in reply to Re: Re: Re: Can't inherit subroutines - workaround?
in thread Can't inherit subroutines - workaround?

I see. I have followed that to the best I can, and I am looking deeper into the PObject code. Actually the save() method does seem to be here after all. Doing a class listing with stvns* recursing class lister I get, 

MyHuman
-------------------------------------------
humanthingysub
        myStorableBase
        -------------------------------------------
        name
        phone
        pobject
        email
        parentthingysub
        id
                Class::PObject::Template
                -------------------------------------------
                errstr
                remove
                __props
                save
                logtrc
                new
                load
                fetch
                count
                confess
                ()
                columns
                dump
                remove_all
                (""
                get
                set
                logconfig
                __driver
                croak
                carp
                drop_datasource

[download]

I've labelled human and parent thingies which are markers for methods in places I want to extend. So, we do inherit from ::Template and we get save() into the bargain, but unlike using an instance at the top level which saves and loads just fine I get a runtime error (which I've been seeing as a missing save() all along). Something else is up...OK, the context of use is, 
#!/usr/bin/perl

use MyHuman;

my $person = MyHuman->new();

$person->name('bob');
$person->email('bob@bob.com');
$new_id = $person->save() or die "save bork";
my $newperson = MyHuman->load($new_id) or die "reload bork";;
print "reload OK\nname is: ".$person->name()."\n";

[download]


..and we get a runtime,

Can't locate Class/PObject/Driver/.pm in @INC...

So my understanding is that its creating an instance just fine.Somehow the definition of the db_file and path are getting lost?
___________________________
*  A little while back another monk posted a very useful tool which has been invaluable to me experimenting with more adventurous OO Perl. I can't find the link, even in the supersearch, so I've posted the code again below. Note where I am using this to explore the inheritance of class myHuman. 

#!/usr/bin/perl

use strict;
use warnings;
no strict 'refs';
=pod
# Class/Object Method Lister
# on Jan 18, 2004 at 21:03     = by stvn
# if you want certain methods ignored,
# put their names in this string
=cut
my $IGNORE = "";
    require MyHuman;

    printFlatClassView("MyHuman");
    print "\n";

    printExpandedClassView("MyHuman");
    print "\n";
## ------------------------------------------------------------------

sub getClassMethodList {
    my $class = shift;
    return grep {
                !/^($IGNORE)$/ && defined &{"${class}::$_"}
                    } keys %{"${class}::"};
}
## ------------------------------------------------------------------

sub getCompleteClassMethodList {
    my ($class) = @_;
    my @methods = getClassMethodList($class);
    push @methods => map {
                        getCompleteClassMethodList($_)
                        } @{"${class}::ISA"};
    return @methods;
}
## ------------------------------------------------------------------

sub printExpandedClassView {
    my ($class, $tab_count) = @_;
    $tab_count ||= 0;
    if ($tab_count) {
        my $t = ("\t" x $tab_count);
        print "${t}$class\n";
        print "${t}-------------------------------------------\n$t";
        print join "\n${t}", getClassMethodList($class);
        print "\n";
    }
    else {
        print("$class\n");
        print "-------------------------------------------\n";
        print join "\n" => getClassMethodList($class);
        print "\n";
    }
    map {
        printExpandedClassView($_, $tab_count + 1)
        } @{"${class}::ISA"};
}

sub printFlatClassView {
    my ($class) = @_;
    print("$class\n");
    print "-------------------------------------------\n";
    my %method = map {
                    $_ => 1
                } getCompleteClassMethodList($class);
    print join "\n" => keys %method;
    print "\n";
}
## ------------------------------------------------------------------
1;

[download]
I've retititled more approppriately. I do appreciate all your help with this.
Andy.

Replies are listed 'Best First'.
Re: Inheriting from Class::PObject
by simonm (Vicar) on May 09, 2004 at 07:03 UTC
    The problem may be with Class::PObject itself; I'm not sure if it's written in a way that supports subclassing.
[reply]
      Ah ha. Interesting. I did wonder about that after reading something in the goat book about similar behaviour from badly written classes you couldn't inherit from. Shame because the module is very good functionally, the author Sherzod hasn't been around for a long time according to the logs, so looks like I'm on my own with a lovely opportunity to write a storable class from the top on my own at last :() Thanks for your thoughts Simon.
[reply]
        looks like I'm on my own with a lovely opportunity to write a storable class from the top on my own

        I think you'd be better off just patching Class::PObject to handle this situation.

        Something like the following should do the trick: 

        sub Class::PObject::Template::__props {
    my $self = shift;
    my @isa = ref($self) || $self;
    while ( scalar @isa ) {
        my $target = shift @ISA;
        no strict 'refs';
        if ( my $props = ${ $target . '::props' } ) {
            return $props;
        } else {
            push @isa, @{ $target . '::ISA' }
        }
    }
}

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom