From 5e9b1336d1f20d57953e3e419fa7d68e79723528 Mon Sep 17 00:00:00 2001
From: Marcus Ramberg <mramberg@cpan.org>
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<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 031d985..0a6c95b 100644
--- 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;
--
2.39.5