]> git.decadent.org.uk Git - maypole.git/commitdiff
C3, inheritence changes and adding skeleton DFV model
authorAaron Trevena <aaron.trevena@gmail.com>
Mon, 2 Oct 2006 15:49:30 +0000 (15:49 +0000)
committerAaron Trevena <aaron.trevena@gmail.com>
Mon, 2 Oct 2006 15:49:30 +0000 (15:49 +0000)
git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@524 48953598-375a-da11-a14b-00016c27c3ee

Changes
MANIFEST
lib/Maypole.pm
lib/Maypole/Manual/Inheritance.pod
lib/Maypole/Model/Base.pm
lib/Maypole/Model/CDBI.pm
lib/Maypole/Model/CDBI/AsForm.pm
lib/Maypole/Model/CDBI/DFV.pm [new file with mode: 0644]
lib/Maypole/Model/CDBI/FromCGI.pm
lib/Maypole/Model/CDBI/Plain.pm

diff --git a/Changes b/Changes
index 5009e1982790dc4452e4d390a9ffa56504ba1001..3ba29b6ef8e46211486517c892a4d7656f803ee9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,6 +6,7 @@ For information about current developments and future releases, see:
    Fixed some db_colinfo test bugs
    Fixed typo in edit form template
    Now uses Class::C3 in all Classes to simplify inheritence
+   add_model_superclass method moves @ISA munging into the model
 
 2.11 Mon 31 July 2006
 
index 623a93477e7fcfec0ca2fae3be72ab50f9a9d331..8cb44c16fe8e073b651260f89b8ba49d759918f9 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -45,6 +45,7 @@ lib/Maypole/Model/CDBI.pm
 lib/Maypole/Model/CDBI/Plain.pm
 lib/Maypole/Model/CDBI/AsForm.pm
 lib/Maypole/Model/CDBI/FromCGI.pm
+lib/Maypole/Model/CDBI/DFV.pm
 lib/Maypole/View/Base.pm
 lib/Maypole/View/TT.pm
 Makefile.PL
index ec504196adf4c8ce12e0ca4feb4344d088e0641c..6656b9b20a2bb741dff627e4fbbed325345e1187 100644 (file)
@@ -1,4 +1,5 @@
 package Maypole;
+use Class::C3;
 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
 use UNIVERSAL::require;
 use strict;
@@ -299,14 +300,10 @@ sub setup_model {
   # among other things, this populates $config->classes
   $config->model->setup_database($config, $class, @_);
 
-  foreach my $subclass ( @{ $config->classes } ) {
-    next if $subclass->isa("Maypole::Model::Base");
-    no strict 'refs';
-    unshift @{ $subclass . "::ISA" }, $config->model;
-  }
+  $config->model->add_model_superclass($config);
 
   # Load custom model code, if it exists - nb this must happen after the
-  # unshift, to allow code attributes to work, but before adopt(),
+  # adding the model superclass, to allow code attributes to work, but before adopt(),
   # in case adopt() calls overridden methods on $subclass
   foreach my $subclass ( @{ $config->classes } ) {
     $class->load_model_subclass($subclass) unless ($class->model_classes_loaded());
index bff339db3bd467b82f5cf6c59d90c3df1c573026..76d76115626194e1f271cecb134edb02e33d1896 100644 (file)
@@ -33,8 +33,8 @@ application.
 =head1 Structure of a standard Maypole application\r
 \r
 A minimal Maypole application (such as the Beer database example from the\r
-L<Maypole> synopsis) consists of a custom driver class (BeerDB.pm), a set of\r
-auto-generated model classes, and a view class:\r
+L<Maypole> synopsis) consists of a custom driver (or controller) class (BeerDB.pm),\r
+a set of auto-generated model classes, and a view class:\r
 \r
 \r
            THE DRIVER\r
@@ -76,6 +76,11 @@ auto-generated model classes, and a view class:
           pub();                      BeerDB::Style\r
           beer();                     beers();\r
 \r
+=head2 Ouch, that's a lot of inheritence!\r
+\r
+Yes, that's a lot of inheritence, fortunately as of 2.12 Maypole uses\r
+L<Class::C3> to ensure sane method resolution.\r
+\r
 =head2 What about Maypole::Application - loading plugins\r
 \r
 The main job of L<Maypole::Application> is to insert the plugins into the\r
@@ -107,7 +112,7 @@ L<Class::DBI::Loader> identifies the appropriate L<Class::DBI> subclass and
 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
+Next, C<Maypole::setup> B<pushes> L<Maypole::Model::CDBI> onto the C<@ISA> \r
 array of each of these classes. \r
 \r
 Finally, the relationships among these tables are set up. Either do this\r
@@ -184,7 +189,7 @@ C<BeerDB2::Beer>, you would write:
     1;\r
     \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
+and C<BeerDB2::Maypole::Model> is B<pushed> 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
@@ -230,12 +235,14 @@ The resulting model looks like this:
 \r
 =head3 Features\r
 \r
+*REWRITE BASED ON C3 and push instead of shift*\r
+\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
 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
+Offline table classes, because C<BeerDB2::Maypole::Model> was pushed onto the\r
+end 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
 C<BeerDB2::Beer>, then C<BeerDB2::Maypole::Model>, C<Maypole::Model::CDBI>,\r
 C<Maypole::Model::Base>, and C<Class::DBI>, before moving on to\r
index d5d325c6dfaaf374414ac728ec9f894e9b2de1a3..8858c0a44a777e6b26047340c081d1471a8944f3 100644 (file)
@@ -1,6 +1,7 @@
 package Maypole::Model::Base;
-
 use strict;
+use Class::C3;
+
 use Maypole::Constants;
 use attributes ();
 
@@ -215,6 +216,13 @@ sub is_public {
 }
 
 
+=head2 add_model_superclass
+
+Adds model as superclass to model classes (if necessary)
+
+=cut
+
+sub add_model_superclass { return; }
 
 =head2 method_attrs
 
index ce93690d065c86d99ea98214ed2ab63852b15287..50e4d30f1106f151658b13e84083708615f37bb3 100644 (file)
@@ -1,5 +1,6 @@
 package Maypole::Model::CDBI;
 use strict;
+use Class::C3;
 
 use Data::Dumper;
 
@@ -26,7 +27,6 @@ will instead use Class::DBI classes provided.
 =cut
 
 use base qw(Maypole::Model::Base Class::DBI);
-#use Class::DBI::Plugin::Type;
 use Class::DBI::Loader;
 use Class::DBI::AbstractSearch;
 use Class::DBI::Plugin::RetrieveAll;
@@ -35,7 +35,7 @@ use Lingua::EN::Inflect::Number qw(to_PL);
 use attributes ();
 
 use Maypole::Model::CDBI::AsForm;
-use Maypole::Model::CDBI::FromCGI; 
+use Maypole::Model::CDBI::FromCGI;
 use CGI::Untaint::Maypole;
 
 =head2 Untainter
@@ -44,13 +44,24 @@ Set the class you use to untaint and validate form data
 Note it must be of type CGI::Untaint::Maypole (takes $r arg) or CGI::Untaint
 
 =cut
+
 sub Untainter { 'CGI::Untaint::Maypole' };
 
-# or if you like bugs 
+=head2 add_model_superclass
+
+Adds model as superclass to model classes (if necessary)
+
+=cut
 
-#use Class::DBI::FromCGI;
-#use CGI::Untaint;
-#sub Untainter { 'CGI::Untaint' };
+sub add_model_superclass {
+  my ($class,$config) = @_;
+  foreach my $subclass ( @{ $config->classes } ) {
+    next if $subclass->isa("Maypole::Model::Base");
+    no strict 'refs';
+    push @{ $subclass . "::ISA" }, $config->model;
+  }
+  return;
+}
 
 
 __PACKAGE__->mk_classdata($_) for (qw/COLUMN_INFO/);
index 1765482469927742eb67baca014c82eea5ec4114..f176f3ec9a86c2994835fff66e1ea6ff870d91d5 100644 (file)
@@ -7,8 +7,9 @@ package Maypole::Model::CDBI::AsForm;
 #                  -- $class->to_field($has_many_col); # foreign inputs  
 #  $class->search_inputs; /
 
-
+use Class::C3;
 use strict;
+
 use warnings;
 
 use base 'Exporter';
@@ -18,7 +19,6 @@ use HTML::Element;
 use Carp qw/cluck/;
 
 our $OLD_STYLE = 0;
-# pjs  --  Added new methods to @EXPORT 
 our @EXPORT = 
        qw( 
                to_cgi to_field  foreign_input_delimiter search_inputs unselect_element
@@ -30,7 +30,7 @@ our @EXPORT =
                _options_from_array _options_from_hash 
     );
 
-our $VERSION = '.95'; 
+our $VERSION = '.96'; 
 
 =head1 NAME
 
diff --git a/lib/Maypole/Model/CDBI/DFV.pm b/lib/Maypole/Model/CDBI/DFV.pm
new file mode 100644 (file)
index 0000000..1a90bce
--- /dev/null
@@ -0,0 +1,116 @@
+package Maypole::Model::CDBI::DFV;
+use Class::C3;
+use Maypole::Config;
+use base qw(Maypole::Model::Base);
+use strict;
+
+Maypole::Config->mk_accessors(qw(table_to_class));
+
+=head1 NAME
+
+Maypole::Model::CDBI::Plain - Class::DBI model without ::Loader
+
+=head1 SYNOPSIS
+
+    package Foo;
+    use 'Maypole::Application';
+
+    Foo->config->model("Maypole::Model::CDBI::DFV");
+    Foo->setup([qw/ Foo::SomeTable Foo::Other::Table /]);
+
+    # Look ma, no untainting
+
+    sub Foo::SomeTable::SomeAction : Exported {
+
+        . . .
+
+    }
+
+=head1 DESCRIPTION
+
+This module allows you to use Maypole with previously set-up
+L<Class::DBI> classes that use Class::DBI::DFV;
+
+Simply call C<setup> with a list reference of the classes you're going to use,
+and Maypole will work out the tables and set up the inheritance relationships
+as normal.
+
+Better still, it will also set use your DFV profile to validate input instead
+of CGI::Untaint. For teh win!!
+
+=head1 METHODS
+
+=head2 setup
+
+  This method is inherited from Maypole::Model::Base and calls setup_database,
+  which uses Class::DBI::Loader to create and load Class::DBI classes from
+  the given database schema.
+
+=head2 setup_database
+
+  This method loads the model classes for the application
+
+=cut
+
+sub setup_database {
+    my ( $self, $config, $namespace, $classes ) = @_;
+    $config->{classes}        = $classes;
+    foreach my $class (@$classes) { $namespace->load_model_subclass($class); }
+    $namespace->model_classes_loaded(1);
+    $config->{table_to_class} = { map { $_->table => $_ } @$classes };
+    $config->{tables}         = [ keys %{ $config->{table_to_class} } ];
+}
+
+=head2 class_of
+
+  returns class for given table
+
+=cut
+
+sub class_of {
+    my ( $self, $r, $table ) = @_;
+    return $r->config->{table_to_class}->{$table};
+}
+
+=head2 add_model_superclass
+
+Adds model as superclass to model classes
+
+=cut
+
+sub add_model_superclass {
+  my ($class,$config) = @_;
+  foreach my $subclass ( @{ $config->classes } ) {
+    next if $subclass->isa("Maypole::Model::Base");
+    no strict 'refs';
+    push @{ $subclass . "::ISA" }, $config->model;
+  }
+  return;
+}
+
+=head2 adopt
+
+This class method is passed the name of a model class that represensts a table
+and allows the master model class to do any set-up required.
+
+=cut
+
+sub adopt {
+    my ( $self, $child ) = @_;
+    if ( my $col = $child->stringify_column ) {
+        $child->columns( Stringify => $col );
+    }
+}
+
+=head1 SEE ALSO
+
+L<Maypole::Model::Base>
+
+L<Maypole::Model::CDBI>
+
+=cut
+
+
+1;
+
+
index 6cb95a0bce3babb9ef71dcf334c7565d87b29395..30ef4d4eece1b32603c92b3d838c543e38bbaf3d 100644 (file)
@@ -1,4 +1,5 @@
 package Maypole::Model::CDBI::FromCGI;
+use Class::C3;
 use strict;
 use warnings;
 
index 3c3296a2fbe3a46c59b4d961d3d00b6a6d02ab1a..c95bead3babdd720fb2f76f1ac8096076f94c785 100644 (file)
@@ -1,4 +1,5 @@
 package Maypole::Model::CDBI::Plain;
+use Class::C3;
 use Maypole::Config;
 use base 'Maypole::Model::CDBI';
 use strict;