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 scanning of several (well, two) docroots...\n";
15
16my $x = Pod::Simple::Search->new;
17die "Couldn't make an object!?" unless ok defined $x;
18
19$x->inc(0);
20
21$x->callback(sub {
22  print "#  ", join("  ", map "{$_}", @_), "\n";
23  return;
24});
25
26use File::Spec;
27use Cwd;
28my $cwd = cwd();
29print "# CWD: $cwd\n";
30
31sub source_path {
32    my $file = shift;
33    if ($ENV{PERL_CORE}) {
34        return "../lib/Pod/Simple/t/$file";
35    } else {
36        return $file;
37    }
38}
39
40my($here1, $here2);
41if(        -e ($here1 = source_path('testlib1'))) {
42  die "But where's $here2?"
43    unless -e ($here2 = source_path('testlib2'));
44} elsif(   -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1'      ))) {
45  die "But where's $here2?"
46    unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2'));
47} else {
48  die "Can't find the test corpora";
49}
50print "# OK, found the test corpora\n#  as $here1\n# and $here2\n";
51ok 1;
52
53print $x->_state_as_string;
54#$x->verbose(12);
55
56use Pod::Simple;
57*pretty = \&Pod::Simple::BlackBox::pretty;
58
59print "# OK, starting run...\n# [[\n";
60my($name2where, $where2name) = $x->survey($here1, $here2);
61print "# ]]\n#OK, run done.\n";
62
63my $p = pretty( $where2name, $name2where )."\n";
64$p =~ s/, +/,\n/g;
65$p =~ s/^/#  /mg;
66print $p;
67
68my $ascii_order;
69if(     -e ($ascii_order = source_path('ascii_order.pl'))) {
70  #
71} elsif(-e ($ascii_order = File::Spec->catfile($cwd, 't', 'ascii_order.pl'))) {
72  #
73} else {
74  die "Can't find ascii_order.pl";
75}
76
77require $ascii_order;
78
79{
80my $names = join "|", sort ascii_order values %$where2name;
81skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
82     $names,
83     "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
84}
85
86{
87my $names = join "|", sort ascii_order keys %$name2where;
88skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
89     $names,
90     "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
91}
92
93ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
94
95ok grep( m/squaa\.pm/, keys %$where2name ), 1;
96
97###### Now with recurse(0)
98
99$x->recurse(0);
100
101print "# OK, starting run without recurse...\n# [[\n";
102($name2where, $where2name) = $x->survey($here1, $here2);
103print "# ]]\n#OK, run without recurse done.\n";
104
105$p = pretty( $where2name, $name2where )."\n";
106$p =~ s/, +/,\n/g;
107$p =~ s/^/#  /mg;
108print $p;
109
110{
111my $names = join "|", sort ascii_order values %$where2name;
112skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
113     $names,
114     "Blorm|Suzzle|squaa|zikzik";
115}
116
117{
118my $names = join "|", sort ascii_order keys %$name2where;
119skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
120     $names,
121     "Blorm|Suzzle|squaa|zikzik";
122}
123
124ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
125
126ok grep( m/squaa\.pm/, keys %$where2name ), 1;
127
128ok 1;
129
130__END__
131
132