Commit | Line | Data |
7b43481a |
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; |
16be52b8 |
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"); |
e4dfc136 |
27 | my $result = join("\n### ", sort values %pods); |
16be52b8 |
28 | print "### found $result\n"; |
7b43481a |
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 | )); |
16be52b8 |
39 | if ($^O eq 'VMS') { |
40 | $compare = lc($compare); |
051b35bf |
41 | $result = join(',', sort grep(/pod::/, values %pods)); |
e4dfc136 |
42 | my $undollared = $Qlib_dir; |
43 | $undollared =~ s/\$/\\\$/g; |
44 | $undollared =~ s/\-/\\\-/g; |
45 | $result =~ s/$undollared/pod::/g; |
16be52b8 |
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 | } |
7b43481a |
57 | |
58 | # File::Find is located in this place since eons |
59 | # and on all platforms, hopefully |
60 | |
16be52b8 |
61 | print "### searching for File::Find\n"; |
7b43481a |
62 | $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find') |
63 | || 'undef - pod not found!'; |
16be52b8 |
64 | print "### found $result\n"; |
7b43481a |
65 | |
66 | require Config; |
16be52b8 |
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 | } |
7b43481a |
77 | |
78 | # Search for a documentation pod rather than a module |
16be52b8 |
79 | print "### searching for perlfunc.pod\n"; |
7b43481a |
80 | $result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'perlfunc') |
81 | || 'undef - perlfunc.pod not found!'; |
16be52b8 |
82 | print "### found $result\n"; |
7b43481a |
83 | |
16be52b8 |
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 | } |
7b43481a |
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 | |