Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Is their a way to specifically check whether a subroutine exist in a child class even if it exist in parent class? For argument sake, the subroutine does not exist in child class but does exist in parent class. The 'can' function does check for existence of subroutines. If the subroutine does not exist in child class but does in parent class it will return true. I was wondering if there is a function which will only do the look up in child class and return true or false if the subroutine does not exist in child class. Thank You in Advance!
  • Comment on A function to check if subroutine exists?

Replies are listed 'Best First'.
Re: A function to check if subroutine exists?
by chromatic (Archbishop) on Jan 30, 2001 at 02:13 UTC
    There's not a built-in function, but it's trivial to write one. Just use the symbol table: 
    #!/usr/bin/perl -w

use strict;

package Parent;

sub new {
    bless({}, $_[0]);
}

package Child;

@Child::ISA = qw( Parent );

sub child_only {}

package main;

print "new exists in Child\n" if in_kid('Child', 'new');
print "new exists in Parent\n" if in_kid('Parent', 'new');
print "child_only exists in Child\n" if in_kid('Child', 'child_only');
print "child_only exists in Parent\n" if in_kid('child_only', 'new');

sub in_kid {
    my $class = shift;
    my $sub = shift;
    no strict 'refs';
    return defined &{$class . '::' . $sub};
}

    [download]
[reply]
[d/l]
Re: A function to check if subroutine exists?
by tilly (Archbishop) on Jan 30, 2001 at 02:17 UTC
    The documentation for defined describes a direct way to do this.

    If you are in an OO environment though, you probably care more about the method having been overridden between the child and you than having it actually in the base class. In that case you can do it with the can method, see AbstractClass for a working example.

[reply]
(tye)Re: A function to check if subroutine exists?
by tye (Sage) on Jan 30, 2001 at 02:18 UTC

    "perldoc -f defined" or, if you have Perl 5.6 or later and don't care to be portable to older versions of Perl, see "perldoc -f exists".

            - tye (but my friends call me "Tye")
[reply]
Re: A function to check if subroutine exists?
by japhy (Canon) on Jan 30, 2001 at 09:30 UTC
    Here's an OO approach to it: 
    sub UNIVERSAL::native_can {
  my ($obj,$meth) = @_;
  $obj = ref($obj) || $obj;
  local @{"${obj}::ISA"};
  return $obj->can($meth);
}

my $obj = Class::Child->new;
# Class::Child inherits 'foo' from Class::Parent
print $obj->can('foo') ? 1 : 0;         # 1
print $obj->native_can('foo') ? 1 : 0;  # 0

    [download]


    japhy -- Perl and Regex Hacker
[reply]
[d/l]

Back to Seekers of Perl Wisdom