in reply to Re^4: Getting methods existing in a Perl Object!
in thread Getting methods existing in a Perl Object!

Okay, I think I've got the problem fixed now.

Previously, I wasn't inspecting the keys in the hash returned from the recursive call to find_methods, which has been fixed.

I also created 3 new anonymous subroutines, $p_class_syms, $p_class_subs and $p_super_classes, as it didn't feel right to have so much code after the no strict; statement.  Creating those subroutines let me localize no strict; within each, and take it out of the main subroutine, which felt both safer and cleaned up the code, I think.

Update:  I've also changed the program to take advantage of the blessed method in Scalar::Util, as pointed out by chromatic further below.

Update 2:  Minor change suggested by ysth.

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 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 $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; }

So, give that a try, and let me know if it works for you!


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

Replies are listed 'Best First'.
Re^6: Getting methods existing in a Perl Object!
by chromatic (Archbishop) on Dec 31, 2006 at 09:23 UTC
    # Fix the class name (eg. "Bah=HASH(0x192a324)" => "Bah")

    Are you aware of blessed() in Scalar::Util?

      Yes, I am now ;-)

      So it looks like a better (more standard) way to "Fix the class name" would be:

      use Scalar::Util qw(blessed); # Near the top of the program # ... # Fix the class name (eg. "Bah=HASH(0x192a324)" => "Bah") # Brute force method: $class =~ s/=.*//; my $cname = blessed($class); $class = $cname if defined($cname); # was "if $cname;"

      Thank you for the tip, ++chromatic!

      Update:  ... and ysth, whose change I've also incorporated.


      s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
        $class = $cname if defined( $cname );
Re^6: Getting methods existing in a Perl Object!
by Ace128 (Hermit) on Dec 30, 2006 at 16:48 UTC
    Seems to be working nicely man!