#!/usr/bin/perl

use Module::Info;
use IO::File;
use Data::Dumper;

my %modinfos;

sub _showcode {
    my ($pkg, $sub) = @_;

    my $fh;
    if (!exists($modinfos{$pkg}{parsedfile})){
    if ($fh = new IO::File($modinfos{$pkg}{mod}->file())){
        my $count = 0;
        do {
        my $offset = $fh->tell();
        $modinfos{$pkg}{parsedfile}[$count++] = $offset;
        } while ($fh->getline);
    } else {
        die("Could not open $filename");
    }
    } else {
    $fh = new IO::File($modinfos{$pkg}{mod}->file());
    }
    if ($fh){
    my $s = $modinfos{$pkg}{subs}->{$sub}->{start};
    my $f = $modinfos{$pkg}{subs}->{$sub}->{end};
    my $sp = $modinfos{$pkg}{parsedfile}[$s];
    my $fp = $modinfos{$pkg}{parsedfile}[$f];
    my $delta = $fp - $sp;
    if ($delta <= 0){
        warn("Error retrieving code for $varName, start $s->$sp, end $
+f->$fp, delta = $delta, $filename");
        $s = $f - 1;
        $sp = $modinfos{$pkg}{parsedfile}[$s];
        $fp = $modinfos{$pkg}{parsedfile}[$f];
        $delta = $fp - $sp;
    }
    print("$s($sp) to $f($fp) delta = $delta for $sub\n");
    $fh->seek($sp, 0);
    my $cbuf;
    my $r = $fh->read($cbuf, $delta);

    # Need to back up to beginning of sub from the "start"
    while ($cbuf !~ /sub\s+$sub/){
        $s--;
        last if ($s < 0);
        $sp = $modinfos{$pkg}{parsedfile}[$s];
        $fp = $modinfos{$pkg}{parsedfile}[$s+1];
        my $delta = $fp - $sp;
        $fh->seek($sp, 0);
        my $cbuf2;
        my $r = $fh->read($cbuf2, $delta);
        $cbuf = $cbuf2 . $cbuf;
    }
    $s = $f-1;
    my @used = $modinfos{$pkg}{mod}->modules_used();
    my $usedstr = "";
    foreach my $used (@used){
        $usedstr .= "use $used;\n";
    }
    while (1){
        print("Sending to eval => $usedstr$cbuf\n");
        my $ref = eval "$usedstr$cbuf";
        if ($@){
        # warn($@);
        } else {
        last;
        }
        $s++;
        last if ($s > $modinfos{$pkg}{parsedfile});
        $sp = $modinfos{$pkg}{parsedfile}[$s];
        $fp = $modinfos{$pkg}{parsedfile}[$s+1];
        my $delta = $fp - $sp;
        $fh->seek($sp, 0);
        my $cbuf2;
        my $r = $fh->read($cbuf2, $delta);
        $cbuf .= $cbuf2;
        
    }
    print("Code is => \n$cbuf\n");
    }
}


sub UNIVERSAL::Introspect {
    my @recurse = (@_);
    while (@recurse){
    my $cur = shift @recurse;
    my $pkg;
    if ($pkg = ref($cur)){
        print("$cur is a $pkg\n");
    } else {
        $pkg = $cur;
        $cur = $pkg->new();
    }

    if (!exists($modinfos{$pkg}{mod})){
        my @mods = Module::Info->all_installed($pkg);

        if (@mods != 1){
        warn("Did not get proper number of modules: " . Dumper(\@mods)
+);
        return;
        }
        $modinfos{$pkg}{mod} = shift @mods;
    }

    if (grep /^$pkg$/, @done){
        print "Skipping $pkg\n";
        next;
    }
    my %subs = $modinfos{$pkg}{mod}->subroutines();
    if (%subs){
        my $ncur = $pkg;
        print("$ncur ==>\n");
        foreach my $ok (keys %subs){
        my $nk = $ok;
        $nk =~ s/$pkg\:\://;
        print "$pkg->$ok => $nk\n";
        $subs{$nk} = $subs{$ok};
        delete $subs{$ok};
        }
        $modinfos{$pkg}{subs} = \%subs;
        foreach my $sub (sort keys %subs){
        _showcode($pkg, $sub);
        }
    }
    push @done, $pkg;
    }
}

my $fh = new IO::File();
$fh->Introspect;
[download]