#!/usr/bin/env perl

=head1 NAME

file-rename - rename multiple files

=head1 SYNOPSIS

  file-rename [OPTIONS] [[-e|-E CODE]*|CODE] [FILES]

=head1 DESCRIPTION

C<file-rename> renames the files according to the rule specified as
the first argument. The perlexpr argument is a Perl expression which
is expected to modify the $_ string in Perl for at least some of
the filenames specified. If a given filename is not modified by the
expression, it will not be renamed. If no filenames are given on the
command line, filenames will be read via standard input.

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Outputs this help page.

=item B<-e> I<EXPRESSION>, B<-E> I<EXPRESSION>, B<--expr>=I<EXPRESSION
+>

The code to be executed on filenames. It uses all the power by Perl an
+d
supplies the mechanism for renaming files.

Each input filename is numbered with C<$NR>. It can be useful when fil
+e
numbering is required.

For example:

  file-rename 's/^/$NR. /' ...
  file-rename 's/^/sprintf "%02d. ", $NR/e' ...

When the B<-T> option is specified, the C<$ENCODE> and C<$DECODE>
variables are used internally for encoding and decoding the processed
file names. See the corresponding description below.

=item B<-M> I<[-]MODULE[=IMPORT]>

Load the module. It's almost similar to Perl's own option B<-M>.

It executes C<use MODULE> before executing the expressions.

It executes C<no MODULE>, if a dash C<-> is specified before the modul
+e name.

The comma-separated list C<IMPORT> causes the module to import specifi
+c symbols.

=item B<-T> I<ENCODE>, B<--transcode>=I<ENCODE>

Apply for each filename the decoding before processing and encoding
after processing.

To encode output in a different encoding than input was decoded, two
comma-separated encoding names are supplied.

Assume the script is launched as below:

  -T ENC1,ENC2 -e '...'

in fact, it works as follows:

  -MEncode -e '$_ = $DECODE->decode($_); ...; $_ = $ENCODE->encode($_)
+'

where C<$DECODE> and C<$ENCODE> are encoding objects corresponding to
the encodings C<ENC1> and C<ENC2>.

=item B<-a>, B<--count-all>

This option makes impact on counting of input files. By default, the
tool counts only those input files which are supposed to be renamed an
+d
skips others. When this option is declared, all input files are counte
+d.

This option makes impact on the $NR variable. Consider four files C<fi
+le1>
through C<file4> (emulated in this example).

Without this option only renamed files are counted:

  $ printf '%s\n' file{1..4} | file-rename 's/[34]/.$NR/' -n
  Reading from <stdin>
  'file1' not changed'
  'file2' not changed'
  move 'file3' 'file.1'
  move 'file4' 'file.2'

When C<-a> is specified, all files are counted:

  $ printf '%s\n' file{1..4} | file-rename 's/[34]/.$NR/' -n -a
  Reading from <stdin>
  'file1' not changed'
  'file2' not changed'
  move 'file3' 'file.3'
  move 'file4' 'file.4'

=item B<-v>, B<--verbose>

Be verbose.

=item B<-n>, B<--dry-run>, B<--check>

Do nothing but print what can be done.

=item B<-c>, B<--copy>

Copy instead of move.

=item B<-f>, B<--force>

Overwrite existing files.

=item B<-N>, B<--filename-only>

Do not rename directories: only rename filename component of path.

=item B<-z>, B<-0>, B<--null>

Treat the input as a set of lines terminated by a zero byte C<\0>,
instead of a newline.

=item B<-r> I<RENAME-MODE>, B<--rename>=I<RENAME-MODE>

Rename files cyclically. Rotation is implemented by the Perl core func
+tion
C<rename> and is limited by a single file system.

=over 4

=item I<l> or I<rotate-left>

Rename files rotating names left:

  f1 <- f2 <- ... <- fn <- f1

=item I<r> or I<rotate-right>

Rename files rotating names right:

  f1 -> f2 -> ... -> fn -> f1

=item I<s> or I<swap>

Rename files by swapping the closest names:

  f1 <-> f2 f3 <-> f4 ...

=item I<f> or I<flip>

=item I<F> or I<flip-even>

Rename files by swapping the farthest names:

  f1 <-> fn f2 <-> fn-1 ...

Difference is in the number of files supposed to be processed: the eve
+n
number of files is required with the "flip-even" option, otherwise the
script fails.

=back

=back

=head1 VARIABLES

The script provides the following variables to make usage more conveni
+ent.

=head2 C<$NR>

The number of the file to be renamed.

=head2 C<$ENCODE> and C<$DECODE>

Encoder and decoder respectively. Both are set as instances of the
L<Encode> module and used to decode and encode file names.

=head1 SEE ALSO

mv(1)

cp(1)

perldoc -f rename

perldoc File::Copy

L<https://metacpan.org/pod/rename>

L<https://metacpan.org/pod/App::RenameUtils>

L<http://plasmasturm.org/code/rename/>

=head1 AUTHORS

This script is inspired by codes by Larry Wall and Robin Barker with
some other ideas by perlancar and Aristotle Pagaltzis. This work is
attempt to rethink the already existing scripts, rework the code, exte
+nd
(if it's possible) and make the usage more convenient. The last one is
my personal vision.

Ildar Shaimordanov

=head1 COPYRIGHT

Copyright 2019-2021, Ildar Shaimordanov

  MIT License

=cut

# ====================================================================
+=====

use strict;
use warnings;

use Getopt::Long qw(:config no_ignore_case bundling);
use Pod::Usage;

use File::Copy;

# ====================================================================
+=====

my $verbose;
my $dry_run;
my $force;
my $action = "move";
my $filename_only;
my $null;
my $die_on_error;

# Current line number
my $NR = 0;
my $count_all;

# Encoders used internally with -T
my $DECODE;
my $ENCODE;

my @expr;
my @use;
my $transcode;

my $rename_mode;
my %rename_modes = (
    "l" => "rotate-left",
    "r" => "rotate-right",
    "s" => "swap",
    "f" => "flip",
    "F" => "flip-even",
);

exit 1 unless GetOptions(
    "h|help"        => sub { pod2usage({ -verbose => 2, -noperldoc => 
+1 }); },

    "v|verbose"        => \$verbose,
    "n|dry-run|check"    => sub { $dry_run = $verbose = 1; },
    "c|copy"        => sub { $action = "copy"; },
    "f|force"        => \$force,
    "N|filename-only"    => \$filename_only,
    "z|0|null"        => \$null,
    "a|count-all"        => \$count_all,

    "e|E|expr=s@"        => \@expr,
    "M=s@"            => \@use,
    "T|transcode=s"        => \$transcode,

    "r|rename=s"    => sub {
        ( $rename_mode ) = $rename_modes{ $_[1] } // grep /\Q$_[1]\E/,
+ values %rename_modes;
        die "Bad rename mode: $_[1]\n" unless $rename_mode;
    },
);

# ====================================================================
+=====

sub input {
    unless ( -t 0 ) {
        warn "Reading from <stdin>\n" if $verbose;
        local $/ = "\0" if $null;
        chop( @ARGV = <STDIN> );
    }
    # globbing only when meet wildcards
    # so it works the same way in win and unix
    @ARGV = map { /[*?]/ ? glob : $_ } @ARGV;
}

sub act {
    my ( $x, $y ) = @_;

    $verbose and warn "$action '$x' '$y'\n";

    return if $dry_run;

    no strict 'refs';
    $action->($x, $y) or do {
        warn "Cannot $action '$x' '$y': $!\n";
        exit 255 if $die_on_error;
    }
}

# When invoke the core rename function under the no strict refs mode,
# Perl dies with the message "Undefined subroutine &main::rename calle
+d".
# I redeclare the function to avoid this error.
sub rename {
    CORE::rename $_[0], $_[1];
}

# ====================================================================
+=====

$rename_mode and do {
    input;

    unless ( $dry_run ) {
        # Make sure the files exist
        for ( @ARGV ) {
            die "'$_' not found\n" unless -e $_;
        }
    }

    # Create a temp filename that doesn't exist
    my $tmp;
    while ( 1 ) {
        $tmp = sprintf "rotate-tmp-%d", rand() * 1_000_000;
        last unless -e $tmp;
    }

    # Prepare replacement list
    # rotate left  : tmp f1 f2 ... fn-1 fn tmp
    # rotate right : tmp fn fn-1 ... f2 f1 tmp
    # swap files   : tmp f1 f2 tmp ... fn-1 fn tmp
    # flip files   : tmp fn f1 tmp fn-1 f2 tmp ...
    #
    # Renaming will be done in the loop, accordingly this way:
    # rename $argv[$i], $argv[$i-1]
    my @files;
    if ( $rename_mode eq "rotate-left" ) {
        @files = ( $tmp, @ARGV, $tmp );
    } elsif ( $rename_mode eq "rotate-right" ) {
        @files = ( $tmp, reverse(@ARGV), $tmp );
    } elsif ( $rename_mode eq "swap" ) {
        die "Even number of files required\n" if @ARGV % 2;

        @files = ( $tmp );
        for ( my $i = 1; $i < @ARGV; $i += 2 ) {
            push @files, $ARGV[$i - 1], $ARGV[$i], $tmp;
        }
    } elsif ( $rename_mode =~ m/flip(-even)?/ ) {
        die "Even number of files required\n" if $1 && @ARGV % 2;

        @files = ( $tmp );
        for ( my $i = 0; $i < @ARGV >> 1; $i++ ) {
            push @files, $ARGV[$#ARGV - $i], $ARGV[$i], $tmp;
        }
    }

    $action = "rename";
    $die_on_error = 1;

    # Rename files accordingly the selected mode
    for ( my $i = 1; $i < @files; $i++ ) {
        my $x = $files[$i];
        my $y = $files[$i - 1];

        act $x, $y;
    }
    exit;
};

# ====================================================================
+=====

push @expr, shift if ! @expr && @ARGV;
@expr or pod2usage;

for ( @use ) {
    s/^-/no / or s/^/use /;
    s/=(.*)/ split ",", q{$1}/;
}

if ( $transcode ) {
    my @objs;
    for ( split /,/, $transcode, 2 ) {
        my $obj = Encode::find_encoding($_) or die "Encoding not found
+: $_\n";
        push @objs, $obj;
    }

    ( $DECODE, $ENCODE ) = @objs;
    $ENCODE //= $DECODE;

    push @use, 'use Encode';

    unshift @expr, '$_ = $DECODE->decode($_)';
    push    @expr, '$_ = $ENCODE->encode($_)';
}

my $code = join ";", @use, @expr;

my $eval = eval sprintf "sub {\n#line 1\n%s\n}", $code or die $@;

my $evaluate = ! $filename_only ? $eval : sub {
    require File::Spec;
    my ( $vol, $dir, $file ) = File::Spec->splitpath($_);
    $eval->() for ( $file );
    $_ = File::Spec->catpath($vol, $dir, $file);
};

# ====================================================================
+=====

for ( input ) {
    $NR++;

    my $old = $_;

    $evaluate->();

    if ( $old eq $_ ) {
        $NR-- unless $count_all;
        warn "'$old' not changed'\n" if $verbose;
        next;
    }

    if ( -e $_ && ! $force ) {
        $NR-- unless $count_all;
        warn "'$old' not renamed: '$_' already exists\n";
        next;
    }

    act $old, $_;
}

# ====================================================================
+=====

# EOF
[download]