Re: A trigger called when following a 'has_a' (again)

[prev] [thread] [next] [Date index for 2004/07/22]

OK, here's the code!

I can supply a dump of the database (postgres) I'm using, though it 
should be pretty straightforward.

Peter

--8<----

use owner;

my $sub;

my $owner = owner->retrieve(3);
$owner->my_thing->do_stuff; # DOESN'T WORK: SUPERCLASS METHOD GETS CALLED

$sub = superclass->retrieve(1);
$sub->do_stuff; # this is subclass one, and works

$sub = superclass->retrieve(2);
$sub->do_stuff; # this is subclass two, and works

$owner->my_thing->do_stuff; # By now, the trigger has been called and the sublcass' method gets called.




package owner;


use base 'Class::DBI';
__PACKAGE__->connection('dbi:Pg:dbname=ppimley_after_set');

__PACKAGE__->table('owner');
__PACKAGE__->columns(All => qw/id my_thing/);
__PACKAGE__->has_a(my_thing => 'superclass');

1;

package subclass_one;

use base 'superclass';

sub do_stuff {
    my $self = shift;
    print "This is the do_stuff of subclass one\n";
}

1;

package subclass_two;

use base 'superclass';

sub do_stuff {
    my $self = shift;
    print "This is the do_stuff of subclass two\n";
}

1;


package superclass;


use base 'Class::DBI';

__PACKAGE__->connection('dbi:Pg:dbname=ppimley_after_set');
__PACKAGE__->table('superclass');
__PACKAGE__->columns(All => qw/id subclass/);
__PACKAGE__->add_trigger (select => \&bless_to_subclass);


sub bless_to_subclass {
    my $self = shift;
    my $subclass = $self->subclass;
    eval "require $subclass";
    bless $self, $subclass;
}


sub do_stuff {
    my $self = shift;
    print ("This is the superclass' do_stuff\n");
}

1;