Try this out. You'll note that the lexical's name is directly stored as '%method'. This isn't documented since you have to reach into the guts to get a lexical's name back out again so unless you're doing something really, highly unusual it doesn't show up.
=pod
Sample output ...
Names
no name
'%methods'
no name
Values
B::AV=SCALAR(0x8cb00)
B::HV=SCALAR(0x8cb18)
B::NULL=SCALAR(0x8cb30)
=cut
use strict;
use warnings;
no warnings 'uninitialized';
use constant DEBUG => 1;
use B;
{
# Get my new really private object where even
# the methods are hidden
my $object = new object;
# and now violate it. Privacy? Ha!
my $c_hash = extractLexHash( $object );
while (my ($key, $val) = each %$c_hash ) {
print "$key\t@$val\n";
}
}
sub extractLexHash {
my $Obj = B::svref_2object($_[0]);
my ($LexicalNames,
$LexicalValues) =
map { [ $_->ARRAY ] } $Obj->PADLIST->ARRAY;
# for a cheap thrill print the contents of
# $LexicalNames
if (DEBUG) {
print "Names\n";
print "@{[$_->can('PV') ? \"'\".$_->PV().\"'\" : 'no name']}\n
+" for @$LexicalNames;
print "Values\n";
print "$_\n" for @$LexicalValues;
exit;
}
my %Lexicals = ();
for my $index
(0 ..
# min(@LexicalNames, @LexicalValues)
(@$LexicalNames < @$LexicalValues ? @$LexicalNames : @$Lexica
+lValues)) {
next unless B::class($LexicalNames->[$index]) eq 'PVNV';
my @values = $LexicalValues -> [$index] -> ARRAY;
while (@values) {
my $LexicalName = shift @values;
my $LexicalObj = shift @values;
$Lexicals{$LexicalName} = [ $LexicalName,
bless(B::svref_2object(\$Lexic
+alName),'B::IV')->IVX,
$LexicalObj->RV ];
}
}
return \%Lexicals;
}
package object;
sub new {
my %methods;
%methods =
( me => sub { print "me!\n" },
you => sub { print "you!\n" } );
bless sub { $methods{me}->() }, 'object';
}
|