File-Rename-1.10000755000000000000 013352440706 14052 5ustar00unknownunknown000000000000File-Rename-1.10/Build.PL000444000000000000 135513304623445 15507 0ustar00unknownunknown000000000000use 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, }, 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-1.10/CONTRIBUTING000444000000000000 16313350511540 16012 0ustar00unknownunknown000000000000CONTRIBUTING To report a bug or request a feature use https://rt.cpan.org/Dist/Display.html?Name=File-Rename File-Rename-1.10/Changes000444000000000000 464213352440167 15511 0ustar00unknownunknown000000000000Revision history for Perl extension File::Rename. 1.10 Robin Barker 2018-09-25 Added option --filename [-d] to rename filename component only Added option --fullpath [--path] to rename any part of path 1.09_04 Robin Barker 2018-09-19 Added CONTRIBUTING Fixed file 'log' which was supposed to be deleted 1.09_03 Robin Barker 2018-09-17 Change options to closer align to original feature request 1.09_02 Robin Barker 2018-09-16 Fix test failure for perl 5.14 1.09_01 Robin Barker 2018-09-16 Option for renaming file component only: filename-only/-d 1.00 Robin Barker 2018-07-03 File::Rename::Options module 0.99_02 Robin Barker 2018-06-26 Remove spurious C in t/File-Rename-script.t 0.99_01 Robin Barker 2018-06-12 File::Rename::Options in separate file 0.35 Robin Barker 2018-06-14 Add $File::Rename::Options::VERSION 0.33 Robin Barker 2018-06-13 Added return code for File::Rename::rename More tests: in preparation for v1.00 Add $File::Rename::Options::VERSION 0.32 Robin Barker 2018-06-08 - as 0.32-fix Fixed syntax of rmtree() for perl5.16 0.31 Robin Barker 2018-06-05 Removed use of s///r in tests Rewrote tests - more robust - use of testlib.pl 0.30 Robin Barker 2018-06-02 (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 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-1.10/MANIFEST000444000000000000 115713352440504 15340 0ustar00unknownunknown000000000000Changes CONTRIBUTING 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-filename-only.t t/File-Rename-import.t t/File-Rename-no-order.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-V.t t/pod.t t/pod-coverage.t t/testlib.pl lib/File/Rename.pm lib/File/Rename/Options.pm rename.PL examples/rename.pl META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) File-Rename-1.10/MANIFEST.SKIP000444000000000000 15013304623445 16061 0ustar00unknownunknown000000000000^RCS/ /RCS/ \.SKIP$ \.tar\.gz$ ^\.svn/ /\.svn/ ~$ ^MYMETA\. ^_build/ ^Build$ ^blib/ ^Kwalitee/ ^script/ File-Rename-1.10/META.json000444000000000000 264513352440706 15637 0ustar00unknownunknown000000000000{ "abstract" : "Perl extension for renaming multiple files", "author" : [ "Robin Barker " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.422", "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.4" } }, "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" : "1.10" }, "File::Rename::Options" : { "file" : "lib/File/Rename/Options.pm", "version" : "1.10" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "1.10", "x_serialization_backend" : "JSON::PP version 2.27400" } File-Rename-1.10/META.yml000444000000000000 156613352440706 15470 0ustar00unknownunknown000000000000--- abstract: 'Perl extension for renaming multiple files' author: - 'Robin Barker ' build_requires: File::Temp: '0' Test::More: '0' configure_requires: Module::Build: '0.4' dynamic_config: 1 generated_by: 'Module::Build version 0.422, 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 provides: File::Rename: file: lib/File/Rename.pm version: '1.10' File::Rename::Options: file: lib/File/Rename/Options.pm version: '1.10' 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: '1.10' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' File-Rename-1.10/Makefile.PL000444000000000000 137313314270364 16164 0ustar00unknownunknown000000000000# 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 ', NORECURS => 1, ); File-Rename-1.10/README000444000000000000 333413352437114 15071 0ustar00unknownunknown000000000000File-Rename version 1.10 ======================== 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. In 1.00, File::Require::Options is a separate module, and is not made visible by C. 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, 2018 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-1.10/rename.PL000444000000000000 732313350257646 15727 0ustar00unknownunknown000000000000use 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$$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 # use strict; require File::Rename; require File::Rename::Options; 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__; print ' using File::Rename version '. $File::Rename::VERSION; print ', File::Rename::Options version '. $File::Rename::Options::VERSION if (eval $File::Rename::Options::VERSION) < (eval $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<-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/\.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<-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<-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-1.10/examples000755000000000000 013352440706 15670 5ustar00unknownunknown000000000000File-Rename-1.10/examples/rename.pl000444000000000000 22613310175354 17607 0ustar00unknownunknown000000000000use strict; use File::Rename (); @ARGV = map glob, @ARGV if $^O =~ /Win/; File::Rename::rename \@ARGV, { _code => sub { $_ = lc }, verbose => 1 }; File-Rename-1.10/lib000755000000000000 013352440706 14620 5ustar00unknownunknown000000000000File-Rename-1.10/lib/File000755000000000000 013352440706 15477 5ustar00unknownunknown000000000000File-Rename-1.10/lib/File/Rename.pm000444000000000000 1223513352437004 17421 0ustar00unknownunknown000000000000package File::Rename; use strict; BEGIN { eval { require warnings; warnings->import } } our @EXPORT_OK = qw( rename ); our $VERSION = '1.10'; sub import { require Exporter; our @ISA = qw(Exporter); my( $pack ) = @_; $pack->export_to_level(1, @_); require File::Rename::Options; } sub rename_files { my $code = shift; my $options = shift; _default(\$options); my $errors; for (@_) { my $was = $_; if ( $options->{filename_only} ) { require File::Spec; my($vol, $dir, $file) = File::Spec->splitpath($_); $code->() for ($file); $_ = File::Spec->catpath($vol, $dir, $file); } else { $code->(); } 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 } } 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 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>. =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, 2018 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-1.10/lib/File/Rename000755000000000000 013352440706 16706 5ustar00unknownunknown000000000000File-Rename-1.10/lib/File/Rename/Options.pm000444000000000000 434713352437056 21050 0ustar00unknownunknown000000000000package File::Rename::Options; use strict; BEGIN { eval { require warnings; warnings->import } } use Getopt::Long (); use vars qw($VERSION); $VERSION = '1.10'; eval{ Getopt::Long::Configure qw( posix_default no_ignore_case no_require_order ); 1 } or do { require Carp; Carp::carp($@) }; 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; }, ) 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, }; 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; } 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; =head1 DESCRIPTION =over 4 =item C Call C with options for rename script, returning a HASH of options. =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 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-1.10/t000755000000000000 013352440706 14315 5ustar00unknownunknown000000000000File-Rename-1.10/t/File-Rename-E.t000444000000000000 175513306437675 17127 0ustar00unknownunknown000000000000# 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. unshift @INC, 't' if -d 't'; require 'testlib.pl'; 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-1.10/t/File-Rename-Options.t000444000000000000 117313314270364 20355 0ustar00unknownunknown000000000000# 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; $File::Rename::VERSION }, 'File::Rename::Option version not ahead of distribution version' ) File-Rename-1.10/t/File-Rename-V.t000444000000000000 210113314270364 17117 0ustar00unknownunknown000000000000# 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. unshift @INC, 't' if -d 't'; require 'testlib.pl'; # 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+)(_\d+)* ( , \s+ (\w+\:\:)+Rename\:\:\w+ \s+ version \s+ \d+(\.\d+)(_\d+)* )* $ }msx, "-V"); } File-Rename-1.10/t/File-Rename-filename-only.t000444000000000000 512113350225451 21453 0ustar00unknownunknown000000000000# 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-1.10/t/File-Rename-files.t000444000000000000 470313347504102 20022 0ustar00unknownunknown000000000000# 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-1.10/t/File-Rename-import.t000444000000000000 160013310172573 20226 0ustar00unknownunknown000000000000# 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-1.10/t/File-Rename-list-null.t000444000000000000 243513350551024 20642 0ustar00unknownunknown000000000000# 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-1.10/t/File-Rename-list.t000444000000000000 234113306437755 17705 0ustar00unknownunknown000000000000# 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-1.10/t/File-Rename-no-order.t000444000000000000 174613306437772 20466 0ustar00unknownunknown000000000000# 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. unshift @INC, 't' if -d 't'; require 'testlib.pl'; 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-1.10/t/File-Rename-require.t000444000000000000 151513310323651 20370 0ustar00unknownunknown000000000000# 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 $ok = eval q{ rename [1], 1, 1; 1; }; # require File::Rename does not import rename ok(!$ok, 'not imported rename()'); File-Rename-1.10/t/File-Rename-script.t000444000000000000 316713316646302 20234 0ustar00unknownunknown000000000000# 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. unshift @INC, 't' if -d 't'; require 'testlib.pl'; 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-1.10/t/File-Rename.t000444000000000000 254713306440052 16724 0ustar00unknownunknown000000000000# 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-1.10/t/pod-coverage.t000444000000000000 24113304623445 17167 0ustar00unknownunknown000000000000use 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-1.10/t/pod.t000444000000000000 20113304623445 15372 0ustar00unknownunknown000000000000use 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-1.10/t/testlib.pl000444000000000000 455513350772744 16476 0ustar00unknownunknown000000000000use strict; 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; for (@_) { create_file(File::Spec->catfile($d, $_), $_) or die; } } sub listdir { my $d = shift; local *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; local *FILE; if (open FILE, '>', $file) { print FILE @_; close FILE or die $!; return 1; } $file =~ s/\n/\\n/; 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, $print, $warn) = (); { local *STDOUT; open STDOUT, '>', \$print or die; $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 = @_; my $opt = do { require File::Rename::Options; File::Rename::Options::GetOptions(1); }; die "Bad options '@_'" unless $opt; die "Not options '@ARGV'" if @ARGV; return $opt; } 1;