cpan/Pod-Simple/t/search12.t

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