pjsz and AJT Maypole/Model updates and fixes

[maypole.git] / lib / Maypole.pm

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index fe2d29a0c5dad032b905a55aade0945b1faffd3d..5db199b484ae12a13c492aa3c16e64e419476e51 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -307,35 +307,32 @@ don't need to load them in the driver.
 
 =cut
 
-sub setup_model 
-{
-    my $class = shift;
-    
-    $class = ref $class if ref $class;
-    
-    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, $@;
-    
-    # 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;
-      
-      # Load custom model code, if it exists - nb this must happen after the 
-      # unshift, to allow code attributes to work, but before adopt(),  
-      # in case adopt() calls overridden methods on $subclass
-      $class->load_model_subclass($subclass) unless ($class->model_classes_loaded());
-      
-      $config->model->adopt($subclass) if $config->model->can("adopt");
-    }
+sub setup_model {
+  my $class = shift;
+  $class = ref $class if ref $class;
+  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, $@;
+
+  # 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; 
+
+  }
+
+  # Load custom model code, if it exists - nb this must happen after the
+  # unshift, 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());
+    $config->model->adopt($subclass) if $config->model->can("adopt");
+  }
+
 }
 
 =item load_model_subclass($subclass)
@@ -344,32 +341,32 @@ This method is called from C<setup_model()>. It attempts to load the
 C<$subclass> package, if one exists. So if you make a customized C<BeerDB::Beer>
 package, you don't need to explicitly load it. 
 
-If, perhaps during development, you don't want to load up custom classes, you 
+If automatic loading causes problems, Override load_model_subclass in your driver.
+
+sub load_model_subclass {};
+
+Or perhaps during development, if you don't want to load up custom classes, you 
 can override this method and load them manually. 
 
 =cut
 
-sub load_model_subclass
-{
-    my ($class, $subclass) = @_;
-    
-    my $config = $class->config;
-    
-    # Load any external files for the model base class or subclasses
-    # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
-    # Maypole::Plugin::Loader and Class::DBI.
-    if ( $subclass->require ) 
-    {
-        warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
-    } 
-    else 
-    {
-        (my $filename = $subclass) =~ s!::!/!g;
-        die "Loading '$subclass' failed: $@\n"
-               unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
-        warn "No external module for '$subclass'" 
-            if $class->debug > 1;
-   }
+sub load_model_subclass {
+  my ($class, $subclass) = @_;
+
+  my $config = $class->config;
+
+  # Load any external files for the model base class or subclasses
+  # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
+  # Maypole::Plugin::Loader and Class::DBI.
+  if ( $subclass->require ) {
+    warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
+  } else {
+    (my $filename = $subclass) =~ s!::!/!g;
+    die "Loading '$subclass' failed: $@\n"
+      unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
+    warn "No external module for '$subclass'"
+      if $class->debug > 1;
+  }
 }
 
 =item init
@@ -526,7 +523,7 @@ sub handler_guts
     
     $self->__load_request_model;
 
-    my $applicable = $self->is_model_applicable;
+    my $applicable = $self->is_model_applicable == OK;
     
     $self->__setup_plain_template unless $applicable;
 
@@ -730,6 +727,10 @@ from a Maypole:Constant to a true/false value.
 
 Returns a Maypole::Constant to indicate whether the request is valid.
 
+=cut
+
+sub is_applicable { return shift->is_model_applicable(@_); }
+
 =item is_model_applicable
 
 Returns true or false to indicate whether the request is valid.
@@ -740,17 +741,8 @@ C<< $r->action >>.
 
 =cut
 
-sub is_model_applicable 
-{
+sub is_model_applicable {
     my ($self) = @_;
-    
-    # cater for applications that are using obsolete version
-    if ($self->can('is_applicable')) 
-    {
-        warn "DEPRECATION WARNING: rewrite is_applicable to the interface ".
-                "of Maypole::is_model_applicable\n";
-        return $self->is_applicable == OK;
-    }
 
     # Establish which tables should be processed by the model
     my $config = $self->config;
@@ -779,17 +771,17 @@ sub is_model_applicable
             . join( ",", keys %$ok_tables )
                 if $self->debug and not $ok_tables->{$table};
                 
-        return 0;
+        return DECLINED;
     }
     
     # Is the action public?
     my $action = $self->action;
-    return 1 if $self->model_class->is_public($action);
+    return OK if $self->model_class->is_public($action);
     
     warn "The action '$action' is not applicable to the table '$table'"
          if $self->debug;
     
-    return 0;
+    return DECLINED;
 }
 
 =item get_session