|
Ace128 has asked for the wisdom of the Perl Monks concerning the following question:
Greetings fellow Monks!
Ok, I have this simple and basic OO hiarchy:
Object.pm:
package Object;
use strict;
use warnings;
sub new {
my ($class) = @_;
my $self = {
_object => $class,
};
bless $self, $class;
return $self;
}
sub toString {
my $self = shift;
return $self->{'_object'};
}
1
Bah.pm:
package Bah;
use lib ".";
use Object;
use strict;
our @ISA = qw(Object); # inherits from Object
# Create Object class instance
#my $Object = Object()->new();
sub new {
my ($class) = @_;
my $self = $class->SUPER::new(@_);
$self->{'_bah'} = 0;
return $self;
}
sub printBah {
my $self = shift;
print "Bah\n";
}
1
And a simple test script to see that Bah inherits:
objtests.pl:
use lib ".";
use Bah;
use strict;
use Data::Dumper;
my $bah = Bah->new();
print $bah->toString() . "\n";
$bah->printBah();
This works as it should. Bah inherits from Object. Now my question is if you guys here can give me ideas on how to from within this objtests using the object ref $bah getting all methods this object has!? Something like: $bah->_methods; would return "new", "printBah" and "toString". As usuall with perl I bet there are different methods to get this information and I wanna find the "best" way. I wanna avoid having to put the methodnames in the object itself somehow (EXPORT?), so I dont have to update this list everytime I add a new method. I can also parse the code, but I was hoping for a more OO/clean way...
Ideas?
Thanks,
Ace |
Re: Getting methods existing in a Perl Object!
by liverpole (Monsignor) on Dec 26, 2006 at 16:09 UTC
|
Hi ace128,
Does this node by GrandFather help?
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;
}
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$..$/
| [reply]
[d/l]
[select] |
|
|
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'
]
]
};
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;
}
}
And we get:
Objects = $VAR1 = {
'Bah' => [
'new',
'printBah'
],
'Object' => [
'new',
'toString'
]
};
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] |
|
|
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;
which should really be this one:
map { push @{$methods{$name}}, $_ } @$val;
s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
| [reply]
[d/l]
[select] |
|
|
|
|
|
Re: Getting methods existing in a Perl Object!
by ferreira (Chaplain) on Dec 26, 2006 at 17:05 UTC
|
I think that you could get what you want with a little help from Class::Inspector by Adam Kennedy.
After getting and installing Class::Inspector from your nearest CPAN mirror, you do something like:
use Class::Inspector;
# Only get public methods
my $meths = Class::Inspector->methods( 'Bah', 'public' );
# $meths should contain [ 'new', 'printBah' ]
| [reply]
[d/l] |
Re: Getting methods existing in a Perl Object! (-d, m)
by tye (Sage) on Dec 26, 2006 at 16:46 UTC
|
The Perl debugger's "m" command lists the available methods for an object or class. You could look at the source of perl5db.pl and see what it does to implement the "m" command.
| [reply] |
Re: Getting methods existing in a Perl Object!
by ysth (Canon) on Dec 26, 2006 at 18:18 UTC
|
Any automated way to do this will also turn up class methods, private methods and non-methods (regular subs not expecting to be called via a method call).
If all you are looking for is to see if a method exists, see "can" in UNIVERSAL.
Why do you want to do this? In general, your subclass shouldn't know or care what methods the superclass has.
| [reply] |
|
|
I wanna load a class in, and see what methods/functions exists (and those inherited from the parent class also, since, well, those are available aswell). I wanna be able of getting those since I'm gonna use the information for autocompletion... That way it's all gonna be easier - you dont have to check some API/or the module... :)
| [reply] |
|
|
Ah, autocompletion is a very reasonable thing to want. Hope liverpole's solution is working well for you.
| [reply] |
Re: Getting methods existing in a Perl Object!
by chromatic (Archbishop) on Dec 27, 2006 at 05:38 UTC
|
my $meta = Class::MOP::Class->initialize( $Object );
my $method_map = $meta->compute_all_applicable_methods();
| [reply]
[d/l] |
|
|
Hey, this seems quite nice actually... not sure what to use here... liverpole's or the Class::MOP module... well, I think I will see if it's neccessary since the liverpole's solution seems to do what I need quite nice already...
| [reply] |
Re: Getting methods existing in a Perl Object!
by hesco (Deacon) on Dec 27, 2006 at 01:31 UTC
|
I've been retrofitting test suites onto applications in my archives. This is not really an automated method, but I feed can_ok() methods using foreach iterating across an array of methods gleaned with:
grep ^sub Module.pm | sed "s/^sub //" | sed "s/{.*$//"
But as already mentioned in this thread, this does nothing to discern between public and private methods, though were you to adopt the convention of naming private methods with a leading underbar, or if you managed to actually document with pod, EVERY public method, then your string manipulations could be massaged to dissect perldoc instead, and get an accurate list.
-- Hugh
if( $lal && $lol ) { $life++; }
| [reply]
[d/l] |
Re: Getting methods existing in a Perl Object!
by Ace128 (Hermit) on Dec 27, 2006 at 03:32 UTC
|
Hey, thanks all for feedback... And since I prefer to only use CPAN modules when really needed... I think I'm gonna go with liverpole's implementation... :)
Also, I think I should start with ++'ing people more... I forget to do that...
/ Ace | [reply] |
Re: Getting methods existing in a Perl Object!
by mreece (Friar) on Dec 31, 2006 at 20:57 UTC
|
use Class::Can;
use Data::Dumper;
my %methods = Class::Can->interrogate( ref $bah );
print Dumper(\%methods);
$VAR1 = {
'printBah' => 'Bah',
'new' => 'Bah',
'toString' => 'Object'
};
updated with example
| [reply]
[d/l] |
|
|
