X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole.pm;h=83607c8db34137662cf0694cf8a494179d319d18;hb=f94c2679992bf0db0b360a0a475b3e646466aee0;hp=5db199b484ae12a13c492aa3c16e64e419476e51;hpb=688f03716c8809f3e5cd1a2bf95276b3c45747cf;p=maypole.git diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 5db199b..83607c8 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -3,11 +3,13 @@ use base qw(Class::Accessor::Fast Class::Data::Inheritable); use UNIVERSAL::require; use strict; use warnings; +use Data::Dumper; use Maypole::Config; use Maypole::Constants; use Maypole::Headers; -use Maypole::Components; use URI(); +use URI::QueryParam; +use NEXT; use File::MMagic::XS qw(:compat); our $VERSION = '2.11'; @@ -202,7 +204,7 @@ __PACKAGE__->mk_classdata($_) for qw( config init_done view_object model_classes __PACKAGE__->mk_accessors( qw( params query objects model_class template_args output path args action template error document_encoding content_type table - headers_in headers_out stash status) + headers_in headers_out stash status parent) ); __PACKAGE__->config( Maypole::Config->new() ); @@ -253,7 +255,7 @@ Some packages respond to higher debug levels, try increasing it to 2 or 3. =cut -sub debug { 0 } +sub debug { 1 } =item config @@ -273,7 +275,7 @@ documentation. However here is the most usage of setup where Maypole::Model::CDBI is the base class. My::App->setup($data_source, $user, $password, - { opitons => { # These are DB connection options + { options => { # These are DB connection options AutoCommit => 0, RaiseError => 1, ... @@ -317,12 +319,11 @@ sub setup_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; - + unshift @{ $subclass . "::ISA" }, $config->model; } # Load custom model code, if it exists - nb this must happen after the @@ -444,8 +445,9 @@ sub handler : method { # initialise the request $self->headers_out(Maypole::Headers->new); $self->get_request($req); + $self->parse_location; - + # hook useful for declining static requests e.g. images, or perhaps for # sanitizing request parameters $self->status(Maypole::Constants::OK()); # set the default @@ -459,6 +461,7 @@ sub handler : method { $self->get_user; my $status = $self->handler_guts; + return $status unless $status == OK; # TODO: require send_output to return a status code @@ -467,12 +470,52 @@ sub handler : method { return $status; } +=item component + + Run Maypole sub-requests as a component of the request + + [% request.component("/beer/view_as_component/20") %] + + Allows you to integrate the results of a Maypole request into an existing +request. You'll need to set up actions and templates +which return fragments of HTML rather than entire pages, but once you've +done that, you can use the C method of the Maypole request object +to call those actions. You may pass a query string in the usual URL style. + +You should not fully qualify the Maypole URLs. + +Note: any HTTP POST or URL parameters passed to the parent are not passed to the +component sub-request, only what is included in the url passed as an argyument +to the method + +=cut + sub component { - my ($r,$path) = @_; - my $component = Maypole::Components->new(@_); - return $component->handler($path); + my ( $r, $path ) = @_; + my $self = bless { parent => $r, config => $r->{config}, template_args => {}, }, ref $r; + $self->get_user; + my $url = URI->new($path); + warn "path : $path\n"; + $self->{path} = $url->path; + $self->parse_path; + $self->params( $url->query_form_hash ); + $self->handler_guts; + return $self->output; } +sub get_template_root { + my $self = shift; + my $r = shift; + return $r->parent->get_template_root if $r->{parent}; + return $self->NEXT::DISTINCT::get_template_root( $r, @_ ); +} + +sub view_object { + my $self = shift; + my $r = shift; + return $r->parent->view_object if $r->{parent}; + return $self->NEXT::DISTINCT::view_object( $r, @_ ); +} # Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other # plugins also get to call the hook, we can cycle through the application's @@ -524,17 +567,14 @@ sub handler_guts $self->__load_request_model; my $applicable = $self->is_model_applicable == OK; - - $self->__setup_plain_template unless $applicable; my $status; + # handle authentication eval { $status = $self->call_authenticate }; - if ( my $error = $@ ) { $status = $self->call_exception($error, "authentication"); - if ( $status != OK ) { warn "caught authenticate error: $error"; @@ -542,35 +582,33 @@ sub handler_guts $self->view_object->error($self, $error) : ERROR; } } - if ( $self->debug and $status != OK and $status != DECLINED ) { $self->view_object->error( $self, "Got unexpected status $status from calling authentication" ); } - + return $status unless $status == OK; # We run additional_data for every request $self->additional_data; - - if ($applicable) - { - eval { $self->model_class->process($self) }; - - if ( my $error = $@ ) + + if ($applicable) { + eval { $self->model_class->process($self) }; + if ( my $error = $@ ) { - $status = $self->call_exception($error, "model"); - - if ( $status != OK ) + $status = $self->call_exception($error, "model"); + if ( $status != OK ) { - warn "caught model error: $error"; - return $self->debug ? - $self->view_object->error($self, $error) : ERROR; + warn "caught model error: $error"; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } } + } else { + $self->__setup_plain_template; } - + # less frequent path - perhaps output has been set to an error message return OK if $self->output; @@ -580,6 +618,7 @@ sub handler_guts $self->{content_type} ||= $self->__get_mime_type(); $self->{document_encoding} ||= "utf-8"; + return $processed_view_ok; } @@ -592,11 +631,14 @@ my %filetypes = ( sub __get_mime_type { my $self = shift; - my $type; + my $type = 'text/html'; if ($self->path =~ m/.*\.(\w{3,4})$/) { $type = $filetypes{$1}; } else { - $type = $mmagic->checktype_contents($self->output); + my $output = $self->output; + if (defined $output) { + $type = $mmagic->checktype_contents($output); + } } return $type; } @@ -613,7 +655,7 @@ sub __load_request_model sub __setup_plain_template { my ($self) = @_; - + # It's just a plain template $self->model_class(undef); @@ -626,27 +668,24 @@ sub __setup_plain_template # The model has been processed or skipped (if is_applicable returned false), # any exceptions have been handled, and there's no content in $self->output -sub __call_process_view -{ - my ($self) = @_; - - my $status; - - eval { $status = $self->view_object->process($self) }; - - if ( my $error = $@ ) - { - $status = $self->call_exception($error, "view"); - - if ( $status != OK ) - { - warn "caught view error: $error" if $self->debug; - return $self->debug ? - $self->view_object->error($self, $error) : ERROR; - } +sub __call_process_view { + my ($self) = @_; + + my $status = eval { $self->view_object->process($self) }; + + my $error = $@ || $self->{error}; + + if ( $error ) { + $status = $self->call_exception($error, "view"); + + if ( $status != OK ) { + warn "caught view error: $error" if $self->debug; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } - - return $status; + } + + return $status; } =item get_request @@ -1080,8 +1119,6 @@ backend. Otherwise, see L =cut -sub get_template_root {'.'} - =back =head2 Request properties @@ -1405,8 +1442,7 @@ L, L, L. =head1 AUTHOR -Maypole is currently maintained by Aaron Trevena, David Baird, Dave Howorth and -Peter Speltz. +Maypole is currently maintained by Aaron Trevena. =head1 AUTHOR EMERITUS