Re: [Maypole-dev] Patch to support compound primary keys

From: Simon Flack (sf at flacks.net)
Date: Sun Dec 05 2004 - 17:49:13 GMT


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