PERL   28
Lint debug
Guest on 14th September 2023 01:23:05 PM


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

Login or Register to edit or fork this paste. It's free.