use strict;
use warnings;

use lib ".";
use Scalar::Util qw(blessed);
use Bah2;
use Data::Dumper;

my $bah = Bah2->new();

print $bah->toString() . "\n";
$bah->printBah();

# Create anonymous subroutine for generating all methods
my $p_get_methods = find_methods();
my $presults = $p_get_methods->($bah);
printf "Modules = %s\n\n", Dumper($presults);

#
#  find_methods()
#  061226 by liverpole
#  Based on 'methods_via()' from the Perl debugger 'perl5db.pl'.
#
#  Takes 1 argument, a classname (eg. "Bah") or a blessed object (eg. $bah),
#  and returns a hash containing all methods for the given class and any
#  classes from which it is inherited.  For example:
#
#        {
#           'Bah' => [
#                      'new',
#                      'printBah'
#                    ],
#           'Object' => [
#                         'new',
#                         'test_method',
#                         'toString'
#                       ]
#        };
#
#
sub find_methods {
    my %seen;
    my %methods;

    my $p_class_syms = sub {
        my $class = shift;
        no strict;
        return sort keys %{"${class}::"};
    };

    my $p_class_subs = sub {
        my ($class, $psyms) = @_;
        no strict;
        return grep { defined &{ ${"${class}::"}{$_} } } @$psyms;
    };

    my $p_super_classes = sub {
        my $class = shift;
        no strict;
        return @{"${class}::ISA"};
    };

    my $psub = sub {
        my $class = shift;

        # Fix the class name (eg. "Bah=HASH(0x192a324)" => "Bah")
        # $class =~ s/=.*//;
        my $cname = blessed($class);
        $class = $cname if defined($cname);

        # If we've processed this class already, just quit.
        if ($seen{$class}++) {
            return \%methods;
        }

        # Extract from all the symbols in this class, and
        # get the entire list of class methods.
        my @syms = $p_class_syms->($class);
        my @subs = $p_class_subs->($class, \@syms);

        # Save each method name which hasn't yet been seen.
        for my $subname (@subs) {
            if (!$seen{$subname}++) {
                $methods{$class} ||= [ ];
                push @{$methods{$class}}, $subname;
            }
        }

        # Keep going up the tree, finding all super classes.
        # Dump each class' methods into the %methods hash.
        #
        my @super = $p_super_classes->($class);
        for my $name (@super) {
            my $pnewsub  = find_methods();
            my $pmethods = $pnewsub->($name);
            while (my ($key, $pvals) = each %$pmethods) {
                $methods{$key} ||= [ ];
                map { push @{$methods{$key}}, $_ } @$pvals;
            }
        }

        return \%methods;
    };

    return $psub;
}