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

diff --git a/ex/BeerDB/Base.pm b/ex/BeerDB/Base.pm
new file mode 100644 (file)
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 (file)
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 f103eb2abf7db6187805ba5e5e1cf962c0b20fba..6c6ff52c0fc8ef0cad989205b9925382ccb03014 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -205,22 +205,26 @@ Called by C<setup>. This method builds the Maypole model hierarchy.
 
 A likely target for over-riding, if you need to build a customised model.
 
 
 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 
 {
 =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 || $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 } ) 
     {
     
     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");
         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 a20740578a0cde8813474e368439245200592354..6c6c6b77eba53e34624cf88766ec64bb52017412 100644 (file)
--- 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: \r
 \r
 \r
 view class: \r
 \r
 \r

-                  THE DRIVER\r
+           THE DRIVER\r

                                           +------- init() is a factory method,\r
                    1      Maypole         |           it sets up the view\r
    Maypole::Config <----- config();       |              classes\r
                                           +------- init() is a factory method,\r
                    1      Maypole         |           it sets up the view\r
    Maypole::Config <----- config();       |              classes\r


@@ -58,14 +58,14 @@ view class:
     |     it sets up the model\r
     |         classes\r
     |\r
     |     it sets up the model\r
     |         classes\r
     |\r

-    |                                 THE MODEL\r
+    |                                             THE MODEL\r

     |\r
     |\r

-    |  Maypole::Model::Base   Class::DBI\r
-    |             +             +\r
-    |             |             |\r
-    +-------> Maypole::Model::CDBI\r
-                      +\r
-                      |\r
+    |  Maypole::Model::Base    Class::DBI\r
+    |             +             +      +\r
+    |             |             |      |\r
+    +-------> Maypole::Model::CDBI   Class::DBI::<db_driver>\r
+                      +                     +\r
+                      |                     |\r

            +------------+--------+-------+---------+\r
            |            |        |       |         |\r
        BeerDB::Pub      |   BeerDB::Beer | BeerDB::Brewery\r
            +------------+--------+-------+---------+\r
            |            |        |       |         |\r
        BeerDB::Pub      |   BeerDB::Beer | BeerDB::Brewery\r


@@ -98,10 +98,13 @@ customised model.
 \r
 The standard model is built in 3 stages. \r
 \r
 \r
 The standard model is built in 3 stages. \r
 \r

-First, C<Maypole::setup> calls C<setup_database> on the Maypole model class, in\r
-this case L<Maypole::Model::CDBI>. C<setup_database> then uses\r
+First, C<Maypole::setup_model> calls C<setup_database> on the Maypole model\r
+class, in this case L<Maypole::Model::CDBI>. C<setup_database> then uses\r

 L<Class::DBI::Loader> to autogenerate individual L<Class::DBI> classes for each\r
 of the tables in the database (C<BeerDB::Beer>, C<BeerDB::Pub> etc).\r
 L<Class::DBI::Loader> to autogenerate individual L<Class::DBI> classes for each\r
 of the tables in the database (C<BeerDB::Beer>, C<BeerDB::Pub> etc).\r

+L<Class::DBI::Loader> identifies the appropriate L<Class::DBI> subclass and\r
+inserts it into each of these table classes' C<@ISA> ( C<<\r
+Class::DBI::<db_driver> >> in the diagrams)..\r

 \r
 Next, C<Maypole::setup> B<unshifts> L<Maypole::Model::CDBI> onto the C<@ISA> \r
 array of each of these classes. \r
 \r
 Next, C<Maypole::setup> B<unshifts> L<Maypole::Model::CDBI> onto the C<@ISA> \r
 array of each of these classes. \r


@@ -177,8 +180,8 @@ C<BeerDB2::Beer>, you would write:
     use base 'OfflineBeer::Beer';\r
     1;\r
     \r
     use base 'OfflineBeer::Beer';\r
     1;\r
     \r

-This package will be loaded automatically during C<setup()>, and\r
-C<BeerDB2::Maypole::Model> is B<unshifted> onto it's C<@ISA>. \r
+From Maypole 2.11, this package will be loaded automatically during C<setup()>,\r
+and C<BeerDB2::Maypole::Model> is B<unshifted> onto it's C<@ISA>.\r

 \r
 Configure relationships either in the individual C<OfflineBeer::*> classes, or\r
 else all together in C<OfflineBeer> itself i.e. not in the Maypole model. This \r
 \r
 Configure relationships either in the individual C<OfflineBeer::*> classes, or\r
 else all together in C<OfflineBeer> itself i.e. not in the Maypole model. This \r


@@ -191,15 +194,16 @@ The resulting model looks like this:
                                           |\r
    Maypole::Model::Base                   |\r
            +                              |\r
                                           |\r
    Maypole::Model::Base                   |\r
            +                              |\r

-           |       +----------------------+-----------------+\r
-           |       |                                        |\r
-           |       |                                        |\r
-     Maypole::Model::CDBI                                   |     OFFLINE\r
-             +                                              |        MODEL\r
-             |                                              |\r
-     BeerDB2::Maypole::Model                           OfflineBeer\r
-       +                                                    +\r
-       |                                                    |\r
+           |       +-----------------+----+-----------------+\r
+           |       |                 |                      |\r
+           |       |                 |                      |\r
+     Maypole::Model::CDBI            |                      |     OFFLINE\r
+             +                       |                      |        MODEL\r
+             |                       |                      |\r
+     BeerDB2::Maypole::Model  Class::DBI::<db_driver>  OfflineBeer\r
+       +                             +                      +\r
+       |                             |                      |\r
+       +-----------------------------+                      |\r

        |                                                    |\r
        +--- BeerDB2::Pub --------+ OfflineBeer::Pub --------+\r
        |                           beers();                 |\r
        |                                                    |\r
        +--- BeerDB2::Pub --------+ OfflineBeer::Pub --------+\r
        |                           beers();                 |\r


@@ -223,10 +227,10 @@ The resulting model looks like this:
 \r
 =head3 Features\r
 \r
 \r
 =head3 Features\r
 \r

-Non-Maypole applications using the Offline model are completely isolated from\r
+1. Non-Maypole applications using the Offline model are completely isolated from\r

 the Maypole application, and need not know it exists at all.\r
 \r
 the Maypole application, and need not know it exists at all.\r
 \r

-Methods defined in the Maypole table classes, override methods defined in the\r
+2. Methods defined in the Maypole table classes, override methods defined in the\r

 Offline table classes, because C<BeerDB2::Maypole::Model> was unshifted onto the\r
 beginning of each Maypole table class's C<@ISA>. Perl's depth first,\r
 left-to-right method lookup from e.g. C<BeerDB2::Beer> starts in\r
 Offline table classes, because C<BeerDB2::Maypole::Model> was unshifted onto the\r
 beginning of each Maypole table class's C<@ISA>. Perl's depth first,\r
 left-to-right method lookup from e.g. C<BeerDB2::Beer> starts in\r


@@ -242,13 +246,14 @@ C<OfflineBeer::CDBI>. Place this B<first> in the C<@ISA> of both
 C<BeerDB2::Maypole::Model> and C<OfflineBeer>. Note that C<OfflineBeer::CDBI>\r
 does not itself need to inherit from L<Class::DBI>.\r
 \r
 C<BeerDB2::Maypole::Model> and C<OfflineBeer>. Note that C<OfflineBeer::CDBI>\r
 does not itself need to inherit from L<Class::DBI>.\r
 \r

-Methods defined in the Maypole model base class (C<BeerDB2::Maypole::Model>),\r
+3. Methods defined in the Maypole model base class (C<BeerDB2::Maypole::Model>),\r

 override methods in the individual Offline table classes, and in the Offline\r
 model base class (C<Offline>). \r
 \r
 override methods in the individual Offline table classes, and in the Offline\r
 model base class (C<Offline>). \r
 \r

-Relationships defined in the Offline classes are inherited by the Maypole model.\r
+4. Relationships defined in the Offline classes are inherited by the Maypole\r
+model.\r

 \r
 \r

-The Maypole model has full access to the underlying Offline model. \r
+5. The Maypole model has full access to the underlying Offline model. \r

 \r
 =head3 Theory \r
 \r
 \r
 =head3 Theory \r
 \r

diff --git a/lib/Maypole/Session.pm b/lib/Maypole/Session.pm
index cde28dcb1fd7f69cd89499c173aaf8a225ad4553..774553b5e5eefcb89bd8b192ac9251bc5c805d50 100644 (file)
--- a/lib/Maypole/Session.pm
+++ b/lib/Maypole/Session.pm
@@ -12,11 +12,16 @@ my $uid = Maypole::Session::generate_unique_id()
 
 =head1 DESCRIPTION
 
 
 =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
 
 
 =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()
 
 
 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
 
 
 =cut
 


@@ -39,12 +45,14 @@ sub generate_unique_id {
 }
 
 
 }
 
 

-###################################################################################################
-###################################################################################################
+################################################################################
+################################################################################

 
 =head1 TODO
 
 
 =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
 
 
 =head1 SEE ALSO
 

diff --git a/t/01basics.t b/t/01basics.t
index 3a77f02cff97cff1d252118f91fcd9203f71c46d..e40fa85f488725b000c26b80428cc70012c51779 100644 (file)
--- 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 {
 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 $@;
 
         "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;
 }
 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');
 
    '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/] );