t/pod/find.t

   1 # Testing of Pod::Find
   2 # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
   3
   4 $| = 1;
   5
   6 use Test;
   7
   8 BEGIN {
   9   plan tests => 4;
  10   use File::Spec;
  11   if ($^O eq 'VMS') {
  12      # This magick is needed to make the VMS I/O system to believe
  13      # that there's life after eight directory levels (this makes
  14      # it believe there's life until sixteen levels).  The filesystem
  15      # has no limitation as such.
  16      $DEFAULT_DIR = $ENV{'DEFAULT'};
  17      my $here = $DEFAULT_DIR;
  18      my ($dev,$dir) = File::Spec->splitpath($here);
  19      $dev =~ s/:$//;
  20      $dev = $ENV{$dev} if exists($ENV{$dev});
  21      $dev .= ':' if $dev !~ /:/;
  22      $here = File::Spec->canonpath($dev.$dir);
  23      $here =~ s/\]$/.]/;
  24      system "define/nolog/job/trans=conceal temp_perl_base $here";
  25      chdir('temp_perl_base:[000000]');
  26   }
  27 }
  28
  29 END {
  30     chdir($DEFAULT_DIR) if $^O eq 'VMS';
  31     system "deassign/job temp_perl_base";
  32 }
  33
  34 use Pod::Find qw(pod_find pod_where);
  35
  36 # load successful
  37 ok(1);
  38
  39 require Cwd;
  40 my $VERBOSE = 0;
  41 my $lib_dir = File::Spec->catdir('pod', 'testpods', 'lib');
  42 if ($^O eq 'VMS') {
  43     $lib_dir = VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'));
  44     $Qlib_dir = $lib_dir;
  45     $Qlib_dir =~ s#\/#::#g;
  46 }
  47 print "### searching $lib_dir\n";
  48 my %pods = pod_find($lib_dir);
  49 my $result = join(',', sort values %pods);
  50 my $compare = join(',', sort qw(
  51     Pod::Stuff
  52     Pod::Rhubarb
  53     Like::And::Yeah
  54 ));
  55 if ($^O eq 'VMS') {
  56     $compare = lc($compare);
  57     $result = join(',', sort values %pods);
  58     my $undollared = $Qlib_dir;
  59     $undollared =~ s/\$/\\\$/g;
  60     $undollared =~ s/\-/\\\-/g;
  61     $result =~ s/$undollared/pod::/g;
  62     my $count = 0;
  63     my @result = split(/,/,$result);
  64     my @compare = split(/,/,$compare);
  65     foreach(@compare) {
  66         $count += grep {/$_/} @result;
  67     }
  68     ok($count/($#result+1)-1,$#compare);
  69 }
  70 else {
  71     ok($result,$compare);
  72 }
  73
  74
  75 print "### searching for File::Find\n";
  76 $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
  77   || 'undef - pod not found!';
  78 print "### found $result\n";
  79
  80 require Config;
  81 if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
  82     $compare = "lib.File]Find.pm";
  83     $result =~ s/perl_root:\[\-?\.?//i;
  84     $result =~ s/\[\-?\.?//i; # needed under `mms test`
  85     ok($result,$compare);
  86 }
  87 else {
  88     $compare = File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm');
  89     ok(_canon($result),_canon($compare));
  90 }
  91
  92 # Search for a documentation pod rather than a module
  93 print "### searching for Stuff.pod\n";
  94 my $search = File::Spec->catdir('pod', 'testpods', 'lib', 'Pod');
  95 $result = pod_where({ -dirs => [$search], -verbose => $VERBOSE }, 'Stuff')
  96   || 'undef - Stuff.pod not found!';
  97 print "### found $result\n";
  98
  99 $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pod');
 100 ok(_canon($result),_canon($compare));
 101
 102 # make the path as generic as possible
 103 sub _canon
 104 {
 105   my ($path) = @_;
 106   $path = File::Spec->canonpath($path);
 107   my @comp = File::Spec->splitpath($path);
 108   my @dir = File::Spec->splitdir($comp[1]);
 109   $comp[1] = File::Spec->catdir(@dir);
 110   $path = File::Spec->catpath(@dir);
 111   $path = uc($path) if File::Spec->case_tolerant;
 112   $path;
 113 }
 114