123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167 |
- #!/usr/bin/perl
- # Author: Daniel "Trizen" Șuteu
- # License: GPLv3
- # Date: 23 August 2015
- # Website: https://github.com/trizen
- # Sort and move a list of file names into a given directory
- use 5.016;
- use strict;
- use warnings;
- use open IO => ':utf8', ':std';
- use File::Copy qw(move);
- use File::Basename qw(basename);
- use File::Spec::Functions qw(catfile);
- use Getopt::Long qw(GetOptions);
- my $reverse = 0; # bool
- my $sort_by = 'none'; # string
- my $output_dir; # string
- my $move = 'none'; # string
- my %sorts = (
- none => sub { },
- name => sub { $a cmp $b },
- iname => sub { fc($a) cmp fc($b) },
- length => sub { length($a) <=> length($b) },
- size => sub { (-s $a) <=> (-s $b) },
- atime => sub { (stat($a))[8] <=> (stat($b))[8] },
- mtime => sub { (stat($a))[9] <=> (stat($b))[9] },
- ctime => sub { (stat($a))[10] <=> (stat($b))[10] },
- );
- sub help {
- print <<"EOT";
- usage: $0 [options] < [input.txt]
- options:
- -s --sort-by=s : sort the files by:
- name -> sort by filename
- iname -> sort by filename case-insensitively
- length -> sort by the length of the filename
- size -> sort by the size of the file
- atime -> sort by file access time
- mtime -> sort by file modification time
- ctime -> sort by file inode change time
- none -> don't do any sorting (default)
- -r --reverse! : reverse the sorting
- -o --out-dir=s : move the files into this directory
- -m --move=s : move the files as follows:
- first -> moves the first n-1 files
- last -> moves the last n-1 files
- all -> moves all files
- none -> don't move any file (default)
- example:
- $0 --sort-by=mtime --move=last --out-dir=/tmp < files.txt
- EOT
- exit 0;
- }
- GetOptions(
- 'm|move=s' => \$move,
- 'r|reverse!' => \$reverse,
- 'o|out-dir=s' => \$output_dir,
- 's|sort-by|sortby=s' => \$sort_by,
- 'h|help' => \&help,
- )
- or die("error in command line arguments");
- my $sort_code = $sorts{lc($sort_by)} // die "Invalid value `$sort_by' for option `--sort-by'";
- if ($move ne 'none') {
- if (defined($output_dir)) {
- if (not -d $output_dir) {
- die "Invalid value `$output_dir' for option `--out-dir' (requires an existent directory)";
- }
- }
- else {
- die "Please add the `--out-dir' option, in order to `--move` files";
- }
- }
- sub process_files {
- my (@files) = @_;
- @files = do {
- my %seen;
- grep { !$seen{$_}++ } @files;
- };
- if ($sort_by ne 'none') {
- @files = sort $sort_code @files;
- }
- if ($reverse) {
- @files = reverse(@files);
- }
- my @all_files = @files;
- if ($move eq 'none') {
- @files = ();
- }
- elsif ($move eq 'first') {
- @files = @files[0 .. $#files - 1];
- }
- elsif ($move eq 'last') {
- @files = @files[1 .. $#files];
- }
- elsif ($move eq 'all') {
- ## ok
- }
- else {
- die "Invalid value `$move' for `--move`";
- }
- my %table;
- @table{@files} = ();
- foreach my $file (@all_files) {
- print $file;
- if (exists $table{$file}) {
- my $basename = basename($file);
- my $dest = catfile($output_dir, $basename);
- print " -> $dest";
- if (-e $dest) {
- print " (error: already exists)";
- }
- else {
- if (move($file, $dest)) {
- print " (OK)";
- }
- else {
- print " (error: $!)";
- }
- }
- }
- print "\n";
- }
- if (@all_files) {
- say "-" x 80;
- }
- }
- my @files;
- while (defined(my $line = <>)) {
- chomp($line);
- if (-e $line) {
- push @files, $line;
- }
- elsif (@files) {
- process_files(@files);
- @files = ();
- }
- }
- process_files(@files) if @files;
|