require
5;
BEGIN {plan
tests
=> 2};
ok 1;
{
my
@out
;
push
@out
,
"\n\nPerl v"
,
defined
($^V) ?
sprintf
(
'%vd'
, $^V) : $],
" under $^O "
,
(
defined
(
&Win32::BuildNumber
) and
defined
&Win32::BuildNumber
())
? (
"(Win32::BuildNumber "
,
&Win32::BuildNumber
(),
")"
) : (),
(
defined
$MacPerl::Version
)
? (
"(MacPerl version $MacPerl::Version)"
) : (),
"\n"
;
my
%v
;
my
@stack
= (
''
);
my
$this
;
my
$count
= 0;
my
$pref
;
while
(
@stack
) {
$this
=
shift
@stack
;
die
"Too many packages?"
if
++
$count
> 1000;
next
if
exists
$v
{
$this
};
next
if
$this
eq
'main'
;
if
(
defined
${
$this
.
'::VERSION'
} ) {
$v
{
$this
} = ${
$this
.
'::VERSION'
}
}
elsif
(
defined
*{
$this
.
'::ISA'
} or
defined
&{
$this
.
'::import'
}
or (
$this
ne
''
and
grep
defined
*{
$_
}{
'CODE'
},
values
%{
$this
.
"::"
})
) {
$v
{
$this
} =
undef
;
}
else
{
}
$pref
=
length
(
$this
) ?
"$this\::"
:
''
;
push
@stack
,
map
m/^(.+)::$/ ?
"$pref$1"
: (),
keys
%{
$this
.
'::'
};
}
push
@out
,
" Modules in memory:\n"
;
delete
@v
{
''
,
'[none]'
};
foreach
my
$p
(
sort
{
lc
(
$a
) cmp
lc
(
$b
)}
keys
%v
) {
$indent
=
' '
x (2 + (
$p
=~
tr
/:/:/));
push
@out
,
' '
,
$indent
,
$p
,
defined
(
$v
{
$p
}) ?
" v$v{$p};\n"
:
";\n"
;
}
push
@out
,
sprintf
"[at %s (local) / %s (GMT)]\n"
,
scalar
(
gmtime
),
scalar
(
localtime
);
my
$x
=
join
''
,
@out
;
$x
=~ s/^/
print
$x
;
}
print
"# Running"
,
(
chr
(65) eq
'A'
) ?
" in an ASCII world.\n"
:
" in a non-ASCII world.\n"
,
"#\n"
,
;
print
"# \@INC:\n"
,
map
(
"# [$_]\n"
,
@INC
),
"#\n#\n"
;
print
"# \%INC:\n"
;
foreach
my
$x
(
sort
{
lc
(
$a
) cmp
lc
(
$b
)}
keys
%INC
) {
print
"# [$x] = ["
,
$INC
{
$x
} ||
''
,
"]\n"
;
}
ok 1;