88a74eb2b6901f329d6ca3e3b2a24884352b3375
[perl.git] / ext / Locale-Maketext / t / 01_about_verbose.t
1 #!/usr/bin/perl -Tw
2
3 require 5;
4
5 use strict;
6
7 use Test::More tests => 1;
8
9 BEGIN {
10     use_ok( 'Locale::Maketext' );
11 }
12
13 my @out;
14 push @out,
15     "\n\nPerl v",
16     defined($^V) ? sprintf('%vd', $^V) : $],
17     " under $^O ",
18     (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
19     ? ('(Win32::BuildNumber ', &Win32::BuildNumber(), ')') : (),
20     (defined $MacPerl::Version)
21     ? ("(MacPerl version $MacPerl::Version)") : (),
22     "\n"
23 ;
24
25 # Ugly code to walk the symbol tables:
26 my %v;
27 my @stack = ('');  # start out in %::
28 my $this;
29 my $count = 0;
30 my $pref;
31 while(@stack) {
32     $this = shift @stack;
33     die 'Too many packages?' if ++$count > 1000;
34     next if exists $v{$this};
35     next if $this eq 'main'; # %main:: is %::
36
37     no strict 'refs';
38     if ( defined ${$this . '::VERSION'} ) {
39         $v{$this} = ${$this . '::VERSION'}
40     }
41     elsif (
42         defined *{$this . '::ISA'} or defined &{$this . '::import'}
43             or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . '::'})
44         # If it has an ISA, an import, or any subs...
45     ) {
46         # It's a class/module with no version.
47         $v{$this} = undef;
48     }
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 }
57 push @out, " Modules in memory:\n";
58 delete @v{'', '[none]'};
59 foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
60     my $indent = ' ' x (2 + ($p =~ tr/:/:/));
61     push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
62 }
63 push @out, sprintf "[at %s (local) / %s (GMT)]\n", scalar(gmtime), scalar(localtime);
64 my $x = join '', @out;
65 $x =~ s/^/#/mg;
66 print $x;
67
68 my $ascii = (chr(65) eq 'A') ? 'an ASCII' : 'a non-ASCII';
69 print "# Running in $ascii world.\n";
70
71 print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
72
73 print "# \%INC:\n";
74 foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
75     print "#   [$x] = [", $INC{$x} || '', "]\n";
76 }