1BEGIN { 2 if($ENV{PERL_CORE}) { 3 chdir 't'; 4 @INC = '../lib'; 5 } 6} 7 8use strict; 9use Pod::Simple::Search; 10use Test; 11BEGIN { plan tests => 11 } 12 13print "# ", __FILE__, 14 ": Testing the surveying of the current directory...\n"; 15 16my $x = Pod::Simple::Search->new; 17die "Couldn't make an object!?" unless ok defined $x; 18 19$x->inc(0); 20 21use File::Spec; 22use Cwd; 23my $cwd = cwd(); 24print "# CWD: $cwd\n"; 25 26sub source_path { 27 my $file = shift; 28 if ($ENV{PERL_CORE}) { 29 require File::Spec; 30 my $updir = File::Spec->updir; 31 my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); 32 return File::Spec->catdir ($dir, $file); 33 } else { 34 return $file; 35 } 36} 37 38my $here; 39if( -e ($here = source_path('testlib1'))) { 40 chdir $here; 41} elsif(-e ($here = File::Spec->catdir($cwd, 't', 'testlib1'))) { 42 chdir $here; 43} else { 44 die "Can't find the test corpus"; 45} 46print "# OK, found the test corpus as $here\n"; 47ok 1; 48 49print $x->_state_as_string; 50#$x->verbose(12); 51 52use Pod::Simple; 53*pretty = \&Pod::Simple::BlackBox::pretty; 54 55my($name2where, $where2name) = $x->survey('.'); 56 57my $p = pretty( $where2name, $name2where )."\n"; 58$p =~ s/, +/,\n/g; 59$p =~ s/^/# /mg; 60print $p; 61 62{ 63my $names = join "|", sort values %$where2name; 64ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 65} 66 67{ 68my $names = join "|", sort keys %$name2where; 69ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 70} 71 72ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); 73 74ok grep( m/squaa\.pm/, keys %$where2name ), 1; 75 76###### Now with recurse(0) 77 78print "# Testing the surveying of a subdirectory with recursing off...\n"; 79 80$x->recurse(0); 81($name2where, $where2name) = $x->survey( 82 File::Spec->catdir($cwd, 't', 'testlib2')); 83 84$p = pretty( $where2name, $name2where )."\n"; 85$p =~ s/, +/,\n/g; 86$p =~ s/^/# /mg; 87print $p; 88 89{ 90my $names = lc join "|", sort values %$where2name; 91ok $names, "suzzle"; 92} 93 94{ 95my $names = lc join "|", sort keys %$name2where; 96ok $names, "suzzle"; 97} 98 99ok( ($name2where->{'Vliff'} || 'huh???'), 'huh???'); 100 101ok grep( m/Vliff\.pm/, keys %$where2name ), 0; 102 103ok 1; 104 105__END__ 106 107 108