X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=566895129efcadea641af19e81fa13d059c9e9ac;hb=436e67e2ddca8e590809acea95dd4d47b4726da6;hp=6b4fe3f0a56d250f7261e2cfc4e53cb98449cbb2;hpb=2225b4184a391bab5f1d9498d5b695ba0c2f09f2;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 6b4fe3f..5668951 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -1,40 +1,42 @@ package Maypole; use base qw(Class::Accessor::Fast Class::Data::Inheritable); -use attributes (); use UNIVERSAL::require; use strict; use warnings; use Maypole::Config; use Maypole::Constants; +use Maypole::Headers; -our $VERSION = '2.0'; +our $VERSION = '2.10'; __PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); __PACKAGE__->mk_accessors( - qw( ar params query objects model_class template_args output path - args action template error document_encoding content_type table) + qw( params query objects model_class template_args output path + args action template error document_encoding content_type table + headers_in headers_out ) ); __PACKAGE__->config( Maypole::Config->new() ); __PACKAGE__->init_done(0); sub debug { 0 } -sub setup { +sub setup +{ my $calling_class = shift; + $calling_class = ref $calling_class if ref $calling_class; - { - no strict 'refs'; - - # Naughty. - *{ $calling_class . "::handler" } = - sub { Maypole::handler( $calling_class, @_ ) }; - } + 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) @@ -42,25 +44,33 @@ sub setup { } } -sub init { +sub init +{ my $class = shift; my $config = $class->config; $config->view || $config->view("Maypole::View::TT"); $config->view->require; die "Couldn't load the view class " . $config->view . ": $@" if $@; $config->display_tables - || $config->display_tables( [ $class->config->tables ] ); + || $config->display_tables( $class->config->tables ); $class->view_object( $class->config->view->new ); $class->init_done(1); } -sub handler { - +sub handler : method +{ # See Maypole::Workflow before trying to understand this. - my ( $class, $req ) = @_; + my ($class, $req) = @_; + $class->init unless $class->init_done; - my $r = bless { config => $class->config }, $class; + + # Create the request object + my $r = bless { + template_args => {}, + config => $class->config + }, $class; + $r->headers_out(Maypole::Headers->new); $r->get_request($req); $r->parse_location(); my $status = $r->handler_guts(); @@ -73,6 +83,7 @@ sub handler { sub handler_guts { my $r = shift; $r->model_class( $r->config->model->class_of( $r, $r->{table} ) ); + my $applicable = $r->is_applicable; unless ( $applicable == OK ) { @@ -134,7 +145,8 @@ sub is_applicable { . "Available tables are: " . join( ",", @{ $config->{display_tables} } ) if $self->debug - and not $config->ok_tables->{ $self->{table} }; + and not $config->ok_tables->{ $self->{table} } + and $self->{action}; return DECLINED() unless exists $config->ok_tables->{ $self->{table} }; # Is it public? @@ -176,13 +188,31 @@ sub exception { return ERROR } 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->{args} = \@pi; } +sub param { # like CGI::param(), but read-only + my $r = shift; + my ($key) = @_; + if (defined $key) { + unless (exists $r->{params}{$key}) { + return wantarray() ? () : undef; + } + my $val = $r->{params}{$key}; + if (wantarray()) { + return ref $val ? @$val : $val; + } else { + return ref $val ? $val->[0] : $val; + } + } else { + return keys %{$r->{params}}; + } +} + sub get_template_root { "." } sub get_request { } @@ -194,6 +224,13 @@ sub send_output { 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 @@ -204,8 +241,22 @@ See L. =head1 DESCRIPTION -This documents the Maypole request object. For user documentation, see -L. +This documents the Maypole request object. See the L, for a +detailed guide to using Maypole. + +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. + +To use it, you need to create a package which represents your entire +application. In our example above, this is the C package. + +This needs to first use L which will make your package +inherit from the appropriate platform driver such as C or +C, and then call setup. This sets up the model classes and +configures your application. The default model class for Maypole uses +L to map a database to classes, but this can be changed by altering +configuration. (B calling setup.) =head2 CLASS METHODS @@ -274,6 +325,14 @@ A list of remaining parts of the request path after table and action have been removed +=head3 headers_in + +A L object containing HTTP headers for the request + +=head3 headers_out + +A L object that contains HTTP headers for the output + =head3 parse_args Turns post data and query string paramaters into a hash of C. @@ -282,12 +341,15 @@ You should only need to define this method if you are writing a new Maypole backend. +=head3 param + +An accessor for request parameters. It behaves similarly to CGI::param() for +accessing CGI parameters. + =head3 params -Returns a hash of request parameters. The source of the parameters may -vary -depending on the Maypole backend, but they are usually populated from -request +Returns a hash of request parameters. The source of the parameters may vary +depending on the Maypole backend, but they are usually populated from request query string and POST data. B Where muliple values of a parameter were supplied, the @@ -297,17 +359,24 @@ will be an array reference. =head3 get_template_root -Implimentation-specific path to template root. +Implementation-specific path to template root. You should only need to define this method if you are writing a new Maypole backend. Otherwise, see L +=head3 get_request + +You should only need to define this method if you are writing a new +Maypole backend. It should return something that looks like an Apache +or CGI request object, it defaults to blank. + + =head3 is_applicable Returns a Maypole::Constant to indicate whether the request is valid. -The default implimentation checks that C<$r-Etable> is publicly +The default implementation checks that C<$r-Etable> is publicly accessible and that the model class is configured to handle the C<$r-Eaction> @@ -317,7 +386,7 @@ Returns a Maypole::Constant to indicate whether the user is authenticated for the Maypole request. -The default implimentation returns C +The default implementation returns C =head3 model_class @@ -387,28 +456,60 @@ Get/set the output content type. Default: text/html Sends the output and additional headers to the user. -=head1 SEE ALSO +=head3 call_authenticate + +This method first checks if the relevant model class +can authenticate the user, or falls back to the default +authenticate method of your Maypole application. + + +=head3 call_exception -There's more documentation, examples, and a wiki at the Maypole web -site: +This model is called to catch exceptions, first after authenticate, then after +processing the model class, and finally to check for exceptions from the view +class. -http://maypole.perl.org/ +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. -L,L, L. +=head3 make_random_id -=head1 MAINTAINER +returns a unique id for this request can be used to prevent or detect repeat submissions. -Sebastian Riedel, c +=head3 handler + +This method sets up the class if it's not done yet, sets some +defaults and leaves the dirty work to handler_guts. + +=head3 handler_guts + +This is the core of maypole. You don't want to know. + +=head1 SEE ALSO + +There's more documentation, examples, and a information on our mailing lists +at the Maypole web site: + +L + +L, L, L. =head1 AUTHOR -Simon Cozens, C +Maypole is currently maintained by Simon Flack C + +=head1 AUTHOR EMERITUS + +Simon Cozens, C + +Sebastian Riedel, C maintained Maypole from 1.99_01 to 2.04 -=head1 THANK YOU +=head1 THANKS TO -Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka, Marcus Ramberg, -Mickael Joanne, Simon Flack, 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