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

diff --git a/Changes b/Changes
index 5212f55c4f213f13c99c6b8e13052f8622da4fa1..a653e99d7377731dd109c9f95b1f09f39175d2c7 100644 (file)
--- 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 1366dc158cb3d7827d7e5f5b0fc1d5d349bb2a7e..1740dd5b42bb762e20a218f68491ed6f7be04925 100644 (file)
--- 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 0d534a542559e0ec5448c29ffe805bb729317a05..580e6e1c942cb7cbfd3be63dae9f1cd4c6a74590 100644 (file)
--- 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<BeerDB::Beer>.
 
 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 031d9851e797e72497c0ec8681914dcd06766925..0a6c95b0be129cc08206caffb8e011391f875ebc 100644 (file)
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -39,6 +39,8 @@ See L<Maypole::Model::Base> 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;