/usr/share/perl5/B/Lint/Debug.pm is in libb-lint-perl 1.20-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | package B::Lint::Debug;
use if $] > 5.017, 'deprecate';
our $VERSION = '1.20';
=head1 NAME
B::Lint::Debug - Adds debugging stringification to B::
=head1 DESCRIPTION
This module injects stringification to a B::OP*/B::SPECIAL. This
should not be loaded unless you're debugging.
=cut
package # hide from PAUSE
B::SPECIAL;
use overload '""' => sub {
my $self = shift @_;
"SPECIAL($$self)";
};
package # hide from PAUSE
B::OP;
use overload '""' => sub {
my $self = shift @_;
my $class = ref $self;
$class =~ s/\AB:://xms;
my $name = $self->name;
"$class($name)";
};
package # hide from PAUSE
B::SVOP;
use overload '""' => sub {
my $self = shift @_;
my $class = ref $self;
$class =~ s/\AB:://xms;
my $name = $self->name;
"$class($name," . $self->sv . "," . $self->gv . ")";
};
package # hide from PAUSE
B::SPECIAL;
sub DESTROY { }
our $AUTOLOAD;
sub AUTOLOAD {
my $cx = 0;
print "AUTOLOAD $AUTOLOAD\n";
package # hide from PAUSE
DB;
while ( my @stuff = caller $cx ) {
print "$cx: [@DB::args] [@stuff]\n";
if ( ref $DB::args[0] ) {
if ( $DB::args[0]->can('padix') ) {
print " PADIX: " . $DB::args[0]->padix . "\n";
}
if ( $DB::args[0]->can('targ') ) {
print " TARG: " . $DB::args[0]->targ . "\n";
for ( B::Lint::cv()->PADLIST->ARRAY ) {
print +( $_->ARRAY )[ $DB::args[0]->targ ] . "\n";
}
}
}
++$cx;
}
}
1;
|