1# Summary of, well, things.
2
3use strict;
4use warnings;
5use Test::More;
6my @modules;
7BEGIN {
8  @modules = qw(
9
10Pod::Escapes
11
12Pod::Simple
13Pod::Simple::BlackBox
14Pod::Simple::Checker
15Pod::Simple::DumpAsText
16Pod::Simple::DumpAsXML
17Pod::Simple::HTML
18Pod::Simple::HTMLBatch
19Pod::Simple::HTMLLegacy
20Pod::Simple::LinkSection
21Pod::Simple::Methody
22Pod::Simple::JustPod
23Pod::Simple::Progress
24Pod::Simple::PullParser
25Pod::Simple::PullParserEndToken
26Pod::Simple::PullParserStartToken
27Pod::Simple::PullParserTextToken
28Pod::Simple::PullParserToken
29Pod::Simple::RTF
30Pod::Simple::Search
31Pod::Simple::SimpleTree
32Pod::Simple::Text
33Pod::Simple::TextContent
34Pod::Simple::TiedOutFH
35Pod::Simple::Transcode
36Pod::Simple::XMLOutStream
37
38  );
39  plan tests => scalar @modules;
40};
41
42#chdir "t" if -e "t";
43foreach my $m (@modules) {
44  print "# Loading $m ...\n";
45  eval "require $m;";
46  unless($@) { ok 1; next }
47  my $e = $@;
48  $e =~ s/\s+$//s;
49  $e =~ s/[\n\r]+/\n# > /;
50  print "# Error while trying to load $m --\n# > $e\n";
51  ok 0;
52}
53
54{
55  my @out;
56  push @out,
57    "\n\nPerl v",
58    defined($^V) ? sprintf('%vd', $^V) : $],
59    " under $^O ",
60    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
61      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
62    (defined $MacPerl::Version)
63      ? ("(MacPerl version $MacPerl::Version)") : (),
64    "\n"
65  ;
66
67  # Ugly code to walk the symbol tables:
68  my %v;
69  my @stack = ('');  # start out in %::
70  my $this;
71  my $count = 0;
72  my $pref;
73  while(@stack) {
74    $this = shift @stack;
75    die "Too many packages?" if ++$count > 1000;
76    next if exists $v{$this};
77    next if $this eq 'main'; # %main:: is %::
78
79    #print "Peeking at $this => ${$this . '::VERSION'}\n";
80    no strict 'refs';
81    if( defined ${$this . '::VERSION'} ) {
82      $v{$this} = ${$this . '::VERSION'}
83    } elsif(
84       defined *{$this . '::ISA'} or defined &{$this . '::import'}
85       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
86       # If it has an ISA, an import, or any subs...
87    ) {
88      # It's a class/module with no version.
89      $v{$this} = undef;
90    } else {
91      # It's probably an unpopulated package.
92      ## $v{$this} = '...';
93    }
94
95    $pref = length($this) ? "$this\::" : '';
96    push @stack, map m/^(.+)::$/ ? "$pref$1" : (),
97        do { no strict 'refs'; keys %{$this . '::'} };
98    #print "Stack: @stack\n";
99  }
100  push @out, " Modules in memory:\n";
101  delete @v{'', '[none]'};
102  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
103    my $indent = ' ' x (2 + ($p =~ tr/:/:/));
104    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
105  }
106  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
107    scalar(gmtime), scalar(localtime);
108  my $x = join '', @out;
109  $x =~ s/^/#/mg;
110  print $x;
111}
112
113print "# Running",
114  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
115  "#\n",
116;
117
118print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
119
120print "# \%INC:\n";
121foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
122  print "#   [$x] = [", $INC{$x} || '', "]\n";
123}
124
125