1require 5;
2# Time-stamp: "2004-04-24 16:53:03 ADT"
3
4# Summary of, well, things.
5
6use Test;
7BEGIN {plan tests => 2};
8
9ok 1;
10
11{
12  my @out;
13  push @out,
14    "\n\nPerl v",
15    defined($^V) ? sprintf('%vd', $^V) : $],
16    " under $^O ",
17    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
18      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
19    (defined $MacPerl::Version)
20      ? ("(MacPerl version $MacPerl::Version)") : (),
21    "\n"
22  ;
23
24  # Ugly code to walk the symbol tables:
25  my %v;
26  my @stack = ('');  # start out in %::
27  my $this;
28  my $count = 0;
29  my $pref;
30  while(@stack) {
31    $this = shift @stack;
32    die "Too many packages?" if ++$count > 1000;
33    next if exists $v{$this};
34    next if $this eq 'main'; # %main:: is %::
35
36    #print "Peeking at $this => ${$this . '::VERSION'}\n";
37
38    if(defined ${$this . '::VERSION'} ) {
39      $v{$this} = ${$this . '::VERSION'}
40    } elsif(
41       defined *{$this . '::ISA'} or defined &{$this . '::import'}
42       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
43       # If it has an ISA, an import, or any subs...
44    ) {
45      # It's a class/module with no version.
46      $v{$this} = undef;
47    } else {
48      # It's probably an unpopulated package.
49      ## $v{$this} = '...';
50    }
51
52    $pref = length($this) ? "$this\::" : '';
53    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
54    #print "Stack: @stack\n";
55  }
56  push @out, " Modules in memory:\n";
57  delete @v{'', '[none]'};
58  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
59    $indent = ' ' x (2 + ($p =~ tr/:/:/));
60    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
61  }
62  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
63    scalar(gmtime), scalar(localtime);
64  my $x = join '', @out;
65  $x =~ s/^/#/mg;
66  print $x;
67}
68
69print "# Running",
70  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
71  "#\n",
72;
73
74print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
75
76print "# \%INC:\n";
77foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
78  print "#   [$x] = [", $INC{$x} || '', "]\n";
79}
80
81ok 1;
82
83