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