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 { plan tests => 4 }
   9
  10 use Pod::Find qw(pod_find pod_where);
  11 use File::Spec;
  12
  13 # load successful
  14 ok(1);
  15
  16 require Cwd;
  17 my $THISDIR = Cwd::cwd();
  18 my $VERBOSE = 0;
  19 my $lib_dir = File::Spec->catdir($THISDIR,'lib');
  20 if ($^O eq 'VMS') {
  21     $lib_dir = VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
  22     $Qlib_dir = $lib_dir;
  23     $Qlib_dir =~ s#\/#::#g;
  24 }
  25 print "### searching $lib_dir\n";
  26 my %pods = pod_find("$lib_dir");
  27 my $result = join("\n### ", sort values %pods);
  28 print "### found $result\n";
  29 my $compare = join(',', qw(
  30     Pod::Checker
  31     Pod::Find
  32     Pod::InputObjects
  33     Pod::ParseUtils
  34     Pod::Parser
  35     Pod::PlainText
  36     Pod::Select
  37     Pod::Usage
  38 ));
  39 if ($^O eq 'VMS') {
  40     $compare = lc($compare);
  41     $result = join(',', sort grep(/pod::/, values %pods));
  42     my $undollared = $Qlib_dir;
  43     $undollared =~ s/\$/\\\$/g;
  44     $undollared =~ s/\-/\\\-/g;
  45     $result =~ s/$undollared/pod::/g;
  46     my $count = 0;
  47     my @result = split(/,/,$result);
  48     my @compare = split(/,/,$compare);
  49     foreach(@compare) {
  50         $count += grep {/$_/} @result;
  51     }
  52     ok($count/($#result+1)-1,$#compare);
  53 }
  54 else {
  55     ok($result,$compare);
  56 }
  57
  58 # File::Find is located in this place since eons
  59 # and on all platforms, hopefully
  60
  61 print "### searching for File::Find\n";
  62 $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
  63   || 'undef - pod not found!';
  64 print "### found $result\n";
  65
  66 require Config;
  67 if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
  68     $compare = "lib.File]Find.pm";
  69     $result =~ s/perl_root:\[\-?\.?//i;
  70     $result =~ s/\[\-?\.?//i; # needed under `mms test`
  71     ok($result,$compare);
  72 }
  73 else {
  74     $compare = File::Spec->catfile($Config::Config{privlib},"File","Find.pm");
  75     ok(_canon($result),_canon($compare));
  76 }
  77
  78 # Search for a documentation pod rather than a module
  79 print "### searching for perlfunc.pod\n";
  80 $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'perlfunc')
  81   || 'undef - perlfunc.pod not found!';
  82 print "### found $result\n";
  83
  84 if ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
  85     $compare = "/lib/pod/perlfunc.pod";
  86     $result = VMS::Filespec::unixify($result);
  87     $result =~ s/perl_root\///i;
  88     $result =~ s/^\.\.//;  # needed under `mms test`
  89     ok($result,$compare);
  90 }
  91 else {
  92     $compare = File::Spec->catfile($Config::Config{privlib},"perlfunc.pod");
  93     ok(_canon($result),_canon($compare));
  94 }
  95
  96 # make the path as generic as possible
  97 sub _canon
  98 {
  99   my ($path) = @_;
 100   $path = File::Spec->canonpath($path);
 101   my @comp = File::Spec->splitpath($path);
 102   my @dir = File::Spec->splitdir($comp[1]);
 103   $comp[1] = File::Spec->catdir(@dir);
 104   $path = File::Spec->catpath(@dir);
 105   $path = uc($path) if File::Spec->case_tolerant;
 106   $path;
 107 }
 108