X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=de7fbebd5938fa46625919fe4c94869c3a8468ae;hb=b91bc53de6872ec4b22779382f6955b3af7c6fd5;hp=6ab5bc029860121331a1285467ef68d961f4a2ec;hpb=616082000cbe7305fbfc84d33bb2f9d53cc86f3c;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 6ab5bc0..de7fbeb 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -1,19 +1,22 @@ package Maypole; use base qw(Class::Accessor::Fast Class::Data::Inheritable); -use attributes (); use UNIVERSAL::require; use strict; use warnings; use Maypole::Config; -our $VERSION = '2.0'; +use Maypole::Constants; +use Maypole::Headers; + +our $VERSION = '2.05'; + __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) + args action template error document_encoding content_type table + headers_in headers_out ) ); __PACKAGE__->config( Maypole::Config->new() ); __PACKAGE__->init_done(0); -use Maypole::Constants; sub debug { 0 } @@ -22,6 +25,7 @@ sub setup { $calling_class = ref $calling_class if ref $calling_class; { no strict 'refs'; + no warnings 'redefine'; # Naughty. *{ $calling_class . "::handler" } = @@ -47,7 +51,7 @@ sub init { $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); @@ -58,7 +62,8 @@ sub handler { # See Maypole::Workflow before trying to understand this. my ( $class, $req ) = @_; $class->init unless $class->init_done; - my $r = bless { config => $class->config }, $class; + 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(); @@ -71,6 +76,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 ) { @@ -128,23 +134,16 @@ sub is_applicable { $config->ok_tables || $config->ok_tables( $config->display_tables ); $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } ) if ref $config->ok_tables eq "ARRAY"; - warn "We don't have that table ($self->{table})" + warn "We don't have that table ($self->{table}).\n" + . "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} }; - # Does the action method exist? - my $cv = $self->model_class->can( $self->{action} ); - 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" if $self->debug; - return DECLINED(); - } unless $self->{method_attribs} =~ /\bExported\b/i; + # Is it public? + return DECLINED unless $self->model_class->is_public( $self->{action} ); return OK(); } @@ -186,6 +185,7 @@ sub parse_path { shift @pi while @pi and !$pi[0]; $self->{table} = shift @pi; $self->{action} = shift @pi; + $self->{action} = "index" unless $self->{action}; $self->{args} = \@pi; } @@ -211,7 +211,7 @@ See L. =head1 DESCRIPTION This documents the Maypole request object. For user documentation, see -L. +L. =head2 CLASS METHODS @@ -221,11 +221,10 @@ Returns the L object =head3 setup - My::App->setup(); + My::App->setup($data_source, $user, $password, \%attr); - Initialise the maypole application and model classes. Your - application should - call this after setting configuration via L<"config"> +Initialise the maypole application and model classes. Your application should +call this after setting configuration via L<"config"> =head3 init @@ -241,9 +240,8 @@ Get/set the Maypole::View object sub My::App::debug {1} - Returns the debugging flag. Override this in your application class - to - enable/disable debugging. +Returns the debugging flag. Override this in your application class to +enable/disable debugging. =head2 INSTANCE METHODS @@ -282,6 +280,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. @@ -311,6 +317,13 @@ 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. @@ -355,7 +368,7 @@ C list. See L for more information. $r->template_args->{foo} = 'bar'; - Get/set a hash of template variables. +Get/set a hash of template variables. =head3 template @@ -395,6 +408,33 @@ Get/set the output content type. Default: text/html Sends the output and additional headers to the user. +=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 + +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. + +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. + + +=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 wiki at the Maypole web @@ -404,19 +444,19 @@ http://maypole.perl.org/ L,L, L. -=head1 MAINTAINER +=head1 AUTHOR Sebastian Riedel, c -=head1 AUTHOR +=head1 AUTHOR EMERITUS Simon Cozens, C -=head1 THANK YOU +=head1 THANKS TO -Danijel Milicevic, Jesse Scheidlower, Jody Belka, Marcus Ramberg, -Mickael Joanne, Simon Flack, Veljko Vidovic and all the others who've -helped. +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