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

Hi all,
I have following problem:
Base object: 
package mObject_T;
use Moose; # automatically turns on strict and warnings
has '_logicErrors' => (is => 'rw', isa => 'Str');
...

[download]
Inherited object: 
package mSomeObject_T;
extends mObject_T;
...

[download]
I need second param of some function to be inherited from mObject_T, so I check if is_a("mObject_T"): 
contract('checkName')
    ->in(is_a("mName_T"),
        is_a("mObject_T"))
    ->enable;

[download]
but contract fails, if I call function with inherited object: 
my $obj = new mSomeObject_T;
checkName($nameObj, $obj);

[download]
as is_a() gets 'mSomeObject_T' instead of 'mObject_T'. How to do it properly?

Thanks for any help.

Replies are listed 'Best First'.
Re: Sub::Contract is_a inheritance problem
by ikegami (Patriarch) on Sep 09, 2008 at 09:01 UTC

    is_a doesn't check if the object is a descendant of the specified class. 

    sub is_a {
    croak "is_a() expects a package name"
        if (scalar @_ != 1 || !defined $_[0] || ref $_[0] ne '');

    my $type = shift;
    return sub {
        return 0 if (!defined $_[0]);
        return (ref $_[0] eq $type) ? 1:0;
    };
}

    [download]

    So use is_a('mSomeObject_T') or make your own constraint. 

    use Scalar::Util qw( blessed );

sub is_or_extends {
    my ($type) = @_;

    croak "is_or_extends() expects a package name"
        if !defined($type) || ref($type) ne '';

    return sub {
        return ( blessed($_[0])
           ? $_[0]->isa($type)
           : UNIVERSAL::isa($_[0], $type)
        );
    };
}

    [download]
[reply]
[d/l]
[select]
      Works perfectly, thanks!
[reply]

Back to Seekers of Perl Wisdom