in reply to Re^4: Getting methods existing in a Perl Object!
in thread Getting methods existing in a Perl Object!
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!
|
|---|
| 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 | |
by liverpole (Monsignor) on Dec 31, 2006 at 14:41 UTC | |
by ysth (Canon) on Dec 31, 2006 at 20:01 UTC | |
|
Re^6: Getting methods existing in a Perl Object!
by Ace128 (Hermit) on Dec 30, 2006 at 16:48 UTC |