Perl module to dump a blessed references' symbol table and provide code dumps for any methods in its namespace.

BlackMagic.pm

package BlackMagic ;

use strict ;
use warnings ;
use Carp qw(confess) ;

use B::Deparse ;

sub Dump {
  my ($blessed) = @_ ;
  my ($ns, @fn, $d) ;

  $ns = ref ($blessed) ;
  if (!$ns) {
    confess (sprintf ("%s::Dump: \$blessed isn't.", __PACKAGE__)) ;
    return ;
  }

  printf STDERR ("Namespace: %s\n", $ns) ;
  printf STDERR ("Symbols:\n") ;

  eval {
    no strict qw(refs) ;
    while (my ($name, $glob) = each %{"${ns}::"}) {
      printf STDERR ("  %s\n", $name) ;
      if (*{$glob}{CODE}) {
        printf STDERR ("  ^- is code\n") ;
        push (@fn, $name) ;
      }
    }
    printf STDERR ("\n\n") ;

    $d = B::Deparse->new ("-sC") ;
    printf STDERR ("package $ns ;\n\n") ;
    foreach my $name (sort @fn) {
      my ($sym, $code) ;

      $sym  = sprintf ("%s::%s", $ns, $name) ;
      $code = _cleanup ($d->coderef2text (\&{$sym})) ;
      printf STDERR ("sub %s %s", $name, $code) ;
      printf STDERR ("\n\n") ;
    }
    use strict qw(refs) ;
  } ;
}

sub _cleanup {
  my ($code) = @_ ;
  my ($body, @lines) ;

  foreach my $line (split (/[\r\n]+/, $code)) {
    if ($body) {
      push (@lines, $line) ;

    } else {
      next if ($line =~ /^\s*(package|use|no|\{)(\s+|$)/) ;

      $body = 1 ;
      push (@lines, '{') ; # re-add opening brace
      redo ;
    }
  }

  return (join ("\n", @lines)) ;
}

1 ;