>>>>> "John" == John Siracusa <[EMAIL PROTECTED]> writes:
John> Keep in mind that you can still make Perl aliases:
John> package MyThing;
John> ...
__PACKAGE__-> meta->setup
John> (
John> columns =>
John> [
John> my_pk => { ... }, # can't alias here
John> ...
John> ],
John> ...
John> );
John> *id = \&my_pk; # can alias here
John> I'm not sure if that helps. If not, the other option is to use RDBO
John> to do the actual database manipulation, but build another layer on top
John> of that to present the public API. MyWrappedThing "has a" MyThing,
John> and so on.
And in a recent project where I transitioned a large CDBI project
to RDBO, I ended up creating these. Came in very handy:
sub id {
my $self = shift;
my @pk = $self->meta->primary_key_columns;
die "need exactly one primary key for $self" unless @pk == 1;
my $getter = $pk[0]->accessor_method_name;
return $self->$getter(@_);
}
use overload
q{""} => sub { return shift->stringify_self },
bool => sub { not shift->_undefined_primary },
fallback => 1,
;
sub stringify_self {
my $self = shift;
return overload::StrVal($self);
}
sub _undefined_primary {
## returns true if all PKs are defined, otherwise false
my $self = shift;
for my $pk ($self->meta->primary_key_columns) {
my $getter = $pk->accessor_method_name;
return 1 unless defined $self->$getter;
}
return 0;
}
sub make_clone {
## clone the object except for primary keys and new items
my $self = shift;
my %updates = @_;
my $new = (ref $self)->new;
for my $column ($new->meta->columns) {
my $getter = $column->accessor_method_name;
my $setter = $column->mutator_method_name;
if (exists $updates{$getter}) {
$new->$setter($updates{$getter});
} elsif ($column->is_primary_key_member) {
# do nothing
} else {
$new->$setter($self->$getter);
}
}
return $new;
}
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys-and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
Rose-db-object mailing list
Rose-db-object@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/rose-db-object
