RE: Reblessing question: change primary key name?

[prev] [thread] [next] [Date index for 2005/01/10]

>This sounds like you want a decorator, not a mutation.  Wrap an object
around this one that adjusts the plumbing in and out.
>Otherwise, it sounds to me like:
>        I have a car, but what I'd really like is a boat, so I'm going.
>        to pull off the wheels, make it waterproof, and give it a
>        rudder.  But, I'll keep my car registration, since they're
>        cheaper than boat registrations.

I think I made it sound more ominous than it really is.  I pretty much
have the old "I have a 'Vehicle' that is either a 'Car' or a 'Boat' and
I want to load the right one" situation.  The only thing I am "pulling
off", is the big sticker that says 'Car' to let me know to fetch the
wheels and not the rudder.

I've noticed that Class::DBI is usually the easiest component to
confuse, so I am trying to keep things as simple as possible on the
application side - the database takes care of the messy details and
C:DBI just sees mutable views (one per subclass), which it can treat
like regular tables.  So for simple manipulations I can just dump these
objects into my generic CRUD tools, without any special treatment; but,
they behave polymorphically for more advanced visualizations.

The only thing that was a stumbling block was getting the right class
when selecting from the 'base' table.  I ended up with this:

(in the root package that extends C:DBI itself)
sub polymorphize {
	my $class =3D shift;
	my $sub_classes =3D (ref $_[0] eq 'HASH') ? shift : {@_};
	my $closure =3D sub {
		my $self =3D shift;
		return if(ref $self ne $class || $self->type eq 'base');
		my $old_id =3D $self->id;
		bless $self, $sub_classes->{$self->type} || die
sprintf("Unknown subclass type: '%s'", $self->type);
		$self->set($self->primary_column->name =3D> $old_id);
		delete $self->{__Changed};
	};
	$class->add_trigger(select =3D> $closure);
}

The subclass just needs to add it's own fields and remove the two
irrelevant ones:

package Vehicle::Boat;
use base 'Vehicle;

__PACKAGE__->table('boats');
__PACKAGE__->columns(Primary		=3D> qw/boat_id/);
__PACKAGE__->columns(Essential	=3D> grep({$_ ne 'type' && $_ ne
Vehicle->primary_column->name } map {$_->{name}}
Vehicle->columns('Essential')));
__PACKAGE__->columns(Data		=3D> qw/rudder
expensive_registration/);

The reason the primary key is important is because I have a lot of tools
that use reflection to construct the user-facing pages - it does me no
good to have Boat and Car objects, if the user still sees 'Vehicle'
everywhere.

The whole thing is a well understood aspect of the object/relational
"Paradigm Mismatch", there's just no perfect solutions for it (this is
as close as I've come to liking one though, and only because it's a
simple app).

>The word "rebless" is almost always a danger sign.

Agreed.  Which is why I'm still at work at 10:30 on a Sunday making sure
it will work :)

Thanks,
Dmitri