From ea4ae8a93a09e21354465c485471e5f10582b784 Mon Sep 17 00:00:00 2001 From: David Baird Date: Thu, 3 Nov 2005 21:45:28 +0000 Subject: [PATCH] Modified setup_model() to load any available custom table classes. Added a dummy table class to ex/BeerDB to support a couple of tests. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@408 48953598-375a-da11-a14b-00016c27c3ee --- ex/BeerDB/Base.pm | 7 ++++ ex/BeerDB/Beer.pm | 10 ++++++ lib/Maypole.pm | 24 +++++++------ lib/Maypole/Manual/Inheritance.pod | 57 ++++++++++++++++-------------- lib/Maypole/Session.pm | 22 ++++++++---- t/01basics.t | 8 +++-- 6 files changed, 83 insertions(+), 45 deletions(-) create mode 100644 ex/BeerDB/Base.pm create mode 100644 ex/BeerDB/Beer.pm diff --git a/ex/BeerDB/Base.pm b/ex/BeerDB/Base.pm new file mode 100644 index 0000000..75ed338 --- /dev/null +++ b/ex/BeerDB/Base.pm @@ -0,0 +1,7 @@ +package BeerDB::Base; +use strict; +use warnings; + +sub floob {} + +1; diff --git a/ex/BeerDB/Beer.pm b/ex/BeerDB/Beer.pm new file mode 100644 index 0000000..d7de346 --- /dev/null +++ b/ex/BeerDB/Beer.pm @@ -0,0 +1,10 @@ +package BeerDB::Beer; +use strict; +use warnings; + +# do this to test we get the expected @ISA after setup_model() +use base 'BeerDB::Base'; + +sub fooey : Exported {} + +1; diff --git a/lib/Maypole.pm b/lib/Maypole.pm index f103eb2..6c6ff52 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -205,22 +205,26 @@ Called by C. This method builds the Maypole model hierarchy. A likely target for over-riding, if you need to build a customised model. +This method also ensures any code in custom model classes is loaded, so you +don't need to load them in the driver. + =cut sub setup_model { - my $calling_class = shift; + my $class = shift; - $calling_class = ref $calling_class if ref $calling_class; + $class = ref $class if ref $class; - my $config = $calling_class->config; + my $config = $class->config; $config->model || $config->model('Maypole::Model::CDBI'); $config->model->require or die sprintf "Couldn't load the model class %s: %s", $config->model, $@; - $config->model->setup_database($config, $calling_class, @_); + # among other things, this populates $config->classes + $config->model->setup_database($config, $class, @_); foreach my $subclass ( @{ $config->classes } ) { @@ -228,12 +232,12 @@ sub setup_model unshift @{ $subclass . "::ISA" }, $config->model; $config->model->adopt($subclass) if $config->model->can("adopt"); - - # TODO: I think we should also load these classes, in case there is any - # custom code. It would save the developer from needing to put - # lots of use MyApp::SomeTable statements in the driver, and should - # help eliminate some of those annoying silent errors if there's a - # syntax error. + + # Load custom model code, if it exists - nb this must happen after the + # unshift, to allow code attributes to work + eval "use $subclass"; + die "Error loading $subclass: $@" + if $@ and $@ !~ /Can\'t locate \S+ in \@INC/; } } diff --git a/lib/Maypole/Manual/Inheritance.pod b/lib/Maypole/Manual/Inheritance.pod index a207405..6c6c6b7 100644 --- a/lib/Maypole/Manual/Inheritance.pod +++ b/lib/Maypole/Manual/Inheritance.pod @@ -37,7 +37,7 @@ custom driver class (BeerDB.pm), a set of auto-generated model classes, and a view class: - THE DRIVER + THE DRIVER +------- init() is a factory method, 1 Maypole | it sets up the view Maypole::Config <----- config(); | classes @@ -58,14 +58,14 @@ view class: | it sets up the model | classes | - | THE MODEL + | THE MODEL | - | Maypole::Model::Base Class::DBI - | + + - | | | - +-------> Maypole::Model::CDBI - + - | + | Maypole::Model::Base Class::DBI + | + + + + | | | | + +-------> Maypole::Model::CDBI Class::DBI:: + + + + | | +------------+--------+-------+---------+ | | | | | BeerDB::Pub | BeerDB::Beer | BeerDB::Brewery @@ -98,10 +98,13 @@ customised model. The standard model is built in 3 stages. -First, C calls C on the Maypole model class, in -this case L. C then uses +First, C calls C on the Maypole model +class, in this case L. C then uses L to autogenerate individual L classes for each of the tables in the database (C, C etc). +L identifies the appropriate L subclass and +inserts it into each of these table classes' C<@ISA> ( C<< +Class::DBI:: >> in the diagrams).. Next, C B L onto the C<@ISA> array of each of these classes. @@ -177,8 +180,8 @@ C, you would write: use base 'OfflineBeer::Beer'; 1; -This package will be loaded automatically during C, and -C is B onto it's C<@ISA>. +From Maypole 2.11, this package will be loaded automatically during C, +and C is B onto it's C<@ISA>. Configure relationships either in the individual C classes, or else all together in C itself i.e. not in the Maypole model. This @@ -191,15 +194,16 @@ The resulting model looks like this: | Maypole::Model::Base | + | - | +----------------------+-----------------+ - | | | - | | | - Maypole::Model::CDBI | OFFLINE - + | MODEL - | | - BeerDB2::Maypole::Model OfflineBeer - + + - | | + | +-----------------+----+-----------------+ + | | | | + | | | | + Maypole::Model::CDBI | | OFFLINE + + | | MODEL + | | | + BeerDB2::Maypole::Model Class::DBI:: OfflineBeer + + + + + | | | + +-----------------------------+ | | | +--- BeerDB2::Pub --------+ OfflineBeer::Pub --------+ | beers(); | @@ -223,10 +227,10 @@ The resulting model looks like this: =head3 Features -Non-Maypole applications using the Offline model are completely isolated from +1. Non-Maypole applications using the Offline model are completely isolated from the Maypole application, and need not know it exists at all. -Methods defined in the Maypole table classes, override methods defined in the +2. Methods defined in the Maypole table classes, override methods defined in the Offline table classes, because C was unshifted onto the beginning of each Maypole table class's C<@ISA>. Perl's depth first, left-to-right method lookup from e.g. C starts in @@ -242,13 +246,14 @@ C. Place this B in the C<@ISA> of both C and C. Note that C does not itself need to inherit from L. -Methods defined in the Maypole model base class (C), +3. Methods defined in the Maypole model base class (C), override methods in the individual Offline table classes, and in the Offline model base class (C). -Relationships defined in the Offline classes are inherited by the Maypole model. +4. Relationships defined in the Offline classes are inherited by the Maypole +model. -The Maypole model has full access to the underlying Offline model. +5. The Maypole model has full access to the underlying Offline model. =head3 Theory diff --git a/lib/Maypole/Session.pm b/lib/Maypole/Session.pm index cde28dc..774553b 100644 --- a/lib/Maypole/Session.pm +++ b/lib/Maypole/Session.pm @@ -12,11 +12,16 @@ my $uid = Maypole::Session::generate_unique_id() =head1 DESCRIPTION -This class provides session related methods for Maypole such as unique id's for requests. +This class provides session related methods for Maypole such as unique id's for +requests. -Currently it provides only the generate_unique_id() function, by checking the id's generated by this function and included in submitted forms, it is possible to see if a form has been submitted before.. implementing these checks is left to the developer of that application. +Currently it provides only the generate_unique_id() function, by checking the +id's generated by this function and included in submitted forms, it is possible +to see if a form has been submitted before.. implementing these checks is left +to the developer of that application. -Further functionality is to be added here in later versions to provide easy access to sessions, either through plugins or builtin methods. +Further functionality is to be added here in later versions to provide easy +access to sessions, either through plugins or builtin methods. =head1 FUNCTIONS @@ -24,7 +29,8 @@ Further functionality is to be added here in later versions to provide easy acce my $uid = Maypole::Session::generate_unique_id() -generates a unique id and returns it, requires no arguments but accepts size, default is 32. +generates a unique id and returns it, requires no arguments but accepts size, +default is 32. =cut @@ -39,12 +45,14 @@ sub generate_unique_id { } -################################################################################################### -################################################################################################### +################################################################################ +################################################################################ =head1 TODO -Currently implementing uniqueness tests of form submissions is left to the Maypole user, we plan to provide an optional default behaviour to automate this if required. +Currently implementing uniqueness tests of form submissions is left to the +Maypole user, we plan to provide an optional default behaviour to automate this +if required. =head1 SEE ALSO diff --git a/t/01basics.t b/t/01basics.t index 3a77f02..e40fa85 100644 --- a/t/01basics.t +++ b/t/01basics.t @@ -1,4 +1,4 @@ -# vim:ft=perl +#!/usr/bin/perl -w use Test::More; use lib 'ex'; # Where BeerDB should live BEGIN { @@ -7,7 +7,7 @@ BEGIN { "SQLite not working or BeerDB module could not be loaded: $@" ) if $@; - plan tests => 15; + plan tests => 18; } use Maypole::CLI qw(BeerDB); use Maypole::Constants; @@ -42,3 +42,7 @@ is($classdata{list_columns}, 'score name price style brewery url', 'classdata.list_columns'); is ($classdata{related_accessors},'pubs','classdata.related_accessors'); +# test if successfully loaded customised model class +can_ok(BeerDB::Beer => 'fooey'); # defined in BeerDB::Beer +can_ok(BeerDB::Beer => 'floob'); # defined in BeerDB::Base +is_deeply( [@BeerDB::Beer::ISA], [qw/Maypole::Model::CDBI Class::DBI::SQLite BeerDB::Base/] ); -- 2.39.5