File-Rename-2.02/0000755000000000000000000000000014544124362012224 5ustar rootrootFile-Rename-2.02/examples/0000755000000000000000000000000014544124445014044 5ustar rootrootFile-Rename-2.02/examples/using-options-code.pl0000644000000000000000000000204514544003004020113 0ustar rootroot# examples of using the options HASH from C # based on code from "Craig Sanders" # Bug #146138 for File-Rename: how to access options hash in rename script? # [rt.cpan.org #146138] # # with user code from command line # use strict; use warnings; use File::Rename qw(rename); use File::Basename qw(dirname); use File::Path qw(make_path); my $options = File::Rename::Options::GetOptions() or die "Bad options\n"; @ARGV = map {glob} @ARGV if $^O =~ m{Win}msx; my $expr = delete $options->{_code} or die "No code\n"; my $eval = eval qq( sub { $expr } ) or die $@; my %seen; my $code = sub { &$eval; my $dir = dirname($_); if (! -e $dir) { if ($options->{no_action}) { print "#mkdir($dir)\n" unless $seen{"$dir"}++; } else { make_path("$dir", { verbose => 1 }); }; } elsif (! -d "$dir") { print STDERR "$_: $dir exists but is not a directory!\n"; return } }; rename(\@ARGV, $code, $options); File-Rename-2.02/examples/using-options.pl0000644000000000000000000000201414544003004017177 0ustar rootroot# examples of using the options HASH from C # based on code from "Craig Sanders" # Bug #146138 for File-Rename: how to access options hash in rename script? # [rt.cpan.org #146138] # # with renaming code in the script # use strict; use warnings; use File::Rename qw(rename); use File::Basename qw(dirname); use File::Path qw(make_path); my $options = File::Rename::Options::GetOptions(1) or # don't read code die "Bad options\n"; @ARGV = map {glob} @ARGV if $^O =~ m{Win}msx; my %seen; my $code = sub { s{^}{my_new_dir/}; # example user code to rename file my $dir = dirname($_); if (! -e $dir) { if ($options->{no_action}) { print "#mkdir($dir)\n" unless $seen{"$dir"}++; } else { make_path("$dir", { verbose => 1 }); }; } elsif (! -d "$dir") { print STDERR "$_: $dir exists but is not a directory!\n"; return } }; rename(\@ARGV, $code, $options); File-Rename-2.02/examples/rename.pl0000644000000000000000000000022614024446652015650 0ustar rootrootuse strict; use File::Rename (); @ARGV = map glob, @ARGV if $^O =~ /Win/; File::Rename::rename \@ARGV, { _code => sub { $_ = lc }, verbose => 1 }; File-Rename-2.02/t/0000755000000000000000000000000014544124445012471 5ustar rootrootFile-Rename-2.02/t/testlib.pl0000644000000000000000000000651114544003004014462 0ustar rootrootuse strict; use warnings; require File::Spec; require File::Path; sub main_argv { local @ARGV = @_; main() } my $tempdir; sub tempdir { my $d = 'temp' . $$; File::Path::rmtree($d) if -d $d; File::Path::mkpath($d); return ( $tempdir = $d ); } sub create { my $d = $tempdir; die unless $d and -d $d; my @created; for (@_) { my $path = File::Spec->catfile( $d, $_ ); my $text = $_; $text =~ s/[^\x20-\x7e]/?/g; if ( create_file( $path, $text ) ) { push @created, $path; } } return @created; } sub listdir { my $d = shift; my $DIR; unless ( opendir $DIR, $d ) { diag("Can't opendir $d: $!"); return; } my @read = readdir $DIR; closedir $DIR or die $!; return ( grep { !/^\./ } @read ); } sub create_file { my $file = shift; if ( open my $fh, '>', $file ) { print $fh @_; return 1 if close $fh; } $file =~ s/\n/\\n/g; $file =~ s/\s/\\ /g; diag("Can't create file \"$file\": $!\n"); return; } sub test_rename_files { my ( $sub, $file, $verbose, $warning, $printed ) = @_; my @file = ref $file ? @$file : $file; test_rename_function( sub { File::Rename::rename_files( $sub, $verbose, @file ) }, $warning, $printed ); } sub test_rename_list { my ( $sub, $fh, $verbose, $warning, $printed ) = @_; test_rename_function( sub { File::Rename::rename_list( $sub, $verbose, $fh ) }, $warning, $printed ); } sub test_rename_function { my ( $function, $warning, $printed ) = @_; our ( $found, $warn ) = (); our $print = ''; { open my $stdout, '>', \$print or die; select $stdout; $function->(); close $stdout or die; } if ($warning) { if ($warn) { if ( $warn =~ s/^\Q$warning\E\b.*\n//sm ) { $found++ } } else { $warn = "(no warning)\n" } unless ($found) { $warning =~ s/^/EXPECT: WARN: /mg; diag($warning); } } elsif ($printed) { if ($print) { if ( $print =~ s/^\Q$printed\E(\s.*)?\n//sm ) { $found++ } } else { $print = "(no output)\n" } unless ($found) { $printed =~ s/^/EXPECT: PRINT: /mg; diag($printed); } } else { $found++ unless $warn or $print; } } sub diag_rename { if ( our $warn ) { $warn =~ s/^/WARN: /mg; diag($warn); } if ( our $print ) { $print =~ s/^/PRINT: /mg; diag($print); } } sub options { local @ARGV = @_; # Test must File::Rename::Options->import # using either C # or C my $opt = File::Rename::Options::GetOptions(1); die "Bad options '@_'" unless $opt; die "Not options '@ARGV'" if @ARGV; return $opt; } sub is_windows { unless ( $] < 5.014 ) { if ( eval { require Perl::OSType; } ) { return Perl::OSType::is_os_type('Windows'); } diag $@; } return ( $^O eq q{MSWin32} ); } sub script_name { return +( is_windows() ? 'file-rename' : 'rename' ); } sub unsafe_script_name { return 'unsafe-rename'; } 1; File-Rename-2.02/t/File-Rename-list.t0000644000000000000000000000246314544003004015703 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 4; BEGIN { use_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $dir = do { require File::Temp; File::Temp::tempdir(); }; chdir $dir or die; my $file = 'list.txt'; create_file($file); our $found; our $print; our $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; sub test_rename { goto &test_rename_list; } my $s = sub { s/foo/bar/ }; { open my $fh, '<', $file or die "Can't open $file: $!\n"; test_rename($s, $fh, 1, undef, "Reading filenames from file handle" ); } ok( $found, "rename_list"); diag_rename(); { open my $fh, '<', $file or die "Can't open $file: $!\n"; *{$fh} = \"XYZZY"; test_rename($s, $fh, 1, undef, "Reading filenames from XYZZY" ); } ok( $found, "rename_list - using *FH{SCALAR}"); diag_rename(); END { chdir File::Spec->rootdir; File::Path::rmtree($dir); ok( !-d $dir, "test dir removed"); } File-Rename-2.02/t/rename-cygwin.t0000644000000000000000000000061414542552307015424 0ustar rootrootuse strict; use warnings; use Test::More; BEGIN { push @INC, qw(blib/script blib/bin) if -d 'blib' }; plan skip_all => "Not cygwin" unless $^O eq 'cygwin'; plan tests => 3; ok( eval { require('rename') }, 'cygwin: script is rename'); ok( !eval { require('file-rename') }, 'cygwin: script not file-rename'); like( $INC{'rename'}, qr{/ rename \z}msx, "required script in \%INC"); File-Rename-2.02/t/File-Rename-require.t0000644000000000000000000000160414544003004016400 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl File-Rename.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; BEGIN { require_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # require File::Rename should not include File::Rename::Options my $ok = !eval { local @ARGV = (1); File::Rename::Options::GetOptions(); 1 }; ok($ok, 'not imported File::Rename::Options::GetOptions' ); # eval will fail if rename is CORE::rename my $eval = eval q{ rename [1], 1, 1; 1; }; # require File::Rename does not import rename ok(!$eval, 'not imported rename()'); File-Rename-2.02/t/File-Rename-E.t0000644000000000000000000000201514544003004015105 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 2; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 main_argv('-E', 's/i/a/', '-E', 's/g/j/', glob File::Spec->catfile($dir,'b*') ); is_deeply( [ sort(listdir($dir)) ], [qw(banj.txt bonj.txt)], 'rename - files' ); File::Path::rmtree($dir); File-Rename-2.02/t/rename-ostype.t0000644000000000000000000000070514542552307015450 0ustar rootrootuse strict; use warnings; use Test::More; plan skip_all => 'Need perl v5.14.0: no Perl::OSType' if $] < 5.014; plan tests => 5; require_ok 'Perl::OSType'; ok( Perl::OSType::os_type(), 'Perl::OSType::os_type' ); ok( Perl::OSType::is_os_type('Windows','MSWin32'), 'MSWin32 is Windows'); ok( !Perl::OSType::is_os_type('Windows','cygwin'), 'cygwin isn\'t Windows'); ok( !Perl::OSType::is_os_type('Windows','darwin'), 'darwin isn\'t Windows'); File-Rename-2.02/t/File-Rename-script.t0000644000000000000000000000342514544003004016233 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use strict; use warnings; use Test::More tests => 4; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; diag $INC{$script}; SKIP: { skip "script may be in blib/bin", 1 if $] < 5.008009; like( $INC{$script}, qr{/ $script \z}msx, "required $script in \%INC"); } ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 main_argv( 's/i/a/', glob File::Spec->catfile($dir,'b*') ); is_deeply( [ sort( listdir( $dir ) ) ], [qw(bang.txt bong.txt)], 'rename - files' ); # test 3 close STDIN or die; pipe(STDIN, WRITE) or die; my $pid = fork; die unless defined $pid; unless( $pid ) { # CHILD close WRITE; main_argv( 'substr $_, -7, 2, "u"' ); # diag "Child: $$"; # Test::Builder 0.15 does _ending in children Test::Builder->new->no_ending(1) unless $Test::Builder::VERSION > 0.15; exit; } close STDIN; print WRITE File::Spec->catfile($dir,'bong.txt'); print WRITE "\n"; close WRITE or die $!; # diag "Parent: $$"; wait; # diag "Waited: $pid"; is_deeply( [ sort( listdir( $dir ) ) ], [qw(bang.txt bug.txt)], 'rename - list' ); File::Path::rmtree($dir); File-Rename-2.02/t/File-Rename-list-null.t0000644000000000000000000000256314544003004016654 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 4; BEGIN { use_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. unshift @INC, 't' if -d 't'; require 'testlib.pl'; sub test_rename { goto &test_rename_list; } my $dir = do { require File::Temp; File::Temp::tempdir() }; chdir $dir or die; my @files = ('file.txt', 'bad file', "new\nline"); my @target = grep { create_file($_) } @files; die unless @target; my $file = 'list.txt'; create_file($file, map qq($_\0), @target) or die; our $found; our $print; our $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; my $s = sub { s/\W// }; { open my $fh, '<', $file or die "Can't open $file: $!\n"; test_rename($s, $fh, {verbose=>1, input_null=>1}, 0, "Reading filenames from file handle" ); } ok( $found, "rename_list"); diag_rename(); s/\W// for @target; is_deeply( [ sort(listdir('.')) ], [sort($file, @target)], 'rename - list - null' ); END { chdir File::Spec->rootdir; File::Path::rmtree($dir); ok( !-d $dir, "test dir removed"); } File-Rename-2.02/t/u/0000755000000000000000000000000014544124354012734 5ustar rootrootFile-Rename-2.02/t/u/File-Rename-no-order.t0000644000000000000000000000202114544003004016707 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 2; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = unsafe_script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 main_argv( glob( File::Spec->catfile($dir,'b*') ), '-e', 's/i/u/' ); is_deeply( [ sort( listdir( $dir ) ) ], [qw(bong.txt bung.txt)], 'rename - files' ); File::Path::rmtree($dir); File-Rename-2.02/t/u/File-Rename-E.t0000644000000000000000000000202414544003004015351 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 2; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = unsafe_script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 main_argv('-E', 's/i/a/', '-E', 's/g/j/', glob File::Spec->catfile($dir,'b*') ); is_deeply( [ sort(listdir($dir)) ], [qw(banj.txt bonj.txt)], 'rename - files' ); File::Path::rmtree($dir); File-Rename-2.02/t/u/File-Rename-script.t0000644000000000000000000000343414544003004016477 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use strict; use warnings; use Test::More tests => 4; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = unsafe_script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; diag $INC{$script}; SKIP: { skip "script may be in blib/bin", 1 if $] < 5.008009; like( $INC{$script}, qr{/ $script \z}msx, "required $script in \%INC"); } ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 main_argv( 's/i/a/', glob File::Spec->catfile($dir,'b*') ); is_deeply( [ sort( listdir( $dir ) ) ], [qw(bang.txt bong.txt)], 'rename - files' ); # test 3 close STDIN or die; pipe(STDIN, WRITE) or die; my $pid = fork; die unless defined $pid; unless( $pid ) { # CHILD close WRITE; main_argv( 'substr $_, -7, 2, "u"' ); # diag "Child: $$"; # Test::Builder 0.15 does _ending in children Test::Builder->new->no_ending(1) unless $Test::Builder::VERSION > 0.15; exit; } close STDIN; print WRITE File::Spec->catfile($dir,'bong.txt'); print WRITE "\n"; close WRITE or die $!; # diag "Parent: $$"; wait; # diag "Waited: $pid"; is_deeply( [ sort( listdir( $dir ) ) ], [qw(bang.txt bug.txt)], 'rename - list' ); File::Path::rmtree($dir); File-Rename-2.02/t/u/File-Rename-unicode.t0000644000000000000000000000234514544003004016621 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Need perl v5.12.0: no feature unicode_strings" if $] < 5.012; } plan tests => 3; push @INC, qw(blib/script) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = unsafe_script_name(); my $require_ok = eval { require($script) }; die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); my @files = create(qq(b\x{A0}g.txt)); SKIP: { skip "Can't create filename with NBSP", 1 unless @files; main_argv( '-u', '-e', 's/\s//', @files); is_deeply( [ sort( listdir( $dir ) ) ], [qw(bg.txt)], 'rename - unicode' ); } File::Path::rmtree($dir); require_ok 'File::Rename::Unicode'; cmp_ok( eval $File::Rename::Unicode::VERSION, '<=', eval $File::Rename::VERSION); File-Rename-2.02/t/u/rename-examples.t0000644000000000000000000000423214544003004016171 0ustar rootrootuse strict; use warnings; use Test::More; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, qw(t) if -d 't'; require 'testlib.pl'; eval { require Pod::Parser } or plan skip_all => qq(No Pod::Parser\n$@); package File::Rename::Test::Parser; our @ISA = qw(Pod::Parser); our $key = __PACKAGE__; sub begin_pod { shift->{$key} = []; } sub command { return } sub textblock { return } sub interior_sequence { return } sub verbatim { my ($self, $text) = @_; push @{$self->{$key}}, $text; } sub data { @{shift->{$key}} } package main; my $generic = 'rename'; my $script = unsafe_script_name(); eval { require($script) } or BAIL_OUT qq{Can't require $script\n$@}; my $inc_script = $INC{$script}; BAIL_OUT "\$INC($script) = '$inc_script', missing\n" unless $inc_script and -e $inc_script; my $parser = File::Rename::Test::Parser->new; $parser->parse_from_file( $inc_script ); my @examples = grep /\s+$generic\s/, $parser->data; ######################### # Insert your test code below, the Test::More # module is use()ed here so read its man page # ( perldoc Test::More ) # for help writing this test script. plan tests => 2 + ((@examples * 2) || 1); like( $inc_script, qr{/ $script \z}msx, "required $script is $inc_script"); ok( scalar(@examples) > 1, "enough examples in $inc_script" ); # Larry Wall wrote 2 examples in 1992! unshift @INC, 't' if -d 't'; require 'testlib.pl'; for ( @examples ) { s/\n+\z//; my $example = $_; s/\A\s+$generic\s+//; my @args = split; for (@args) { s/\A'(.*)'\z/$1/; } my $dir = tempdir(); create(qw(1 foo.bak baa)); chdir $dir or die $!; mkdir 'my_new_dir' or die $!; if ( $args[-1] =~ /\*/ ) { my @glob = glob(pop @args); push @args, @glob; } my $warn; my $ok = eval { $SIG{__WARN__} = sub { $warn .= $_[0]; }; main_argv( @args ); 1; }; ok( $ok, "does not die: $example" ); diag $@ unless $ok; ok( !$warn, "no warning: $example" ) or diag $warn; chdir File::Spec->updir or die $!; File::Path::rmtree($dir) or die $!; } File-Rename-2.02/t/u/File-Rename-V.t0000644000000000000000000000217314544003004015377 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 2; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = unsafe_script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # test 2 my $buffer; open my $stdout, '>', \$buffer or diag $!; select $stdout; main_argv('-V'); END{ close $stdout or diag $!; like( $buffer, qr{ \b $script \s+ using \s+ (\w+\:\:)+Rename \s+ version \s+ \d+(\.\d+)(_\d+)* ( , \s+ (\w+\:\:)+Rename\:\:\w+ \s+ version \s+ \d+(\.\d+)(_\d+)* )* $ }msx, "-V"); } File-Rename-2.02/t/rename-darwin.t0000644000000000000000000000063214542552307015410 0ustar rootrootuse strict; use warnings; use Test::More; BEGIN { push @INC, qw(blib/script blib/bin) if -d 'blib' }; plan skip_all => "Not darwin" unless $^O eq 'darwin'; plan tests => 3; ok( eval { require('rename') }, 'darwin: script is rename'); ok( !eval { require('file-rename') }, 'darwin: script not file-rename'); like( $INC{rename}, qr{/ rename \z}msx, "required script in \%INC"); File-Rename-2.02/t/File-Rename-unicode.t0000644000000000000000000000233614544003004016355 0ustar rootroot# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Need perl v5.12.0: no feature unicode_strings" if $] < 5.012; } plan tests => 3; push @INC, qw(blib/script) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = script_name(); my $require_ok = eval { require($script) }; die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dir = tempdir(); my @files = create(qq(b\x{A0}g.txt)); SKIP: { skip "Can't create filename with NBSP", 1 unless @files; main_argv( '-u', '-e', 's/\s//', @files); is_deeply( [ sort( listdir( $dir ) ) ], [qw(bg.txt)], 'rename - unicode' ); } File::Path::rmtree($dir); require_ok 'File::Rename::Unicode'; cmp_ok( eval $File::Rename::Unicode::VERSION, '<=', eval $File::Rename::VERSION); File-Rename-2.02/t/File-Rename-files.t0000644000000000000000000000506614544003004016034 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 11; BEGIN { use_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. unshift @INC, 't' if -d 't'; require 'testlib.pl'; sub test_rename { goto &test_rename_files; } my $dir = do { require File::Temp; File::Temp::tempdir() }; chdir $dir or die; my($test_foo, $test_bar, $copy_foo, $copy_bar, $new1, $new2, $old2, $old3) = qw(test.foo test.bar copy.foo copy.bar 1.new 2.new 2.old 3.old); my $subdir = 'food'; File::Path::mkpath($subdir) or die; my $sub_test = File::Spec->catfile($subdir,'test.txt'); for my $file ($test_foo, $copy_foo, $copy_bar, $new1, $old2, $sub_test) { create_file($file) or die; } our $found; our $print; our $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; my $s = sub { s/foo/bar/ }; test_rename($s, $test_foo); ok( (-e $test_bar and !-e $test_foo and $found), "rename foo->bar"); diag_rename(); test_rename($s, $new1); ok( (-e $new1 and $found), "rename: filename not changed"); diag_rename(); test_rename($s, $copy_foo, undef, "$copy_foo not renamed"); ok( (-e $copy_foo and $found), "rename: file exists"); diag_rename(); test_rename($s, $copy_foo, {over_write=>1}); ok( (!-e $copy_foo and $found), "rename: over_write"); diag_rename(); create_file($copy_foo); test_rename($s, $copy_foo, {over_write=>1, verbose=>1}, undef, "$copy_foo renamed as $copy_bar"); ok( (!-e $copy_foo and $found), "rename: over_write+verbose"); diag_rename(); test_rename($s, $sub_test, undef, "Can't rename $sub_test"); ok( (-e $sub_test and $found), "rename: can't rename"); diag_rename(); my $inc = sub { s/(\d+)/ $1 + 1 /e unless /\.old\z/ }; test_rename($inc, $new1, {no_action=>1}, undef, "rename($new1, $new2)"); ok( (-e $new1 and !-e $new2 and $found), "rename: no_action"); diag_rename(); test_rename($inc, $new1, 1, undef, "$new1 renamed as $new2"); ok( (-e $new2 and !-e $new1 and $found), "rename 1->2"); diag_rename(); test_rename($inc, $old2, 1); ok( (-e $old2 and !-e $old3 and $found), "rename: filename not changed (1->2)"); diag_rename(); END { chdir File::Spec->rootdir; File::Path::rmtree($dir); ok( !-d $dir, "test dir removed"); } File-Rename-2.02/t/rename-examples.t0000644000000000000000000000422314544003004015725 0ustar rootrootuse strict; use warnings; use Test::More; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, qw(t) if -d 't'; require 'testlib.pl'; eval { require Pod::Parser } or plan skip_all => qq(No Pod::Parser\n$@); package File::Rename::Test::Parser; our @ISA = qw(Pod::Parser); our $key = __PACKAGE__; sub begin_pod { shift->{$key} = []; } sub command { return } sub textblock { return } sub interior_sequence { return } sub verbatim { my ($self, $text) = @_; push @{$self->{$key}}, $text; } sub data { @{shift->{$key}} } package main; my $generic = 'rename'; my $script = script_name(); eval { require($script) } or BAIL_OUT qq{Can't require $script\n$@}; my $inc_script = $INC{$script}; BAIL_OUT "\$INC($script) = '$inc_script', missing\n" unless $inc_script and -e $inc_script; my $parser = File::Rename::Test::Parser->new; $parser->parse_from_file( $inc_script ); my @examples = grep /\s+$generic\s/, $parser->data; ######################### # Insert your test code below, the Test::More # module is use()ed here so read its man page # ( perldoc Test::More ) # for help writing this test script. plan tests => 2 + ((@examples * 2) || 1); like( $inc_script, qr{/ $script \z}msx, "required $script is $inc_script"); ok( scalar(@examples) > 1, "enough examples in $inc_script" ); # Larry Wall wrote 2 examples in 1992! unshift @INC, 't' if -d 't'; require 'testlib.pl'; for ( @examples ) { s/\n+\z//; my $example = $_; s/\A\s+$generic\s+//; my @args = split; for (@args) { s/\A'(.*)'\z/$1/; } my $dir = tempdir(); create(qw(1 foo.bak baa)); chdir $dir or die $!; mkdir 'my_new_dir' or die $!; if ( $args[-1] =~ /\*/ ) { my @glob = glob(pop @args); push @args, @glob; } my $warn; my $ok = eval { $SIG{__WARN__} = sub { $warn .= $_[0]; }; main_argv( @args ); 1; }; ok( $ok, "does not die: $example" ); diag $@ unless $ok; ok( !$warn, "no warning: $example" ) or diag $warn; chdir File::Spec->updir or die $!; File::Path::rmtree($dir) or die $!; } File-Rename-2.02/t/File-Rename-Options.t0000644000000000000000000000126314544003004016360 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl File-Rename.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; BEGIN { use_ok('File::Rename::Options') }; ######################### # test 2 my $ok = do { local @ARGV = (1); File::Rename::Options::GetOptions() }; ok($ok, 'File::Rename::Options::GetOptions' ); ok( $File::Rename::Options::VERSION <= do { require File::Rename; eval $File::Rename::VERSION }, 'File::Rename::Option version not ahead of distribution version' ) File-Rename-2.02/t/File-Rename-dash.t0000644000000000000000000000161214544003004015642 0ustar rootrootuse strict; use warnings; use Test::More; BEGIN { plan skip_all => 'Need perl v5.16.0: no \N{}' if $] < 5.016; } plan tests => 3; require_ok('Encode'); require_ok('File::Rename'); unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $dir = do { require File::Temp; File::Temp::tempdir(); }; chdir $dir or die; my $test = Encode::encode( 'UTF-8', "A \x{2013} B.txt"); # EN DASH my $xxx = 'A XXX B.txt'; create_file($test); SKIP: { skip "Can't create filename with unicode \\N{EN DASH}", 1 unless -e $test; our $found; our $print; our $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; test_rename_files( sub { s/\N{EN DASH}+/XXX/ }, $test, {unicode_strings => 1, encoding => 'utf8'}); ok( (-e $xxx and !-e $test and $found), "rename with \\N{EN DASH}"); diag_rename(); } File-Rename-2.02/t/File-Rename-import.t0000644000000000000000000000167514544003004016246 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl File-Rename.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 4; BEGIN { use_ok('File::Rename', qw(rename) ) }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # test 2 ok( eval q{ rename( ['bing.txt'], 1, 1 ); 1 }, # does nothing 'imported - rename' ); # test 3 ok( !eval q{ CORE::rename( 'bing.txt', 1, 1 ); 1 }, # syntax error 'CORE::rename() is not rename()' ); # test 4 # use File::Rename includes File::Rename::Options my $ok = eval q{ local @ARGV = (1); File::Rename::Options::GetOptions() }; ok($ok, 'imported - File::Rename::Options::GetOptions' ); File-Rename-2.02/t/File-Rename-filename-only.t0000644000000000000000000000530714544003004017467 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 11; BEGIN { use_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. unshift @INC, 't' if -d 't'; require 'testlib.pl'; sub test_rename { goto &test_rename_files; } my $dir = do { require File::Temp; File::Temp::tempdir() }; my($test_foo, $test_bar, $copy_foo, $copy_bar, $new1, $new2, $old2, $old3) = map { File::Spec->catfile($dir, $_) } qw(test.foo test.bar copy.foo copy.bar 1.new 2.new 2.old 3.old); my $subdir = File::Spec->catdir($dir, 'food'); File::Path::mkpath($subdir) or die; my $sub_test = File::Spec->catfile($subdir,'test.txt'); for my $file ($test_foo, $copy_foo, $copy_bar, $new1, $old2, $sub_test) { create_file($file) or die; } our $found; our $print; our $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; my $s = sub { s/foo/bar/ }; my $h = options( q(-d) ); test_rename($s, $test_foo, $h); ok( (-e $test_bar and !-e $test_foo and $found), "rename foo->bar"); diag_rename(); test_rename($s, $new1, $h); ok( (-e $new1 and $found), "rename: filename not changed"); diag_rename(); test_rename($s, $copy_foo, $h, "$copy_foo not renamed"); ok( (-e $copy_foo and $found), "rename: file exists"); diag_rename(); test_rename($s, $copy_foo, options( qw(-filename -f) ) ); ok( (!-e $copy_foo and $found), "rename: over_write"); diag_rename(); create_file($copy_foo); test_rename($s, $copy_foo, options( qw(-nopath -f -v) ), undef, "$copy_foo renamed as $copy_bar"); ok( (!-e $copy_foo and $found), "rename: over_write+verbose"); diag_rename(); test_rename($s, $sub_test, $h); ok( (-e $sub_test and $found), "rename: silently not renamed"); diag_rename(); my $inc = sub { s/(\d+)/ $1 + 1 /e unless /\.old\z/ }; test_rename($inc, $new1, options( qw(-n -nofullpath) ), undef, "rename($new1, $new2)"); ok( (-e $new1 and !-e $new2 and $found), "rename: no_action"); diag_rename(); test_rename($inc, $new1, options( qw(--verbose --filename) ), undef, "$new1 renamed as $new2"); ok( (-e $new2 and !-e $new1 and $found), "rename 1->2"); diag_rename(); test_rename($inc, $old2, options( qw(-d -v) ) ); ok( (-e $old2 and !-e $old3 and $found), "rename: filename not changed (1->2)"); diag_rename(); END { chdir File::Spec->rootdir; File::Path::rmtree($dir); ok( !-d $dir, "test dir removed"); } File-Rename-2.02/t/File-Rename-V.t0000644000000000000000000000216414544003004015133 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as # `perl -I/usr/local/bin t/File-Rename-script.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 2; push @INC, qw(blib/script blib/bin) if -d 'blib'; unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $script = script_name(); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. # test 2 my $buffer; open my $stdout, '>', \$buffer or diag $!; select $stdout; main_argv('-V'); END{ close $stdout or diag $!; like( $buffer, qr{ \b $script \s+ using \s+ (\w+\:\:)+Rename \s+ version \s+ \d+(\.\d+)(_\d+)* ( , \s+ (\w+\:\:)+Rename\:\:\w+ \s+ version \s+ \d+(\.\d+)(_\d+)* )* $ }msx, "-V"); } File-Rename-2.02/t/File-Rename.t0000644000000000000000000000267514544003004014737 0ustar rootrootuse strict; use warnings; # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl File-Rename.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; BEGIN { use_ok('File::Rename') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. unshift @INC, 't' if -d 't'; require 'testlib.pl'; my $dir = tempdir(); create(qw(bing.txt bong.txt)); # test 2 File::Rename::rename( [ glob File::Spec->catfile($dir,'b*') ], 's/i/a/' ); is_deeply( [ sort (listdir($dir)) ], [qw(bang.txt bong.txt)], 'rename - files' ); # test 3 close STDIN or die; pipe(STDIN, WRITE) or die; my $pid = fork; die unless defined $pid; unless( $pid ) { # CHILD close WRITE; File::Rename::rename( [], 'substr $_, -7, 2, "u"' ); # diag "Child: $$"; # Test::Builder 0.15 does _ending in children Test::Builder->new->no_ending(1) unless $Test::Builder::VERSION > 0.15; exit; } close STDIN; print WRITE File::Spec->catfile($dir,'bong.txt'); print WRITE "\n"; close WRITE or die $!; # diag "Parent: $$"; wait; # diag "Waited: $pid"; is_deeply( [ sort(listdir($dir)) ], [qw(bang.txt bug.txt)], 'rename - list' ); File::Path::rmtree($dir); File-Rename-2.02/Changes0000644000000000000000000001750314544020233013515 0ustar rootrootRevision history for Perl extension File::Rename. 2.02 2023-12-30 Author:Robin Barker added example of using options in code add C to source files replace C on older perl versions 2.01 2023-01-17 Author:Robin Barker min perl version 5.8.0 use warnings use Getopt::Long 2.24 source/rename source of rename script 2.00_4 2023-01-16 Author:Robin Barker Min perl version 5.8.0 Move rename source file to source/ - to avoid rename being found when @INC includes '.' Revert regex for $INC values Initialize C for v5.10 2.00_3 2023-01-15 Author:Robin Barker Restore indirect print in t/testlib.pl Change regex for $INC values 2.00_2 deleted 2.00_1 2023-01-14 Author:Robin Barker min perl version 5.6.1 use warnings use Getopt::Long 2.24 2.00 2022-12-31 Author:Robin Barker rename script requires options before code/files New script unsafe-rename with no_require_order Removed Build.PL from distribution 1.99_9 2022-12-28 Author:Robin Barker Remove Build.PL from distribution Set MIN_PERL_VERSION in Makefile.PL 1.992 2022-12-27 Author:Robin Barker Reinstate shebang line https://rt.cpan.org/Ticket/Display.html?id=145711 1.991 2022-12-27 Author:Robin Barker Add required ExtUtils::MakeMaker version to BUILD_REQUIRES and CONFIGURE_REQUIRES Separate out TEST_REQUIRES from PREREQ_PM Fix typos in 1.99 POD and Changes file 1.99 2022-12-24 Author:Robin Barker rename script requires options before code/files New script unsafe-rename with no_require_order: to recover the old behavior of the rename script 1.90_5 2022-12-24 Author:Robin Barker Add back Build.PL for 1.99 - to be removed for 2.00 README and POD for 1.99 1.90_4 2022-12-23 Author:Robin Barker Remove Build.PL - so testers build and test unsafe-rename More globbing in rename-examples.t Test for warnings in rename-examples.t 1.90_3 2022-12-22 Author:Robin Barker Increase required version of ExtUtils::MakeMaker Add test for unsafe script 1.90_2 2022-12-20 Author:Robin Barker Add :config to use File:Rename, to mimic GetOpt::Long Fix cygwin tests - cygwin is not Windows See http://www.cpantesters.org/cpan/report/41cc76dd-84fd-1014-94ee-444106f7812f 1.90_1 2022-12-19 Author:Robin Barker require_order in script New script unsafe-rename with no_require_order Rewrite examples to mark start of non-options 1.31 2022-05-07 Author:Robin Barker Add explicit LICENCE field Fix tests for perl 5.8.* and cygwin 1.30_03 2022-04-23 Author:Robin Barker Add explicit 'cygwin' in test lib and script 1.30_02 2021-09-05 Author:Neil Bowers Add LICENCE=>perl to Makefile.PL 1.30_01 2021-08-16 Author:Robin Barker Fix tests for perl < 5.8.9 (on cygwin) 1.30 2021-08-16 Author:Robin Barker Unicode support: --unicode and File::Rename::Unicode 1.29_06 2021-08-04 Status:not released Documented approach to unicode strings in README 1.29_05 2021-08-03 Author:Robin Barker Add encoding to --unicode Reworked C in testlib.pl: removed unnessary C simplified File-Rename-unicode.t 1.29_04 2021-08-02 Author:Robin Barker Tests which should skip_all: BEGIN { plan skip_all => 1.29_03 2021-08-01 Author:Robin Barker Fix tests which should skip 1.29_02 2021-08-01 Author:Robin Barker Add File::Rename::Unicode to hide C 1.29_01 2021-07-31 Author:Robin Barker Add -u to do utf8::upgrade and unicode_strings 1.20 2021-03-22 Author:Robin Barker On darwin, when built with ExtUtils::MakeMaker, builds the correct script and passes tests; see http://matrix.cpantesters.org/?dist=File-Rename%201.19_04;os=darwin;reports=1 1.19_04 2021-03-20 Author:Robin Barker Fix distribution file format 1.19_03 2021-03-19 Author:Robin Barker Fix META.* for Makefile.PL 1.19_02 2021-03-18 Author:Robin Barker More robust OSType handling 1.19_01 2021-03-17 Author:Robin Barker Fix Makefile and tests to find script on darwin 1.13 2020-06-17 Author:Robin Barker Fix 'examples' test script to do file globbing 1.12 2020-06-17 Author:Robin Barker Added new test script to MANIFEST 1.11 2020-06-16 Author:Robin Barker Added more examples in the script POD, suggested by 'xavier' Added a test script to test that examples in POD are valid 1.10 2018-09-25 Author:Robin Barker Added option --filename [-d] to rename filename component only Added option --fullpath [--path] to rename any part of path 1.09_04 2018-09-19 Author:Robin Barker Added CONTRIBUTING Fixed file 'log' which was supposed to be deleted 1.09_03 2018-09-17 Author:Robin Barker Change options to closer align to original feature request 1.09_02 2018-09-16 Author:Robin Barker Fix test failure for perl 5.14 1.09_01 2018-09-16 Author:Robin Barker Option for renaming file component only: filename-only/-d 1.00 2018-07-03 Author:Robin Barker File::Rename::Options module 0.99_02 2018-06-26 Author:Robin Barker Remove spurious C in t/File-Rename-script.t 0.99_01 2018-06-12 Author:Robin Barker File::Rename::Options in separate file 0.35 2018-06-14 Author:Robin Barker Add $File::Rename::Options::VERSION 0.33 2018-06-13 Author:Robin Barker Added return code for File::Rename::rename More tests: in preparation for v1.00 Add $File::Rename::Options::VERSION 0.32-fix 2018-06-08 Author:Robin Barker Fixed syntax of rmtree() for perl5.16 0.31 2018-06-05 Author:Robin Barker Removed use of s///r in tests Rewrote tests - more robust - use of testlib.pl 0.30 2018-06-02 Author:Robin Barker (tidied configure_requires) removed typo from rename POD options do not need to before code / files allow null separated file names reading from STDIN 0.20 2013-04-30 Author:Robin Barker Added option -E (statement): alternative to -e 0.10 2013-04-29 Author:Robin Barker Merged "0.09 (beta for 0.10)" from 2006-06-26 Added option -V (version). 0.09 2006-06-26 Status:not released (beta for 0.10) Added options -e, -f, -n and -V (version). Options -e, -f, -n suggested by code written by Aristotle Pagaltzis. 0.06 2011-09-23 Author:Robin Barker Added example/rename.pl, dealt with other Kwalitee metrics. Updated META files 0.05 2007-10-03 Author:Robin Barker Removed perl 5.6.0 dependencies and successfully tested on perl 5.005_05 (with patched Temp::File). 0.04 2007-09-27 Author:Robin Barker Replaced depencies on perl versions by explicit requirements on modules in Build.PL/Makefile.PL 0.03 2007-09-26 Author:Robin Barker Added --force and --nono options (over_write, no_action) 0.02 2006-01-13 Author:Robin Barker Added t/pod*.t, and extended POD to pass tests 0.01 2004-12-13T17:54:05Z Mon Dec 13 17:54:05 2004 - original version; created by h2xs 1.23 with options -XAn File::Rename # $Revision$$Date$ # Robin's RCS header: # RCSfile: rename.PL,v Revision: 1.3 Date: 2006/05/25 09:20:32 # Larry's RCS header: # RCSfile: rename,v Revision: 4.1 Date: 92/08/07 17:20:30 # # Log: rename,v # Revision 1.5 1998/12/18 16:16:31 rmb1 # moved to perl/source # changed man documentation to POD # # Revision 1.4 1997/02/27 17:19:26 rmb1 # corrected usage string # # Revision 1.3 1997/02/27 16:39:07 rmb1 # added -v # # Revision 1.2 1997/02/27 16:15:40 rmb1 # *** empty log message *** # # Revision 1.1 1997/02/27 15:48:51 rmb1 # Initial revision # File-Rename-2.02/unsafe.PL0000644000000000000000000000072214544003004013730 0ustar rootrootuse strict; use warnings; use File::Basename qw(dirname); use File::Path qw(mkpath); my($file, $from) = @ARGV; unless( -d( my $dir = dirname $file ) ) { mkpath $dir, 1 } open my $IN, '<', $from or die "$0 can't open $from: $!\n"; open my $OUT, '>', $file or die "$0 can't open $file: $!\n"; select $OUT; while( <$IN> ) { s/;\s+\#\s+REQUIRE_ORDER\b/ qw(:config no_require_order);/; print; } close $OUT or die $!; close $IN or die $!; File-Rename-2.02/CONTRIBUTING0000644000000000000000000000015714024446652014063 0ustar rootrootCONTRIBUTING To report a bug or request a feature use https://rt.cpan.org/Dist/Display.html?Name=File-Rename File-Rename-2.02/source/0000755000000000000000000000000014544124445013526 5ustar rootrootFile-Rename-2.02/source/rename0000644000000000000000000001052614544003004014707 0ustar rootroot#!perl use 5.032; # use strict; use warnings; use File::Rename; # REQUIRE_ORDER use Pod::Usage; main() unless caller; sub main { my $options = File::Rename::Options::GetOptions() or pod2usage; pod2usage( -verbose => 0, -exitval => 'NOEXIT', -message => <<'MESSAGE', -u|--unicode argument does not look like an encoding: either give an encoding or put -e as next option MESSAGE ) if File::Rename::Options::bad_encoding($options); mod_version() if $options->{show_version}; pod2usage( -verbose => 2 ) if $options->{show_manual}; pod2usage( -exitval => 1 ) if $options->{show_help}; @ARGV = map {glob} @ARGV if $^O =~ m{Win}msx; File::Rename::rename(\@ARGV, $options); } sub mod_version { print __FILE__; my $version = File::Rename->VERSION; my $opt_ver = File::Rename::Options->VERSION; print ' using File::Rename version '. $version; if( (eval $opt_ver) < (eval $version) ) { $opt_ver .= '.00' unless $opt_ver =~ m{\.}; print ', File::Rename::Options version '. $opt_ver; } # ignore File::Rename->VERSION print "\n\n"; exit 0 } 1; __END__ =head1 NAME rename - renames multiple files =head1 SYNOPSIS B S<[ B<-h>|B<-m>|B<-V> ]> S<[ B<-v> ]> S<[ B<-0> ]> S<[ B<-n> ]> S<[ B<-f> ]> S<[ B<-d> ]> S<[ B<-u> [I]]> S<[ B<-e>|B<-E> I]*|I> S<[ I ]> =head1 DESCRIPTION C renames the filenames supplied according to the rule specified as the first argument. The I argument is a Perl expression which is expected to modify the C<$_> 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. =head2 Examples (Larry Wall, 1992) For example, to rename all files matching C<*.bak> to strip the extension, you might say rename -- 's/\.bak$//' *.bak To translate uppercase names to lower, you'd use rename 'y/A-Z/a-z/' ./* Examples rewritten to avoid globs which could inject options. =head2 More examples (2020) You can also use rename to move files between directories, possibly at the same time as making other changes (but see B<--filename>) rename 'y/A-Z/a-z/;s/^/my_new_dir\//' ./*.* You can also write the statements separately (see B<-e>/B<-E>) rename -E 'y/A-Z/a-z/' -E 's/^/my_new_dir\//' -- *.* You can use the predefined variables C<$a, $b> in the code; for instance to create sequences of numbers rename -e '$a++;s/\w+/file_$a/' -- *.* =head1 OPTIONS =over 8 =item B<-v>, B<--verbose> Verbose: print names of files successfully renamed. =item B<-0>, B<--null> Use \0 as record separator when reading from STDIN. =item B<-n>, B<--nono> No action: print names of files to be renamed, but don't rename. =item B<-f>, B<--force> Over write: allow existing files to be over-written. =item B<--path>, B<--fullpath> Rename full path: including any directory component. DEFAULT =item B<-d>, B<--filename>, B<--nopath>, B<--nofullpath> Do not rename directory: only rename filename component of path. =item B<-h>, B<--help> Help: print SYNOPSIS and OPTIONS. =item B<-m>, B<--man> Manual: print manual page. =item B<-V>, B<--version> Version: show version number. =item B<-u>, B<--unicode> [I] Treat filenames as perl (unicode) strings when running the user-supplied code. Decode/encode filenames using I, if present. I is optional: if omitted, the next argument should be an option starting with '-', for instance B<-e>. =item B<-e> Expression: code to act on files name. May be repeated to build up code (like C). If no B<-e>, the first argument is used as code. =item B<-E> Statement: code to act on files name, as B<-e> but terminated by ';'. =back =head1 ENVIRONMENT No environment variables are used. =head1 AUTHOR Larry Wall =head1 SEE ALSO mv(1), perl(1) =head1 DIAGNOSTICS If you give an invalid Perl expression you'll get a syntax error. =head1 BUGS The original C did not check for the existence of target filenames, so had to be used with care. =cut File-Rename-2.02/META.json0000644000000000000000000000212414544124362013644 0ustar rootroot{ "abstract" : "Perl extension for renaming multiple files", "author" : [ "Robin Barker " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "File-Rename", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "7.36" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "7.36" } }, "runtime" : { "requires" : { "Getopt::Long" : "2.24", "perl" : "5.008" } }, "test" : { "requires" : { "File::Temp" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "2.02", "x_serialization_backend" : "JSON::PP version 4.06" } File-Rename-2.02/MANIFEST0000644000000000000000000000167314544124362013364 0ustar rootrootChanges CONTRIBUTING Makefile.PL MANIFEST README t/File-Rename.t t/File-Rename-E.t t/File-Rename-files.t t/File-Rename-filename-only.t t/File-Rename-import.t t/File-Rename-Options.t t/File-Rename-script.t t/File-Rename-list.t t/File-Rename-list-null.t t/File-Rename-require.t t/File-Rename-unicode.t t/File-Rename-V.t t/rename-cygwin.t t/rename-darwin.t t/rename-examples.t t/File-Rename-dash.t t/rename-ostype.t t/testlib.pl t/u/File-Rename-no-order.t t/u/File-Rename-E.t t/u/File-Rename-V.t t/u/File-Rename-script.t t/u/File-Rename-unicode.t t/u/rename-examples.t lib/File/Rename.pm lib/File/Rename/Options.pm lib/File/Rename/Unicode.pm source/rename rename.PL unsafe.PL examples/rename.pl examples/using-options.pl examples/using-options-code.pl META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) File-Rename-2.02/README0000644000000000000000000000665514544021076013116 0ustar rootrootFile-Rename version 2.02 ======================== This release is compatible with C. * use warnings * avoid indirect syntax * avoid bareword handles RENAME COMMAND File::Rename provides an implementation of Larry Wall's eg/rename command. All I have done is add some error checking and add the File/Rename.pm module. More options have been added. An earlier version of the script is out in the Internet and is included with some linuxes, and the original eg/rename is not included in the Perl distribution, so I have put this up on CPAN. A revised version of the earlier script is now on the Internet, which includes more options. This script, distinguished by "Getopt::Long::Configure('bundling')", was not written by me; I think the author is Aristotle Pagaltzis. Version 0.10 of this distribution has similar options to the revised script. For Windows, the script is called file-rename to avoid clashes with existing rename command. RECENT CHANGES 1.30: unicode support - added File::Rename::Unicode module 1.99: remove 'no_require_order' The behaviour of requiring options to appear before code or files was reintroduced - this requirement was dropped in version 0.30. The 'no_require_order' functionality is regarded as unsafe but is available in the script unsafe-rename. 2.00: Build.PL was removed from distribution 2.01: minimum perl version is 5.8.0 - added source/rename source of rename script 2.02: perl-5.032 compatibility - added C to all source files - source files are filtered to replace C on older versions of perl. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: File::Basename File::Path File::Spec Getopt::Long (all included with Perl). Unicode support depends on Perl version 5.12.0. Testing requires File::Temp and Test::More which are available with perl 5.6.0. In the past, I have successfully installed those modules for perl 5.005_05 and tested this distribution. Testing on earlier versions of Perl is now only done on CPAN Testers. The minimum perl version for this distribution is 5.8.0 - the earlist Perl version which is known to work with recent versions of File::Rename is 5.8.9. UNICODE SUPPORT File::Rename is built round CORE::rename(), which expects filenames as octet strings. By default, File::Rename expects all filenames to be octet strings, with no special meanings for non-ascii octets. It is possible for the user-supplied code to treat the filenames as Perl strings consisting of unicode characters, while CORE::readme() and other file tests still working on octet strings. This is enabled with -u (--unicode). It is possible to specify the encoding of filenames, with: --unicode encoding. Filenames are decoded from octet strings to unicode strings before applying the user code, and then the resulting string is encoded for CORE::rename. upgrade filenames to unicode (encoded as utf8) by default. COPYRIGHT AND LICENCE Copyright (C) 2005, 2006, 2007, 2011, 2018, 2020, 2021, 2022, 2023 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.4 or, at your option, any later version of Perl 5 you may have available. File-Rename-2.02/rename.PL0000644000000000000000000000105614544003004013717 0ustar rootrootuse strict; use warnings; use File::Basename qw(dirname); use File::Path qw(mkpath); use File::Copy qw(copy); my($file, $from) = @ARGV; unless( -d( my $dir = dirname $file ) ) { mkpath $dir, 1 } if ( $] >= 5.032 and !$ENV{FILE_RENAME_OLD_PERL}) { copy($from, $file) or die $!; exit; } open my $IN, '<', $from or die "$0 can't open $from: $!\n"; open my $OUT, '>', $file or die "$0 can't open $file: $!\n"; select $OUT; while( <$IN> ) { s/^use\s+5\.032;\s*\#\s*//; print; } close $OUT or die $!; close $IN or die $!; File-Rename-2.02/Makefile.PL0000644000000000000000000000452114544003004014165 0ustar rootrootuse 5.008; # Based on earlier h2xs output and # output from Module::Build::Compat version 0.03 use strict; use warnings; use File::Spec; use ExtUtils::MakeMaker 7.36; my $EUMM_REQUIRES = { 'ExtUtils::MakeMaker' => 7.36 }; # ExtUtils::MakeMaker # if an output file depends on extra input files beside the # script itself, a hash ref can be used in version 7.36 and above my $has_os = eval { require Perl::OSType; }; warn "No Perl::OSType\n" unless ($has_os or $] < 5.014); my $is_win = ( $has_os ? Perl::OSType::is_os_type('Windows') : $INC{'ExtUtils/MM_Win32.pm'} ); my $script = File::Spec->catfile( 'script', $is_win ? 'file-rename' : 'rename' ); my $unsafe = File::Spec->catfile( 'script', 'unsafe-rename'); my $source = File::Spec->catfile( 'source', 'rename'); my @pms = map File::Spec->catfile( 'File', $_), (q(Rename.pm), (map File::Spec->catfile( 'Rename', $_), qw(Options.pm Unicode.pm))); my @libs = map File::Spec->catfile('lib', $_), @pms; my %pm; @pm{@pms} = map "\$(INST_LIB)/$_", @pms; my $baselib = $libs[0]; my %rename = ( $script => $source ); @rename{@pms} = @libs; WriteMakefile( NAME => 'File::Rename', VERSION_FROM => $baselib, INSTALLDIRS => 'site', PREREQ_PM => { 'Getopt::Long' => 2.24, # for posix_default }, BUILD_REQUIRES => $EUMM_REQUIRES, CONFIGURE_REQUIRES => $EUMM_REQUIRES, TEST_REQUIRES => { 'File::Temp' => 0, # for testing 'Test::More' => 0, # for testing(!) }, PM => \%pm, clean => { FILES => join ' ', @pms }, EXE_FILES => [ $script, $unsafe ], PL_FILES => { 'rename.PL' => \%rename, 'unsafe.PL' => {$unsafe => $script}, }, ABSTRACT_FROM => $baselib, # retrieve abstract from module AUTHOR => 'Robin Barker ', LICENSE => 'perl', NORECURS => 1, test => { RECURSIVE_TEST_FILES => 1 }, MIN_PERL_VERSION => 5.008, ); File-Rename-2.02/lib/0000755000000000000000000000000014544124445012774 5ustar rootrootFile-Rename-2.02/lib/File/0000755000000000000000000000000014544124354013652 5ustar rootrootFile-Rename-2.02/lib/File/Rename.pm0000644000000000000000000001567714544021151015426 0ustar rootrootpackage File::Rename; use 5.032; # use strict; use warnings; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( rename ); our $VERSION = '2.02'; sub import { my $pack = shift; my($args, $config) = &_config; # sees @_ $pack->export_to_level(1, $pack, @$args); require File::Rename::Options; File::Rename::Options->import(@$config); } sub rename_files { my $code = shift; my $options = shift; _default(\$options); my $sub = $code; if ( $options->{unicode_strings} ) { require File::Rename::Unicode; $sub = File::Rename::Unicode::code($code, $options->{encoding}); } my $errors; for (@_) { my $was = $_; if ( $options->{filename_only} ) { require File::Spec; my($vol, $dir, $file) = File::Spec->splitpath($_); $sub->() for ($file); $_ = File::Spec->catpath($vol, $dir, $file); } else { $sub->(); } if( $was eq $_ ){ } # ignore quietly elsif( -e $_ and not $options->{over_write} ) { if (/\s/ or $was =~ /\s/ ) { warn "'$was' not renamed: '$_' already exists\n"; } else { warn "$was not renamed: $_ already exists\n"; } $errors ++; } elsif( $options->{no_action} ) { print "rename($was, $_)\n"; } elsif( CORE::rename($was,$_)) { print "$was renamed as $_\n" if $options->{verbose}; } else { warn "Can't rename $was $_: $!\n"; $errors ++; } } return !$errors; } sub rename_list { my($code, $options, $fh, $file) = @_; _default(\$options); print "Reading filenames from ", ( defined $file ? $file : defined *{$fh}{SCALAR} and defined ${*{$fh}{SCALAR}} ? ${*{$fh}{SCALAR}} : "file handle ($fh)" ), "\n" if $options->{verbose}; my @file; { local $/ = "\0" if $options->{input_null}; chop(@file = <$fh>); } rename_files $code, $options, @file; } sub rename { my($argv, $code, $verbose) = @_; if( ref $code ) { if( 'HASH' eq ref $code ) { if(defined $verbose ) { require Carp; Carp::carp(<{_code}; unless ( $code ) { require Carp; Carp::carp(< $verbose } } sub _config { # copied from GetOpt::Long::import my @syms = (); # symbols to import my @config = (); # configuration my $dest = \@syms; # symbols first for ( @_ ) { if ( $_ eq ':config' ) { $dest = \@config; # config next next; } push(@$dest, $_); # push } return (\@syms, \@config); } 1; __END__ =head1 NAME File::Rename - Perl extension for renaming multiple files =head1 SYNOPSIS use File::Rename qw(rename); # hide CORE::rename rename \@ARGV, sub { s/\.pl\z/.pm/ }, 1; use File::Rename; File::Rename::rename \@ARGV, '$_ = lc'; use File::Rename qw(:config no_require_order); =head1 DESCRIPTION =head2 USE OPTIONS Parameters to C consists of functions to be imported and configuration options. The only exported function is C. The configuation options are preceded by :config, and are passed to File::Rename::Options. =head2 FUNCTIONS =over 4 =item C rename FILES using CODE, if FILES is empty read list of files from stdin =item C rename FILES using CODE =item C rename a list of file read from HANDLE, using CODE =back =head2 OPTIONS =over 8 =item FILES List of files to be renamed, for C must be an ARRAY reference =item CODE Subroutine to change file names, for C can be a string, otherwise it is a code reference =item VERBOSE Flag for printing names of files successfully renamed, optional for C =item HANDLE Filehandle to read file names to be renames =item FILENAME (Optional) Name of file that HANDLE reads from =back =head2 HASH Either CODE or VERBOSE can be a HASH of options. If CODE is a HASH, VERBOSE is ignored and CODE is supplied by the B<_code> key. Other options are =over 16 =item B As VERBOSE above, provided by B<-v>. =item B Input separator \0 when reading file names from stdin. =item B Print names of files to be renamed, but do not rename (i.e. take no action), provided by B<-n>. =item B Allow files to be over-written by the renaming, provided by B<-f>. =item B Only apply renaming to the filename component of the path, provided by B<-d>. =item B Print help, provided by B<-h>. =item B Print manual page, provided by B<-m>. =item B Print version number, provided by B<-V>. =item B Enable unicode_strings feature, provided by B<-u>. =item B Encoding for filenames, provided by B<-u>. =back =head2 EXPORT rename =head1 ENVIRONMENT No environment variables are used. =head1 SEE ALSO mv(1), perl(1), rename(1) =head1 AUTHOR Robin Barker =head1 Acknowledgements Based on code from Larry Wall. Options B<-e>, B<-f>, B<-n> suggested by more recent code written by Aristotle Pagaltzis. =head1 DIAGNOSTICS Errors from the code argument are not trapped. =head1 COPYRIGHT AND LICENSE Copyright (C) 2004, 2005, 2006, 2011, 2018, 2021, 2022, 2023 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.4 or, at your option, any later version of Perl 5 you may have available. =cut File-Rename-2.02/lib/File/Rename/0000755000000000000000000000000014544124445015062 5ustar rootrootFile-Rename-2.02/lib/File/Rename/Options.pm0000644000000000000000000000667414544003004017053 0ustar rootrootpackage File::Rename::Options; use 5.032; # use strict; use warnings; use Getopt::Long 2.24 (); our $VERSION = 2.01; our $IMPORTED; sub import { my $pack = shift; if( $IMPORTED++ ) { require Carp; Carp::cluck("$pack->import() called twice"); } my @config = qw( posix_default no_ignore_case ); push @config, @_; Getopt::Long::Configure(@config); } sub GetOptions { my ($no_code) = @_; my @expression; my $fullpath = 1; Getopt::Long::GetOptions( '-v|verbose' => \my $verbose, '-0|null' => \my $null, '-n|nono' => \my $nono, '-f|force' => \my $force, '-h|?|help' => \my $help, '-m|man' => \my $man, '-V|version' => \my $version, '-d|filename' => sub { undef $fullpath }, '-path|fullpath!' => \$fullpath, '-e=s' => \@expression, '-E=s' => sub { my(undef, $e) = @_; $e .= ';'; push @expression, $e; }, '-u|unicode:s' => \my $unicode, ) or return; my $options = { verbose => $verbose, input_null => $null, no_action => $nono, over_write => $force, filename_only => !$fullpath, show_help => $help, show_manual => $man, show_version => $version, unicode_strings => defined $unicode, encoding => $unicode, }; return $options if $no_code; return $options if $help or $man or $version; if( @expression ) { $options->{_code} = join "\n", @expression; } else { return unless @ARGV; $options->{_code} = shift @ARGV; } return $options; } sub bad_encoding { my $options = shift; my $encoding = $options->{encoding}; return unless $encoding; return unless $encoding =~ /[^\s\w.-]/; return 1 } 1; __END__ =head1 NAME File::Rename::Options - Option processing for File::Rename =head1 SYNOPSIS use File::Rename::Options; my $options = File::Rename::Options::GetOptions() or pod2usage; use File::Rename::Options qw(no_require_order); =head1 DESCRIPTION =head2 CONFIGUATION The parameters to C are configurations settings for Getopt::Long The default configuration is posix_default and no_ignore_case; other settings are added to this list. =head2 FUNCTIONS =over 4 =item C Call C with options for rename script, returning a HASH of options. =item C Test if I does not look like an encoding =back =head2 OPTIONS See L script for options (in C<@ARGV>). See L for structure of the options HASH =head1 ENVIRONMENT No environment variables are used. =head1 SEE ALSO File::Rename(3), rename(1) =head1 AUTHOR Robin Barker =head1 DIAGNOSTICS Returns C when there is an error in the options. =head1 COPYRIGHT AND LICENSE Copyright (C) 2018, 2022, 2023 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8 or, at your option, any later version of Perl 5 you may have available. =cut File-Rename-2.02/lib/File/Rename/Unicode.pm0000644000000000000000000000277014544003004016777 0ustar rootrootpackage File::Rename::Unicode; use 5.032; # use 5.012; use strict; use warnings; use Encode qw(encode decode); our $VERSION = '1.30'; sub code { my $code = shift; my $encoding = shift; return sub { use feature 'unicode_strings'; if ( $encoding ) { $_ = decode($encoding, $_); } else { utf8::upgrade $_; } $code->(); if ( $encoding ) { $_ = encode($encoding, $_); } }; } 1; __END__ =head1 NAME File::Rename::Unicode - Unicode wrapper for user code for File::Rename =head1 SYNOPSIS require File::Rename::Unicode; my $sub = File::Rename::Unicode::code($code, $enc); =head1 DESCRIPTION =head2 FUNCTIONS =over 4 =item C Wrap the call to user code in utf8/unicode features. =back =head2 OPTIONS See L script --unicode option See L for unicode_strings option =head1 ENVIRONMENT No environment variables are used. =head1 SEE ALSO File::Rename(3), rename(1) =head1 AUTHOR Robin Barker =head1 DIAGNOSTICS None =head1 COPYRIGHT AND LICENSE Copyright (C) 2021 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8 or, at your option, any later version of Perl 5 you may have available. =cut File-Rename-2.02/META.yml0000644000000000000000000000117014544124356013477 0ustar rootroot--- abstract: 'Perl extension for renaming multiple files' author: - 'Robin Barker ' build_requires: ExtUtils::MakeMaker: '7.36' File::Temp: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '7.36' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: File-Rename no_index: directory: - t - inc requires: Getopt::Long: '2.24' perl: '5.008' version: '2.02' x_serialization_backend: 'CPAN::Meta::YAML version 0.018'