package Maypole;
-use Class::C3;
use base qw(Class::Accessor::Fast Class::Data::Inheritable);
use UNIVERSAL::require;
use strict;
use NEXT;
use File::MMagic::XS qw(:compat);
-our $VERSION = '2.12';
+our $VERSION = '2.13';
our $mmagic = File::MMagic::XS->new();
# proposed privacy conventions:
__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 parent build_form_elements)
+ headers_in headers_out stash status parent build_form_elements
+ user session)
);
-__PACKAGE__->config( Maypole::Config->new() );
+__PACKAGE__->config( Maypole::Config->new({additional => { }, request_options => { }, view_options => { },}) );
__PACKAGE__->init_done(0);
return $self->status unless $self->status == Maypole::Constants::OK();
die "status undefined after start_request_hook()" unless defined
$self->status;
- $self->get_session;
- $self->get_user;
+
+ my $session = $self->get_session;
+ $self->session($self->{session} || $session);
+ my $user = $self->get_user;
+ $self->user($self->{user} || $user);
+
my $status = $self->handler_guts;
return $status unless $status == OK;
# TODO: require send_output to return a status code
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
+component sub-request, only what is included in the url passed as an argument
to the method
=cut
$self->args([]);
$self->objects([]);
- $self->get_user;
+ $self->session($self->get_session);
+ $self->user($self->get_user);
+
my $url = URI->new($path);
$self->{path} = $url->path;
$self->parse_path;
# We run additional_data for every request
$self->additional_data;
+ # process request with model if applicable and template not set.
if ($applicable) {
- eval { $self->model_class->process($self) };
- if ( my $error = $@ ) {
- $status = $self->call_exception($error, "model");
- if ( $status != OK ) {
- $self->warn("caught model error: $error");
- return $self->debug ?
- $self->view_object->error($self, $error) : ERROR;
+ unless ($self->{template}) {
+ eval { $self->model_class->process($self) };
+ if ( my $error = $@ ) {
+ $status = $self->call_exception($error, "model");
+ if ( $status != OK ) {
+ $self->warn("caught model error: $error");
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
+ }
}
}
} else {
sub __get_mime_type {
my $self = shift;
my $type = 'text/html';
- if ($self->path =~ m/.*\.(\w{3,4})$/) {
+ if ($self->path =~ m/.*\.(\w{2,4})$/) {
$type = $filetypes{$1};
} else {
my $output = $self->output;
=cut
-sub parse_path
-{
+sub parse_path {
my ($self) = @_;
# Previous versions unconditionally set table, action and args to whatever
=item preprocess_path
Sometimes when you don't want to rewrite or over-ride parse_path but
-want to rewrite urls or extract data from them before it is parsed.
+want to rewrite urls or extract data from them before it is parsed,
+the preprocess_path/location methods allow you to munge paths and urls
+before maypole maps them to actions, classes, etc.
This method is called after parse_location has populated the request
information and before parse_path has populated the model and action
information, and is passed the request object.
You can set action, args or table in this method and parse_path will
-then leave those values in place or populate them if not present
+then leave those values in place or populate them based on the current
+value of the path attribute if they are not present.
=cut
sub preprocess_path { };
+=item preprocess_location
+
+This method is called at the start of parse_location, after the headers in, and allows you
+to rewrite the url used by maypole, or dynamically set configuration
+like the base_uri based on the hostname or path.
+
+=cut
+
+sub preprocess_location { };
+
=item make_path( %args or \%args or @args )
This is the counterpart to C<parse_path>. It generates a path to use
=cut
+
sub make_path
{
my $r = shift;
$self->params->{$key} = $new_val;
}
- return ref $val ? @$val : ($val) if wantarray;
+ return (ref $val eq 'ARRAY') ? @$val : ($val) if wantarray;
- return ref $val ? $val->[0] : $val;
+ return (ref $val eq 'ARRAY') ? $val->[0] : $val;
}