1use strict; 2 3use Test::More; 4 5push @INC, qw(blib/script) if -d 'blib'; 6unshift @INC, qw(t) if -d 't'; 7require 'testlib.pl'; 8 9eval { require Pod::Parser } or 10 plan skip_all => qq(No Pod::Parser\n$@); 11 12package File::Rename::Test::Parser; 13our @ISA = qw(Pod::Parser); 14our $key = __PACKAGE__; 15 16sub begin_pod { shift->{$key} = []; } 17sub command { return } 18sub textblock { return } 19sub interior_sequence { return } 20sub verbatim { 21 my ($self, $text) = @_; 22 push @{$self->{$key}}, $text; 23} 24 25sub data { @{shift->{$key}} } 26 27package main; 28 29my $generic = 'rename'; 30my $script = script_name(); 31eval { require($script) } or 32 BAIL_OUT qq{Can't require $script\n$@}; 33 34my $inc_script = $INC{$script}; 35BAIL_OUT "\$INC($script) = '$inc_script', missing\n" 36 unless $inc_script and -e $inc_script; 37 38my $parser = File::Rename::Test::Parser->new; 39$parser->parse_from_file( $inc_script ); 40my @examples = grep /\s+$generic\s/, $parser->data; 41 42######################### 43 44# Insert your test code below, the Test::More 45# module is use()ed here so read its man page 46# ( perldoc Test::More ) 47# for help writing this test script. 48 49plan tests => 2 + (@examples || 1); 50like( $inc_script, qr{/ $script \z}msx, 51 "required $script is $inc_script"); 52ok( scalar(@examples) > 1, 53 "enough examples in $inc_script" ); 54# Larry Wall wrote 2 examples in 1992! 55 56unshift @INC, 't' if -d 't'; 57require 'testlib.pl'; 58 59for ( @examples ) { 60 s/\n+\z//; 61 my $example = $_; 62 s/\A\s+$generic\s+//; 63 64 my @args = split; 65 for (@args) { s/\A'(.*)'\z/$1/; } 66 67 my $dir = tempdir(); 68 create(qw(1 foo.bak baa)); 69 chdir $dir or die $!; 70 mkdir 'my_new_dir' or die $!; 71 72 if ( $args[-1] =~ /\A\*/ ) { 73 my @glob = glob(pop @args); 74 push @args, @glob; 75 } 76 77 my $ok = eval { main_argv( @args ); 1 }; 78 ok( $ok, "example:$example" ); 79 diag $@ unless $ok; 80 81 chdir File::Spec->updir or die $!; 82 File::Path::rmtree($dir) or die $!; 83} 84 85