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