There goes 1.4.

[maypole.git] / lib / Maypole.pm

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 9a86489b8127d7cbb0914409d88ca0a415948415..e4b36bc8e2ebcf4af32672de145aa154ad457dd8 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -2,16 +2,17 @@ package Maypole;
 use base qw(Class::Accessor Class::Data::Inheritable);
 use attributes ();
 use UNIVERSAL::require;
-use Apache::Constants ":common";
 use strict;
 use warnings;
-our $VERSION = "1.1";
+our $VERSION = "1.4";
 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __PACKAGE__->mk_accessors ( qw( ar params query objects model_class
 args action template ));
 __PACKAGE__->config({});
 __PACKAGE__->init_done(0);
+use Maypole::Constants;
 
+sub debug { 0 }
 
 sub setup {
     my $calling_class = shift;
@@ -24,6 +25,7 @@ sub setup {
     my $config = $calling_class->config;
     $config->{model} ||= "Maypole::Model::CDBI";
     $config->{model}->require;
+    die "Couldn't load the model class $config->{model}: $@" if $@;
     $config->{model}->setup_database($config, $calling_class, @_);
     for my $subclass (@{$config->{classes}}) {
         no strict 'refs';
@@ -38,6 +40,7 @@ sub init {
     my $config = $class->config;
     $config->{view}  ||= "Maypole::View::TT";
     $config->{view}->require;
+    die "Couldn't load the view class $config->{view}: $@" if $@;
     $config->{display_tables} ||= [ @{$class->config->{tables}} ];
     $class->view_object($class->config->{view}->new);
     $class->init_done(1);
@@ -51,11 +54,22 @@ sub handler {
     my $r = bless { config => $class->config }, $class;
     $r->get_request();
     $r->parse_location();
+    my $status = $r->handler_guts();
+    return $status unless $status == OK;
+    $r->send_output;
+    return $status;
+}
 
+sub handler_guts {
+    my $r = shift;
     $r->model_class($r->config->{model}->class_of($r, $r->{table}));
     my $status = $r->is_applicable;
     if ($status == OK) { 
         $status = $r->call_authenticate;
+        if ($r->debug and $status != OK and $status != DECLINED) {
+            $r->view_object->error($r,
+                "Got unexpected status $status from calling authentication");
+        }
         return $status unless $status == OK;
         $r->additional_data();
     
@@ -67,25 +81,28 @@ sub handler {
         $r->{path} =~ s{/}{}; # De-absolutify
         $r->template($r->{path});
     }
-    return $r->view_object->process($r);
+    if (!$r->{output}) { # You might want to do it yourself
+        return $r->view_object->process($r);
+    } else { return OK; }
 }
 
 sub is_applicable {
     my $self = shift;
     my $config = $self->config;
     $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}};
-    #warn "We don't have that table ($self->{table})"
-    #    unless $config->{ok_tables}{$self->{table}};
+    warn "We don't have that table ($self->{table})"
+        if $self->debug and not $config->{ok_tables}{$self->{table}};
     return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
 
     # Does the action method exist?
     my $cv = $self->model_class->can($self->{action});
-    #warn "We don't have that action ($self->{action})" unless $cv;
+    warn "We don't have that action ($self->{action})" 
+        if $self->debug and not $cv;
     return DECLINED() unless $cv;
 
     # Is it exported?
     $self->{method_attribs} = join " ", attributes::get($cv);
-    do { # warn "$self->{action} not exported";
+    do { warn "$self->{action} not exported" if $self->debug;
     return DECLINED() 
      } unless $self->{method_attribs} =~ /\bExported\b/i;
     return OK();
@@ -102,6 +119,16 @@ sub additional_data {}
 
 sub authenticate { return OK }
 
+sub parse_path {
+    my $self = shift;
+    $self->{path} ||= "frontpage";
+    my @pi = split /\//, $self->{path};
+    shift @pi while @pi and !$pi[0];
+    $self->{table} = shift @pi;
+    $self->{action} = shift @pi;
+    $self->{args} = \@pi;
+}
+
 =head1 NAME
 
 Maypole - MVC web application framework
@@ -194,7 +221,7 @@ subclass the model class, and configure your class slightly differently:
 Then your top-level application package should change the model class:
 (Before calling C<setup>)
 
-    ProductDatabase->config->{model_class} = "ProductDatabase::Model";
+    ProductDatabase->config->{model} = "ProductDatabase::Model";
 
 (The C<:Exported> attribute means that the method can be called via the
 URL C</I<table>/supersearch/...>.)
@@ -217,16 +244,28 @@ introduction to the process we're trying to automate.
 You should probably not use Maypole directly. Maypole is an abstract
 class which does not specify how to communicate with the outside world.
 The most popular subclass of Maypole is L<Apache::MVC>, which interfaces
-the Maypole framework to Apache mod_perl.
+the Maypole framework to Apache mod_perl; another important one is
+L<CGI::Maypole>.
 
-If you are implementing Maypole subclasses, you need to provide at least 
-the C<get_request> and C<parse_location> methods. See the
+If you are implementing Maypole subclasses, you need to provide at least
+the C<parse_location> and C<send_output> methods. You may also want to
+provide C<get_request> and C<get_template_root>. See the
 L<Maypole::Workflow> documentation for what these are expected to do.
 
 =cut
 
-sub get_request { die "Do not use Maypole directly; use Apache::MVC or similar" }
+sub get_template_root { "." }
+sub get_request { }
 sub parse_location { die "Do not use Maypole directly; use Apache::MVC or similar" }
+sub send_output{ die "Do not use Maypole directly; use Apache::MVC or similar" }
+
+=head1 SEE ALSO
+
+There's more documentation, examples, and a wiki at the Maypole web site:
+
+http://maypole.simon-cozens.org/
+
+L<Apache::MVC>, L<CGI::Maypole>.
 
 =head1 AUTHOR