#!/usr/bin/perl

use strict;
use warnings;
use App::perlmv;
use Getopt::Std;

my %opts;
getopts('ce:D:dfhloRrSs:Vvw:', \%opts);

if ($opts{V}) { print "perlmv version $App::perlmv::VERSION\n"; exit 0 }
if ($opts{h}) { print <<'USAGE'; exit 0 }
Rename files using Perl code.

Usage:

 perlmv -h

 perlmv [options] <scriptlet> <file...>
 perlmv [options] -e <code> <file...>

 perlmv -e <code> -w <name>
 perlmv -l
 perlmv -s <name>
 perlmv -D <name>

Options:

 -c  Only test compile code, do not run it on the arguments
 -e <CODE> Specify code to rename file (\$_), e.g. 's/\.old\$/\.bak/'
 -d  Dry-run (implies -v)
 -f  Only process files, do not process directories
 -h  Show this help
 -o  Overwrite (by default, ".1", ".2", and so on will be appended to
     avoid overwriting existing files)
 -R  Recursive
 -r  reverse order of processing (by default order is asciibetically)
 -S  Do not process symlinks
 -V  Print version and exit
 -v  Verbose

 -l  list all scriptlets
 -s <NAME> Show source code for scriptlet
 -w <NAME> Write code specified in -e as scriptlet
 -D <NAME> Delete scriptlet
USAGE

my $pmv = App::perlmv->new;
$pmv->{dry_run} = $opts{d};
$pmv->{verbose} = $opts{v} || $opts{d};
$pmv->{reverse_order} = $opts{r};
$pmv->{recursive} = $opts{R};
$pmv->{process_symlink} = !$opts{S};
$pmv->{process_dir} = !$opts{f};
$pmv->{overwrite} = $opts{o};

if ($opts{l}) {
    $pmv->load_scriptlets();
    for (sort keys %{$pmv->{scriptlets}}) {
        if ($opts{v}) {
            print $pmv->format_scriptlet_source($_), "\n";
        } else {
            print $_, "\n";
        }
    }
    exit 0;
}

if ($opts{s}) {
    print $pmv->format_scriptlet_source($opts{s});
    exit 0;
}

if ($opts{w}) {
    $pmv->store_scriptlet($opts{w}, $opts{e});
    exit 0;
}

if ($opts{D}) {
    $pmv->delete_user_scriptlet($opts{D});
    exit 0;
}

if ($opts{e}) {
    $pmv->{code} = $opts{e};
} else {
    die "FATAL: Must specify code (-e) or scriptlet name (first argument)"
        unless @ARGV;
    $pmv->{code} = $pmv->load_scriptlet(scalar shift @ARGV);
}

exit 0 if $opts{c};

die "FATAL: Please specify some files in arguments\n" unless @ARGV;

my @items = ();

# do our own globbing in windows, this is convenient
if ($^O =~ /win32/i) {
    for (@ARGV) {
        if (/[*?{}\[\]]/) { push @items, glob $_ } else { push @items, $_ }
    }
} else {
    push @items, @ARGV;
}

$pmv->rename(@items);

1;
__END__

=head1 NAME

perlmv - Rename files using Perl code

=head1 SYNOPSIS

Usage:

 perlmv -h

 perlmv [options] <scriptlet> <file...>
 perlmv [options] -e <code> <file...>

 perlmv -e <code> -w <name>
 perlmv -l
 perlmv -s <name>
 perlmv -d <name>

=head2 Usage examples

 $ ls
 A.txt B1 c2.txt D3.pl D4.pl

Rename files with prewritten scriptlet (B<ls>) and show (B<-v>) each
file as it is being renamed.

 $ perlmv -v lc *.txt
 `A.txt` -> `a.txt`

Specify script in command line (B<-e>) but do not actually rename
files (B<-d>, dry-run mode):

 $ perlmv -de 's/\d+//g' *
 `B1` -> `B`
 `c2.txt` -> `c.txt`
 `D3.pl` -> `D.pl`
 `D4.pl` -> `D.pl.1`

Really rename the files this time:

 $ perlmv -e 's/\d+//g' *

Save Perl code as scriptlet (in ~/.perlmv/scriptlets/):

 $ perlmv -e 's/\d+//g' -w remove-digits

List all scriptlets (add B<-v> to also show their contents):

 $ perlmv -l
 lc
 uc
 remove-digits

Show source code of scriptlet:

 $ perlmv -s remove-digits
 s/\d+//g

Remove scriptlet:

 $ perlmv -D remove-digits

=head1 DESCRIPTION

Perlmv lets you rename files using Perl code. All the Perl code needs
to do is modify the filename in C<$_> and perlmv will do the rest
(actual renaming, recursive renaming, handling filename conflicts,
dry-run mode, etc.).

Perl code will first be run (eval-ed) once at the beginning for
testing, with C<-TEST> as the filename in C<$_> (and C<$TESTING> will
be defined). Perl code is not run under strict/warnings. Perl code is
run under C<App::perlmv::code> namespace.

Perl code can be specified directly from the command line (using
B<-e>), or by name in C<~/.perlmv/scriptlets/NAME>, or in
C</usr/share/perlmv/scriptlets/>, or in C<%scriptlets> in
L<App::perlmv::scriptlets>, or in C<%scriptlets> in
L<App::perlmv::scriptlets::std>.

=head1 OPTIONS

 -c  Only test compile code, do not run it on the arguments
 -e <CODE> Specify code to rename file (\$_), e.g. 's/\.old\$/\.bak/'
 -d  Dry-run (implies -v)
 -f  Only process files, do not process directories
 -h  Show this help
 -o  Overwrite (by default, ".1", ".2", and so on will be appended to
     avoid overwriting existing files)
 -R  Recursive
 -r  Reverse order of processing (by default order is asciibetically)
 -S  Do not process symlinks
 -V  Print version and exit
 -v  Verbose

 -l  list all scriptlets
 -s <NAME> Show source code for scriptlet
 -w <NAME> Write code specified in -e as scriptlet
 -D <NAME> Delete scriptlet

=head1 FAQ

=head2 Why should I use perlmv? There is prename (File::Rename) already?

Yes, there is a very similar script called B<prename> (also accessible
via B<rename> in Debian) which comes with Perl. This script reinvents
prename and offers more features, e.g.: automatic renaming in case of
conflicts, recursive mode, and saving and loading scriptlets.

=head2 And there is also pmv (File::PerlMove)!

Okay, you got me. I didn't do my homework. The "rename files using
Perl code/expression" is pretty obvious and has surely come up on
other CPAN authors' minds. To be honest, this is a script which I
wrote years ago (at least in 2003, or earlier) and have been using for
years, personally. Admittedly I uploaded this script to CPAN without
careful checking of existing solutions on CPAN. But then, lots of
other CPAN modules are also overlapping in functionality with one
another.

Anyway, I plan to improve perlmv as I see fit, mainly for my own
needs. I plan to borrow some features from prename/pmv, and welcome
them borrowing features from perlmv. I welcome patches. And I am
willing to submit patches to prename/pmv after some discussions with
the respective authors. And lastly, I am also open to the idea of
merging perlmv to either pername/pmv, if I can get all the features I
love in perlmv into those projects.

=head1 BUGS/TODOS

=over 4

=item * Patches for Windows welcome.

=item * Scriptlet should be able to receive arguments.

=back

=head1 SEE ALSO

L<prename> (L<File::Rename>)

L<pm> (L<File::PerlMove>)

=cut
