From: Aaron Trevena <aaron.trevena@gmail.com>
Date: Mon, 2 Oct 2006 15:49:30 +0000 (+0000)
Subject: C3, inheritence changes and adding skeleton DFV model
X-Git-Tag: 2.12~50
X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=ce828f4b7309670fc8b0ed826fd2455c4d5412bb;p=maypole.git

C3, inheritence changes and adding skeleton DFV model

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@524 48953598-375a-da11-a14b-00016c27c3ee
---

diff --git a/Changes b/Changes
index 5009e19..3ba29b6 100644
--- 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
 
diff --git a/MANIFEST b/MANIFEST
index 623a934..8cb44c1 100644
--- 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
diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index ec50419..6656b9b 100644
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -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());
diff --git a/lib/Maypole/Manual/Inheritance.pod b/lib/Maypole/Manual/Inheritance.pod
index bff339d..76d7611 100644
--- a/lib/Maypole/Manual/Inheritance.pod
+++ b/lib/Maypole/Manual/Inheritance.pod
@@ -33,8 +33,8 @@ application.
 =head1 Structure of a standard Maypole application
 
 A minimal Maypole application (such as the Beer database example from the
-L<Maypole> synopsis) consists of a custom driver class (BeerDB.pm), a set of
-auto-generated model classes, and a view class:
+L<Maypole> synopsis) consists of a custom driver (or controller) class (BeerDB.pm),
+a set of auto-generated model classes, and a view class:
 
 
            THE DRIVER
@@ -76,6 +76,11 @@ auto-generated model classes, and a view class:
           pub();                      BeerDB::Style
           beer();                     beers();
 
+=head2 Ouch, that's a lot of inheritence!
+
+Yes, that's a lot of inheritence, fortunately as of 2.12 Maypole uses
+L<Class::C3> to ensure sane method resolution.
+
 =head2 What about Maypole::Application - loading plugins
 
 The main job of L<Maypole::Application> is to insert the plugins into the
@@ -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<<
 Class::DBI::<db_driver> >> in the diagrams)..
 
-Next, C<Maypole::setup> B<unshifts> L<Maypole::Model::CDBI> onto the C<@ISA> 
+Next, C<Maypole::setup> B<pushes> L<Maypole::Model::CDBI> onto the C<@ISA> 
 array of each of these classes. 
 
 Finally, the relationships among these tables are set up. Either do this
@@ -184,7 +189,7 @@ C<BeerDB2::Beer>, you would write:
     1;
     
 From Maypole 2.11, this package will be loaded automatically during C<setup()>,
-and C<BeerDB2::Maypole::Model> is B<unshifted> onto it's C<@ISA>.
+and C<BeerDB2::Maypole::Model> is B<pushed> onto it's C<@ISA>.
 
 Configure relationships either in the individual C<OfflineBeer::*> classes, or
 else all together in C<OfflineBeer> itself i.e. not in the Maypole model. This 
@@ -230,12 +235,14 @@ The resulting model looks like this:
 
 =head3 Features
 
+*REWRITE BASED ON C3 and push instead of shift*
+
 1. Non-Maypole applications using the Offline model are completely isolated from
 the Maypole application, and need not know it exists at all.
 
 2. Methods defined in the Maypole table classes, override methods defined in the
-Offline table classes, because C<BeerDB2::Maypole::Model> was unshifted onto the
-beginning of each Maypole table class's C<@ISA>. Perl's depth first,
+Offline table classes, because C<BeerDB2::Maypole::Model> was pushed onto the
+end of each Maypole table class's C<@ISA>. Perl's depth first,
 left-to-right method lookup from e.g. C<BeerDB2::Beer> starts in
 C<BeerDB2::Beer>, then C<BeerDB2::Maypole::Model>, C<Maypole::Model::CDBI>,
 C<Maypole::Model::Base>, and C<Class::DBI>, before moving on to
diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm
index d5d325c..8858c0a 100644
--- a/lib/Maypole/Model/Base.pm
+++ b/lib/Maypole/Model/Base.pm
@@ -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
 
diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index ce93690..50e4d30 100644
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -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/);
diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index 1765482..f176f3e 100644
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -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
index 0000000..1a90bce
--- /dev/null
+++ b/lib/Maypole/Model/CDBI/DFV.pm
@@ -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;
+
+
diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm
index 6cb95a0..30ef4d4 100644
--- a/lib/Maypole/Model/CDBI/FromCGI.pm
+++ b/lib/Maypole/Model/CDBI/FromCGI.pm
@@ -1,4 +1,5 @@
 package Maypole::Model::CDBI::FromCGI;
+use Class::C3;
 use strict;
 use warnings;
 
diff --git a/lib/Maypole/Model/CDBI/Plain.pm b/lib/Maypole/Model/CDBI/Plain.pm
index 3c3296a..c95bead 100644
--- a/lib/Maypole/Model/CDBI/Plain.pm
+++ b/lib/Maypole/Model/CDBI/Plain.pm
@@ -1,4 +1,5 @@
 package Maypole::Model::CDBI::Plain;
+use Class::C3;
 use Maypole::Config;
 use base 'Maypole::Model::CDBI';
 use strict;