Maypole.pm - applied 'method' attribute to Maypole::handler,

[maypole.git] / lib / Maypole.pm

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index e89cef0af6ce89865530e566592e3e010127bdf1..566895129efcadea641af19e81fa13d059c9e9ac 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -7,11 +7,11 @@ use Maypole::Config;
 use Maypole::Constants;
 use Maypole::Headers;
 
 use Maypole::Constants;
 use Maypole::Headers;
 

-our $VERSION = '2.05';
+our $VERSION = '2.10';

 
 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __PACKAGE__->mk_accessors(
 
 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __PACKAGE__->mk_accessors(

-    qw( ar params query objects model_class template_args output path
+    qw( params query objects model_class template_args output path

         args action template error document_encoding content_type table
         headers_in headers_out )
 );
         args action template error document_encoding content_type table
         headers_in headers_out )
 );


@@ -20,23 +20,23 @@ __PACKAGE__->init_done(0);
 
 sub debug { 0 }
 
 
 sub debug { 0 }
 

-sub setup {
+sub setup 
+{

     my $calling_class = shift;
     my $calling_class = shift;

+    

     $calling_class = ref $calling_class if ref $calling_class;
     $calling_class = ref $calling_class if ref $calling_class;

-    {
-        no strict 'refs';
-        no warnings 'redefine';
-
-        # Naughty.
-        *{ $calling_class . "::handler" } =
-          sub { Maypole::handler( $calling_class, @_ ) };
-    }
+    

     my $config = $calling_class->config;
     my $config = $calling_class->config;

-    $config->model || $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 } ) {
+    
+    $config->model || $config->model('Maypole::Model::CDBI');
+    
+    $config->model->require or die 
+        "Couldn't load the model class $config->{model}: $@";
+    
+    $config->model->setup_database($config, $calling_class, @_);
+    
+    foreach my $subclass ( @{ $config->classes } ) 
+    {

         no strict 'refs';
         unshift @{ $subclass . "::ISA" }, $config->model;
         $config->model->adopt($subclass)
         no strict 'refs';
         unshift @{ $subclass . "::ISA" }, $config->model;
         $config->model->adopt($subclass)


@@ -44,7 +44,8 @@ sub setup {
     }
 }
 
     }
 }
 

-sub init {
+sub init 
+{

     my $class  = shift;
     my $config = $class->config;
     $config->view || $config->view("Maypole::View::TT");
     my $class  = shift;
     my $config = $class->config;
     $config->view || $config->view("Maypole::View::TT");


@@ -57,10 +58,11 @@ sub init {
 
 }
 
 
 }
 

-sub handler {
-
+sub handler : method 
+{

     # See Maypole::Workflow before trying to understand this.
     # See Maypole::Workflow before trying to understand this.

-    my ( $class, $req ) = @_;
+    my ($class, $req) = @_;
+    

     $class->init unless $class->init_done;
 
     # Create the request object
     $class->init unless $class->init_done;
 
     # Create the request object


@@ -186,8 +188,7 @@ sub exception { return ERROR }
 sub parse_path {
     my $self = shift;
     $self->{path} ||= "frontpage";
 sub parse_path {
     my $self = shift;
     $self->{path} ||= "frontpage";

-    my @pi = split /\//, $self->{path};
-    shift @pi while @pi and !$pi[0];
+    my @pi = $self->{path} =~ m{([^/]+)/?}g;

     $self->{table}  = shift @pi;
     $self->{action} = shift @pi;
     $self->{action} ||= "index";
     $self->{table}  = shift @pi;
     $self->{action} = shift @pi;
     $self->{action} ||= "index";


@@ -223,6 +224,13 @@ sub send_output {
     die "Do not use Maypole directly; use Apache::MVC or similar";
 }
 
     die "Do not use Maypole directly; use Apache::MVC or similar";
 }
 

+# Session and Repeat Submission Handling
+
+sub make_random_id {
+    use Maypole::Session;
+    return Maypole::Session::generate_unique_id();
+}
+

 =head1 NAME
 
 Maypole - MVC web application framework
 =head1 NAME
 
 Maypole - MVC web application framework


@@ -236,7 +244,7 @@ See L<Maypole::Application>.
 This documents the Maypole request object. See the L<Maypole::Manual>, for a
 detailed guide to using Maypole.
 
 This documents the Maypole request object. See the L<Maypole::Manual>, for a
 detailed guide to using Maypole.
 

-Maypole is a Perl web application framework to Java's struts. It is 
+Maypole is a Perl web application framework similar to Java's struts. It is 

 essentially completely abstracted, and so doesn't know anything about
 how to talk to the outside world.
 
 essentially completely abstracted, and so doesn't know anything about
 how to talk to the outside world.
 


@@ -465,6 +473,9 @@ This method first checks if the relevant model class
 can handle exceptions the user, or falls back to the default
 exception method of your Maypole application.
 
 can handle exceptions the user, or falls back to the default
 exception method of your Maypole application.
 

+=head3 make_random_id
+
+returns a unique id for this request can be used to prevent or detect repeat submissions.

 
 =head3 handler
 
 
 =head3 handler
 


@@ -492,11 +503,13 @@ Maypole is currently maintained by Simon Flack C<simonflk#cpan.org>
 
 Simon Cozens, C<simon#cpan.org>
 
 
 Simon Cozens, C<simon#cpan.org>
 

+Sebastian Riedel, C<sri#oook.de> maintained Maypole from 1.99_01 to 2.04
+

 =head1 THANKS TO
 
 =head1 THANKS TO
 

-Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg,
-Mickael Joanne, Randal Schwartz, Simon Flack, Steve Simms, Veljko Vidovic
-and all the others who've helped.
+Sebastian Riedel, Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka,
+Marcus Ramberg, Mickael Joanne, Randal Schwartz, Simon Flack, Steve Simms,
+Veljko Vidovic and all the others who've helped.

 
 =head1 LICENSE
 
 
 =head1 LICENSE