File-Rename-0.20000755001750001750 012140156771 13130 5ustar00robinrobin000000000000File-Rename-0.20/MANIFEST000444001750001750 53712140156771 14403 0ustar00robinrobin000000000000Changes Build.PL Makefile.PL MANIFEST MANIFEST.SKIP README t/File-Rename.t t/File-Rename-E.t t/File-Rename-files.t t/File-Rename-script.t t/File-Rename-list.t t/File-Rename-V.t t/pod.t t/pod-coverage.t lib/File/Rename.pm rename.PL examples/rename.pl META.json Module meta-data (added by Module::Build) META.yml Module meta-data (added by MakeMaker) File-Rename-0.20/rename.PL000444001750001750 643512140156771 15001 0ustar00robinrobin000000000000use strict; use File::Basename qw(dirname); use File::Path qw(mkpath); my $file = shift; unless( -d( my $dir = dirname $file ) ) { mkpath $dir, 1 } open OUT, '>'. $file or die "$0 can't open $file: $!\n"; print OUT "#!perl -w\n"; print OUT while ; close OUT or die $!; exit; __END__ # $Revision: 331 $$Date: 2013-04-30 21:23:41 +0100 (Tue, 30 Apr 2013) $ # 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 # use strict; use File::Rename (); use Pod::Usage; main() unless caller; sub main { my $options = File::Rename::Options::GetOptions or pod2usage; 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__ . ' using File::Rename version '. $File::Rename::VERSION ."\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<-n> ]> S<[ B<-f> ]> 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. For example, to rename all files matching C<*.bak> to strip the extension, you might say rename 's/\e.bak$//' *.bak To translate uppercase names to lower, you'd use rename 'y/A-Z/a-z/' * =head1 OPTIONS =over 8 =item B<-v>, B<-verbose> Verbose: print names of files successfully renamed. =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<-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<-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. I hope I've fixed that (Robin Barker). =cut File-Rename-0.20/META.json000444001750001750 250212140156771 14705 0ustar00robinrobin000000000000{ "abstract" : "Perl extension for renaming multiple files", "author" : [ "Robin Barker " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4005, CPAN::Meta::Converter version 2.112621", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "File-Rename", "prereqs" : { "build" : { "requires" : { "File::Temp" : 0, "Test::More" : 0 } }, "configure" : { "requires" : { "Module::Build" : "0.38" } }, "runtime" : { "recommends" : { "File::Spec" : "0.82", "Getopt::Long" : "2.24", "Test::Pod" : 0, "Test::Pod::Coverage" : 0 }, "requires" : { "Getopt::Long" : 0, "perl" : "5" } } }, "provides" : { "File::Rename" : { "file" : "lib/File/Rename.pm", "version" : "0.20" }, "File::Rename::Options" : { "file" : "lib/File/Rename.pm", "version" : 0 } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.20" } File-Rename-0.20/Build.PL000444001750001750 144112140156771 14561 0ustar00robinrobin000000000000use strict; use Module::Build; use File::Spec; my $script = File::Spec->catfile( 'script', Module::Build->os_type eq 'Windows' ? 'file-rename' : 'rename' ); Module::Build -> new ( license => 'perl', script_files => [ $script ], module_name => 'File::Rename', PL_files => { 'rename.PL' => $script }, # create_makefile_pl => 'traditional' requires => { 'Getopt::Long' => 0, perl => 5, }, configure_requires => { 'Module::Build' => 0.40 }, build_requires => { 'File::Temp' => 0, 'Test::More' => 0, }, configure_requires => { 'Module::Build' => 0.38 }, recommends => { 'Getopt::Long' => 2.24, # for Configure qw(posix_default); 'Test::Pod' => 0, 'File::Spec' => 0.82, # required for Pod::Parser, for ... 'Test::Pod::Coverage' => 0, } ) -> create_build_script; File-Rename-0.20/Makefile.PL000444001750001750 135012140156771 15236 0ustar00robinrobin000000000000# Based on earlier h2xs output and # output from Module::Build::Compat version 0.03 use strict; use File::Spec; my $script = File::Spec->catfile( 'script', $^O =~ /win/i ? 'file-rename' : 'rename' ); use ExtUtils::MakeMaker; WriteMakefile( NAME => 'File::Rename', VERSION_FROM => 'lib/File/Rename.pm', INSTALLDIRS => 'site', PREREQ_PM => { 'Getopt::Long' => 0, # recommend 2.24 for posix_default 'File::Temp' => 0, # for testing 'Test::More' => 0, # for testing(!) }, EXE_FILES => [ $script ], PL_FILES => { 'rename.PL' => $script }, ABSTRACT_FROM => 'lib/File/Rename.pm', # retrieve abstract from module AUTHOR => 'Robin Barker ', ); File-Rename-0.20/META.yml000444001750001750 136612140156771 14544 0ustar00robinrobin000000000000--- abstract: 'Perl extension for renaming multiple files' author: - 'Robin Barker ' build_requires: File::Temp: 0 Test::More: 0 configure_requires: Module::Build: 0.38 dynamic_config: 1 generated_by: 'Module::Build version 0.4005, CPAN::Meta::Converter version 2.112621' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: File-Rename provides: File::Rename: file: lib/File/Rename.pm version: 0.20 File::Rename::Options: file: lib/File/Rename.pm version: 0 recommends: File::Spec: 0.82 Getopt::Long: 2.24 Test::Pod: 0 Test::Pod::Coverage: 0 requires: Getopt::Long: 0 perl: 5 resources: license: http://dev.perl.org/licenses/ version: 0.20 File-Rename-0.20/MANIFEST.SKIP000444001750001750 15012140156771 15137 0ustar00robinrobin000000000000^RCS/ /RCS/ \.SKIP$ \.tar\.gz$ ^\.svn/ /\.svn/ ~$ ^MYMETA\. ^_build/ ^Build$ ^blib/ ^Kwalitee/ ^script/ File-Rename-0.20/README000444001750001750 315212140156771 14146 0ustar00robinrobin000000000000File-Rename version 0.20 ======================== File::Rename provides an implementation of Larry Wall's eg/rename command. All I have done is add some error checking and (more recently) add the File/Rename.pm module. 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. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install or if you have Module::Build perl Build.PL perl Build perl Build test perl Build install DEPENDENCIES This module requires these other modules and libraries: File::Basename File::Path File::Spec Getopt::Long (all included with Perl). Testing requires File::Temp and Test::More which are available with perl 5.6.0. I have successfully installed those modules for perl 5.005_05 and tested this module. COPYRIGHT AND LICENCE Copyright (C) 2005, 2006, 2007, 2011 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-0.20/Changes000444001750001750 210612140156771 14557 0ustar00robinrobin000000000000Revision history for Perl extension File::Rename. 0.20 Robin Barker 2013-04-30 Added option -E (statement): alternative to -e 0.10 Robin Barker 2013-04-29 Merged "0.09 (beta for 0.10)" from 2006-06-26 Added option -V (version). 0.09 (beta for 0.10) Robin Barker 2006-06-26 - not released Added options -e, -f, -n and -V (version). Options -e, -f, -n suggested by code written by Aristotle Pagaltzis. 0.06 Robin Barker 2011-09-23 Added example/rename.pl, dealt with other Kwalitee metrics. Updated META files 0.05 Robin Barker 2007-10-03 Removed perl 5.6.0 dependencies and successfully tested on perl 5.005_05 (with patched Temp::File). 0.04 Robin Barker 2007-09-27 Replaced depencies on perl versions by explicit requirements on modules in Build.PL/Makefile.PL 0.03 Robin Barker 2007-09-26 Added --force and --nono options (over_write, no_action) 0.02 Robin Barker 2006-01-13 Added t/pod*.t, and extended POD to pass tests 0.01 Mon Dec 13 17:54:05 2004 - original version; created by h2xs 1.23 with options -XAn File::Rename File-Rename-0.20/lib000755001750001750 012140156771 13676 5ustar00robinrobin000000000000File-Rename-0.20/lib/File000755001750001750 012140156771 14555 5ustar00robinrobin000000000000File-Rename-0.20/lib/File/Rename.pm000444001750001750 1240012140156771 16474 0ustar00robinrobin000000000000package File::Rename; use strict; BEGIN { eval { require warnings; warnings->import } } package File::Rename::Options; use Getopt::Long (); eval{ Getopt::Long::Configure qw( posix_default no_ignore_case ); 1 } or warn $@; sub GetOptions { my @expression; Getopt::Long::GetOptions( '-v|verbose' => \my $verbose, '-n|nono' => \my $nono, '-f|force' => \my $force, '-h|?|help' => \my $help, '-m|man' => \my $man, '-V|version' => \my $version, '-e=s' => \@expression, '-E=s' => sub { my(undef, $e) = @_; $e .= ';'; push @expression, $e; }, ) or return; my $options = { verbose => $verbose, no_action => $nono, over_write => $force, show_help => $help, show_manual => $man, show_version => $version, }; 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; } package File::Rename; use base qw(Exporter); use vars qw(@EXPORT_OK $VERSION); @EXPORT_OK = qw( rename ); $VERSION = '0.20'; sub rename_files { my $code = shift; my $options = shift; _default(\$options); for (@_) { my $was = $_; $code->(); if( $was eq $_ ){ } # ignore quietly elsif( -e $_ and not $options->{over_write} ) { warn "$was not renamed: $_ already exists\n"; } 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"; } } } 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}; chop(my @file = <$fh>); rename_files $code, $options, @file; } sub rename { my($argv, $code, $verbose) = @_; if( ref $code ) { if( 'HASH' eq ref $code ) { require Carp; if(defined $verbose ) { Carp::carp(<{_code} or Carp::carp(< $verbose } } 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'; =head1 DESCRIPTION =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 =item CODE Subroutine to change file names, for C can be a string, otherside 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 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 Print help, provided by B<-h>. =item B Print manual page, provided by B<-m>. =item B Print version number, provided by B<-V>. =back =head2 EXPORT None by default. =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 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-0.20/examples000755001750001750 012140156771 14746 5ustar00robinrobin000000000000File-Rename-0.20/examples/rename.pl000444001750001750 22512140156771 16666 0ustar00robinrobin000000000000use strict; use File::Rename (); @ARGV = map glob, @ARGV if $^O =~ /Win/; File::Rename::rename @ARGV, { _code => sub { $_ = lc }, verbose => 1 }; File-Rename-0.20/t000755001750001750 012140156771 13373 5ustar00robinrobin000000000000File-Rename-0.20/t/File-Rename-script.t000444001750001750 372512140156771 17312 0ustar00robinrobin000000000000# 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 => 4; BEGIN { push @INC, qw(blib/script) if -d 'blib' }; my $script = ($^O =~ m{Win} ? 'file-rename' : 'rename'); my $require_ok = eval { require($script) }; ok( $require_ok, 'require script - '. $script); die $@ unless $require_ok; 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. use File::Spec; use File::Path (); my $dir = 'temp'; File::Path::rmtree $dir if -d $dir; File::Path::mkpath $dir; sub create (@) { for (@_) { open my $fh, '>', File::Spec->catfile($dir, $_) or die $!; close $fh or die $!; } } create qw(bing.txt bong.txt); sub main_argv { local @ARGV = @_; main () } # test 2 main_argv( 's/i/a/', glob File::Spec->catfile($dir,'b*') ); opendir DIR, $dir or die $!; is_deeply( [ sort grep !/^\./, readdir DIR ], [qw(bang.txt bong.txt)], 'rename - files' ); closedir DIR or die $!; # 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"; opendir DIR, $dir or die $!; is_deeply( [ sort grep !/^\./, readdir DIR ], [qw(bang.txt bug.txt)], 'rename - list' ); closedir DIR or die $!; File::Path::rmtree $dir; File-Rename-0.20/t/pod.t000444001750001750 20112140156771 14450 0ustar00robinrobin000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); File-Rename-0.20/t/File-Rename-E.t000444001750001750 242212140156771 16163 0ustar00robinrobin000000000000# 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; BEGIN { push @INC, qw(blib/script) if -d 'blib' }; my $script = ($^O =~ m{Win} ? 'file-rename' : 'rename'); 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. use File::Spec; use File::Path (); my $dir = 'temp'; File::Path::rmtree $dir if -d $dir; File::Path::mkpath $dir; sub create (@) { for (@_) { open my $fh, '>', File::Spec->catfile($dir, $_) or die $!; close $fh or die $!; } } create qw(bing.txt bong.txt); sub main_argv { local @ARGV = @_; main () } # test 2 main_argv('-E', 's/i/a/', '-E', 's/g/j/', glob File::Spec->catfile($dir,'b*') ); opendir DIR, $dir or die $!; is_deeply( [ sort grep !/^\./, readdir DIR ], [qw(banj.txt bonj.txt)], 'rename - files' ); closedir DIR or die $!; File::Path::rmtree $dir; File-Rename-0.20/t/pod-coverage.t000444001750001750 24112140156771 16245 0ustar00robinrobin000000000000use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); File-Rename-0.20/t/File-Rename-list.t000444001750001750 454512140156771 16762 0ustar00robinrobin000000000000# 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. use File::Path; use File::Temp; my $dir = File::Temp::tempdir; chdir $dir or die; my $file = 'list.txt'; create_file($file); sub create_file { my($file) = @_; local *FILE; open FILE, '>'. $file or die "Can't create $file: $!\n"; # print FILE "This is $file\n" or die $!; close FILE or die $!; } my $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; my $print; my $found; sub test_rename { my($sub, $fh, $verbose, $warning, $printed) = @_; { local *STDOUT; open STDOUT, '>'. 'log' or die "Can't create log file: $!\n"; undef $warn; File::Rename::rename_list($sub, $verbose, $fh); close STDOUT or die; } { local *READ; open READ, '<'. 'log' or die "Can't read log file: $!\n"; local $/; $print = ; close READ or die; } undef $found; 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( $warn ) { $warn =~ s/^/WARN: /mg; diag $warn; } if( $print ) { $print =~ s/^/PRINT: /mg; diag $print; } } 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; rmtree $dir; ok( !-d $dir, "test dir removed"); } File-Rename-0.20/t/File-Rename.t000444001750001750 330612140156771 16003 0ustar00robinrobin000000000000# 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. use File::Spec; use File::Path (); my $dir = 'temp'; File::Path::rmtree $dir if -d $dir; File::Path::mkpath $dir; sub create (@) { for (@_) { local *FILE; open FILE, '>'. File::Spec->catfile($dir, $_) or die $!; print FILE "This is @_\n"; close FILE or die $!; } } create qw(bing.txt bong.txt); # test 2 File::Rename::rename( [ glob File::Spec->catfile($dir,'b*') ], 's/i/a/' ); opendir DIR, $dir or die $!; is_deeply( [ sort grep !/^\./, readdir DIR ], [qw(bang.txt bong.txt)], 'rename - files' ); closedir DIR or die $!; # 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"; opendir DIR, $dir or die $!; is_deeply( [ sort grep !/^\./, readdir DIR ], [qw(bang.txt bug.txt)], 'rename - list' ); closedir DIR or die $!; File::Path::rmtree $dir; File-Rename-0.20/t/File-Rename-V.t000444001750001750 175312140156771 16212 0ustar00robinrobin000000000000# 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; BEGIN { push @INC, qw(blib/script) if -d 'blib' }; my $script = ($^O =~ m{Win} ? 'file-rename' : 'rename'); 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. sub main_argv { local @ARGV = @_; main (); } # test 2 my $buffer; close STDOUT; open STDOUT, '>', \$buffer or diag $!; main_argv('-V'); END{ close STDOUT or diag $!; like( $buffer, qr{ \b $script \s+ using \s+ (\w+\:\:)+Rename \s+ version \s+ \d+(\.\d+)+[a-z]* $ }msx, "-V"); } File-Rename-0.20/t/File-Rename-files.t000444001750001750 710312140156771 17102 0ustar00robinrobin000000000000# 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. use File::Path; use File::Spec; use File::Temp; my $dir = 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) } sub create_file { my($file) = @_; local *FILE; open FILE, '>'. $file or die "Can't create $file: $!\n"; print FILE "This is $file\n" or die $!; close FILE or die $!; } my $warn; local $SIG{__WARN__} = sub { $warn .= $_[0] }; my $print; my $found; sub test_rename { my($sub, $file, $verbose, $warning, $printed) = @_; { local *STDOUT; open STDOUT, '>'. 'log' or die "Can't create log file: $!\n"; undef $warn; File::Rename::rename_files($sub, $verbose, $file); close STDOUT or die; } { local *READ; open READ, '<'. 'log' or die "Can't read log file: $!\n"; local $/; $print = ; close READ or die; } undef $found; 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( $warn ) { $warn =~ s/^/WARN: /mg; diag $warn; } if( $print ) { $print =~ s/^/PRINT: /mg; diag $print; } } 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; rmtree $dir; ok( !-d $dir, "test dir removed"); }