On Sun, 05 Dec 2004 17:56:27 +0100, Marcus Ramberg wrote
> Hi.
> Some person in #maypole alerted me to the fact that
> Maypole::Model::Base::process
> will break with compound primary keys, because such a construct
> requires retrieve with named columns. I've attached a patch below
> that will add a process to CDBI.pm which will check if a column has
> more than 1 primary key, and map primary keys to $r->{args} if so.
>
> What do you think? Should we commit this? Is it dirty? ;)
I don't think we need to duplicate the code in Maypole::Model::Base. How about
something like this:
sub Maypole::Model::Base::process {
my ( $class, $r ) = @_;
my $method = $r->action;
return if $r->{template}; # Authentication has set this, we're done.
$r->{template} = $method;
$r->objects( [] );
- my $obj = $class->retrieve( $r->{args}->[0] );
+ my $obj = $class->retrieve( $class->get_object_id($r) );
$r->objects( [$obj] ) if $obj;
$class->$method( $r, $obj, @{ $r->{args} } );
}
sub Maypole::Model::Base::get_object_id {
my ( $class, $r ) = @_;
return $r->{args}[0];
}
sub Maypole::Model::CDBI::get_object_id {
my ( $class, $r ) = @_;
if (@{$class->primary_columns} > 1) {
my %pks;
@pks{@{$class->primary_keys}}=(@{$r->{args}});
return \%pks;
}
return $class->SUPER::get_object_id($r);
}
> Marcus
>
> Index: CDBI.pm
> ===================================================================
> --- CDBI.pm (revision 292)
> +++ CDBI.pm (working copy)
> @@ -73,6 +73,23 @@
>
> =cut
>
> +sub process {
> + my ( $class, $r ) = @_;
> + if (@{$class->primary_columns} > 1) {
> + my $method = $r->action;
> + return if $r->{template}; # Authentication has set this,
> we're done.
> + $r->{template} = $method;
> + $r->objects( [] );
> + my %pks;
> + @pks{@$class->primary_keys}=(@$r->{args});
I think that needs to be:
@pks{@{$class->primary_keys}}=(@{$r->{args}});
> + my $obj = $class->retrieve( %pks);
> + $r->objects( [$obj] ) if $obj;
> + $class->$method( $r, $obj, @{ $r->{args} } );
> + } else {
> + return $class->SUPER::process(@_);
> + }
> +}
> +
> sub related {
> my ( $self, $r ) = @_;
> return keys %{ $self->meta_info('has_many') || {} };
>
> _______________________________________________
> maypole-dev mailing list
> maypole-dev at lists.netthink.co.uk
> http://lists.netthink.co.uk/listinfo/maypole-dev
--simonflk
_______________________________________________
maypole-dev mailing list
maypole-dev at lists.netthink.co.uk
http://lists.netthink.co.uk/listinfo/maypole-dev
This archive was generated by hypermail 2.1.3 : Thu Feb 24 2005 - 22:25:57 GMT