From 5e9b1336d1f20d57953e3e419fa7d68e79723528 Mon Sep 17 00:00:00 2001 From: Marcus Ramberg Date: Mon, 6 Dec 2004 17:47:03 +0000 Subject: [PATCH] Refactored ->retrieve to fetch_objects support MCPKs in M:M:CDBI Added new Test:: dependencies to Makefile.PL git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@299 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 2 ++ Makefile.PL | 2 ++ lib/Maypole/Model/Base.pm | 9 ++++----- lib/Maypole/Model/CDBI.pm | 13 +++++++++++++ 4 files changed, 21 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 5212f55..a653e99 100644 --- a/Changes +++ b/Changes @@ -7,6 +7,8 @@ Revision history for Perl extension Maypole Maypole::Model::CDBI::Plain (Dave Howorth) - Added Apache::RequestIO to Apache::MVC (michael@diaspora.gen.nz) - Applied patch to fix length of utf8 documents. + - added a new override for the model, fetch_objects. + - support MCPKs in CDBI fetch_objects. 2.04 Tue Oct 27 14:00:00 2004 - fixed Apache::MVC version (Randal Schwartz) diff --git a/Makefile.PL b/Makefile.PL index 1366dc1..1740dd5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -23,6 +23,8 @@ WriteMakefile( CGI::Simple => 0, Template => 0, Template::Plugin::Class => 0, + Test::MockModule => 0, + Test::MockObject => 0, }, # e.g., Module::Name => 1.1 ( $] >= 5.005 diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index 0d534a5..580e6e1 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -15,9 +15,7 @@ sub process { return if $r->{template}; # Authentication has set this, we're done. $r->{template} = $method; - $r->objects( [] ); - my $obj = $class->retrieve( $r->{args}->[0] ); - $r->objects( [$obj] ) if $obj; + $r->objects([ $class->fetch_objects($r) ]); $class->$method( $r, $obj, @{ $r->{args} } ); } @@ -65,9 +63,9 @@ C. This maps between a table name and its associated class. -=head2 retrieve +=head2 fetch_objects -This turns an ID into an object of the appropriate class. +This method should populate $r->objects from $r->{args}. =head2 adopt @@ -87,6 +85,7 @@ This is the name of the table. sub class_of { die "This is an abstract method" } sub setup_database { die "This is an abstract method" } +sub fetch_objects { die "This is an abstract method" } =head2 Commands diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 031d985..0a6c95b 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -39,6 +39,8 @@ See L for these: =item setup_database +=item fetch_objects + =back =head1 Additional Commands @@ -233,4 +235,15 @@ sub class_of { return $r->config->loader->_table2class($table); } +sub fetch_objects { + my ($class,$r)=@_; + my @pcs = $class->primary_columns; + if ( $#pcs ) { + my %pks; + @pks{@pcs}=(@{$r->{args}}); + return $class->retrieve( %pks ); + } + return $class->retrieve( %$r->{args}->[0] ); +} + 1; -- 2.39.5