Re: Getting methods existing in a Perl Object!

Update: On closer inspection, I see that it only gives methods for the given object, and not inherited objects. Oh well...

Update 2: As tye aptly points out, there is a method in the Perl debugger 'perl5db.pl' which does what I think you are looking for (the subroutine is called methods_via()).

Normally of course if just prints out the methods it finds. I played around with it, and created a subroutine which is based on it. The new subroutine, find_methods creates a closure which can then be called with the name of your class, or the blessed object itself, which then returns a data structure containing references to lists of methods for each class, starting with the given class (or object), and visiting each parent class from which the given class is a subclass.

Here is the updated code:

use strict;
use warnings;

use lib ".";
use Bah;
use Data::Dumper;

my $bah = Bah->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 a
+ny
#  classes from which it is inherited.  For example:
#
#        {
#           'Bah' => [
#                      'new',
#                      'printBah'
#                    ],
#           'Object' => [
#                         'new',
#                         'test_method',
#                         'toString'
#                       ]
#        };
#
#
sub find_methods {
    my %seen;
    my %methods;

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

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

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

        no strict;

        # Extract from all the symbols in this class.
        my @syms = sort keys %{"${class}::"};

        # Get entire list of defined subroutines in this class.
        my @subs = grep { defined &{ ${"${class}::"}{$_} } } @syms;

        for my $subname (@subs) {
            # If we printed this already, skip it.
            next if $seen{$subname}++;

            # Save the new method name.
            local $\ = '';
            local $, = '';
            $methods{$class} ||= [ ];
            push @{$methods{$class}}, $subname;
        }

        # Keep going up the tree.  
        # Find all the classes this one is a subclass of.
        #
        my @super = @{"${class}::ISA"};
        for $name (@super) {
            # Crawl up the tree and keep trying to crawl up.
            # Then dump the results into the %methods hash
            #
            my $pnewsub  = find_methods();
            my $pmethods = $pnewsub->($name);
            foreach my $val (values %$pmethods) {
                $methods{$name} ||= [ ];
                # Fixed original line, which created a double
                # array reference:
                #     push @{$methods{$name}}, $val;
                map { push @{$methods{$name}}, $_ } @$val;
            }
        }

        return \%methods;
    };

    return $psub;
}
[download]

Update 3: Fixed doubly-referenced array bug as pointed out below (sorry for that annoyance :-/).

Update 4: This still didn't function quite as expected; please see my later post for a version which, for now, appears to work.

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Comment on Re: Getting methods existing in a Perl Object! Select or Download Code

Replies are listed 'Best First'.
Re^2: Getting methods existing in a Perl Object! by Ace128 (Hermit) on Dec 28, 2006 at 15:16 UTC
Ok, because of some reason the Object array info is actually an array in a array.. quite annoying... `Objects = $VAR1 = { 'Bah' => [ 'new', 'printBah' ], 'Object' => [ [ 'new', 'toString' ] ] };` [download] I change little code there to: `# Keep going up the tree. # Find all the classes this one is a subclass of. # my @super = @{"${class}::ISA"}; for $name (@super) { # Crawl up the tree and keep trying to crawl up. # Then dump the results into the %methods hash # my $pnewsub = find_methods(); my $pmethods = $pnewsub->($name); my @m = values(%$pmethods); foreach my $val (@{$m[0]}) { $methods{$name} \|\|= [ ]; push @{$methods{$name}}, $val; } }` [download] And we get: `Objects = $VAR1 = { 'Bah' => [ 'new', 'printBah' ], 'Object' => [ 'new', 'toString' ] };` [download] I dont really like the @{$m[0]} solution... but it works for now... not sure how it will work if more subclassing is done....	[reply] [d/l] [select]
Re^3: Getting methods existing in a Perl Object! by liverpole (Monsignor) on Dec 29, 2006 at 18:38 UTC
Good catch. I missed the fact that there was a double reference being created there. Another way to fix it would be to dereference each value of `$pmethods` (which is an array reference). It's a single line change to my original code, which I'll fix now above. Just for reference, it's this line: `push @{$methods{$name}}, $val;` [download] which should really be this one: `map { push @{$methods{$name}}, $_ } @$val;` [download] s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/	[reply] [d/l] [select]
Re^4: Getting methods existing in a Perl Object! by Ace128 (Hermit) on Dec 30, 2006 at 14:23 UTC
Ok, that helped. Now, if I add this object: Bah2.pm: `package Bah2; use lib "."; use Bah; use strict; our @ISA = qw(Bah); # inherits from Bah # Create Object class instance #my $Object = Object()->new(); sub new { my ($class) = @_; my $self = $class->SUPER::new(@_); $self->{'_bah2'} = 0; return $self; } sub printBah2 { my $self = shift; print "Bah2\n"; } + 1` [download] And I modify the test to use Bah2 I get: `Objects = $VAR1 = { 'Bah' => [ 'new', 'printBah', 'new', 'toString' ], 'Bah2' => [ 'new', 'printBah2' ] };` [download] So, the Object hash is missing! Well, Object's functions are now in Bah though... but would be nice to have the functions in their Object they came from. Maybe the structure should be redone even more, so its an array with all the objects in the hiarchy. [0] is the current object, [1] one up etc. Or opposite ([0] is the top one, [1] subclass of [0] etc...) Functions may also need to be hashes, to remove duplicates... What say you?	[reply] [d/l] [select]
Re^5: Getting methods existing in a Perl Object! by liverpole (Monsignor) on Dec 30, 2006 at 15:32 UTC
Re^6: Getting methods existing in a Perl Object! by chromatic (Archbishop) on Dec 31, 2006 at 09:23 UTC
Some notes below your chosen depth have not been shown here
Re^6: Getting methods existing in a Perl Object! by Ace128 (Hermit) on Dec 30, 2006 at 16:48 UTC