use Maypole::Constants;
use Maypole::Headers;
-our $VERSION = '2.10';
+our $VERSION = '2.11';
# proposed privacy conventions:
# - no leading underscore - public to custom application code and plugins
-# - single leading underscore - private to the main Maypole stack - *not* including plugins
+# - single leading underscore - private to the main Maypole stack - *not*
+# including plugins
# - double leading underscore - private to the current package
__PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
}
+sub new
+{
+ my ($class) = @_;
+
+ my $self = bless {
+ template_args => {},
+ config => $class->config,
+ }, $class;
+
+ return $self;
+}
+
# handler() has a method attribute so that mod_perl will invoke
# BeerDB->handler() as a method rather than a plain function
# BeerDB::handler() and so this inherited implementation will be
$class->init unless $class->init_done;
- # Create the request object
- my $r = bless {
- template_args => {},
- config => $class->config
- }, $class;
-
- $r->headers_out(Maypole::Headers->new);
+ my $self = $class->new;
- $r->get_request($req);
+ # initialise the request
+ $self->headers_out(Maypole::Headers->new);
+ $self->get_request($req);
+ $self->parse_location;
- $r->parse_location;
-
- my $status = $r->handler_guts;
+ my $status = $self->handler_guts;
# moving this here causes unit test failures - need to check why
# before committing the move
- #$status = $r->__call_process_view unless $r->output;
+ #$status = $self->__call_process_view unless $self->output;
return $status unless $status == OK;
- $r->send_output;
+ $self->send_output;
return $status;
}
# The root of all evil
sub handler_guts
{
- my ($r) = @_;
+ my ($self) = @_;
- $r->__load_model;
+ $self->__load_model;
- my $applicable = __to_boolean( $r->is_applicable );
+ my $applicable = __to_boolean( $self->is_applicable );
- $r->__setup_plain_template unless $applicable;
+ $self->__setup_plain_template unless $applicable;
# We authenticate every request, needed for proper session management
my $status;
- eval { $status = $r->call_authenticate };
+ eval { $status = $self->call_authenticate };
if ( my $error = $@ )
{
- $status = $r->call_exception($error);
+ $status = $self->call_exception($error);
if ( $status != OK )
{
warn "caught authenticate error: $error";
- return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
}
}
- if ( $r->debug and $status != OK and $status != DECLINED )
+ if ( $self->debug and $status != OK and $status != DECLINED )
{
- $r->view_object->error( $r,
+ $self->view_object->error( $self,
"Got unexpected status $status from calling authentication" );
}
return $status unless $status == OK;
# We run additional_data for every request
- $r->additional_data;
+ $self->additional_data;
if ($applicable)
{
- eval { $r->model_class->process($r) };
+ eval { $self->model_class->process($self) };
if ( my $error = $@ )
{
- $status = $r->call_exception($error);
+ $status = $self->call_exception($error);
if ( $status != OK )
{
warn "caught model error: $error";
- return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
}
}
}
- # unusual path - perhaps output has been set to an error message
- return OK if $r->output;
+ # less frequent path - perhaps output has been set to an error message
+ return OK if $self->output;
# normal path - no output has been generated yet
- return $r->__call_process_view;
+ return $self->__call_process_view;
}
# is_applicable() returned false, so set up a plain template. Model processing
# access it.
sub __setup_plain_template
{
- my ($r) = @_;
+ my ($self) = @_;
# It's just a plain template
- $r->model_class(undef);
+ $self->model_class(undef);
- my $path = $r->path;
+ my $path = $self->path;
$path =~ s{/$}{}; # De-absolutify
- $r->path($path);
+ $self->path($path);
- $r->template($r->path);
+ $self->template($self->path);
}
# The model has been processed or skipped (if is_applicable returned false),
-# any exceptions have been handled, and there's no content in $r->output
+# any exceptions have been handled, and there's no content in $self->output
sub __call_process_view
{
- my ($r) = @_;
+ my ($self) = @_;
my $status;
- eval { $status = $r->view_object->process($r) };
+ eval { $status = $self->view_object->process($self) };
if ( my $error = $@ )
{
- $status = $r->call_exception($error);
+ $status = $self->call_exception($error);
if ( $status != OK )
{
- warn "caught view error: $error" if $r->debug;
- return $r->debug ? $r->view_object->error($r, $error) : ERROR;
+ warn "caught view error: $error" if $self->debug;
+ return $self->debug ?
+ $self->view_object->error($self, $error) : ERROR;
}
}
sub __load_model
{
- my ($r) = @_;
- $r->model_class( $r->config->model->class_of($r, $r->table) );
+ my ($self) = @_;
+ $self->model_class( $self->config->model->class_of($self, $self->table) );
}
# is_applicable() should return true or false, not OK or DECLINED, because
# the return value is never used as the return value from handler(). There's
-# probably a lot of code out there supplying the return codes though, so instead
-# of changing is_applicable() to return 0 or 1, the return value is passed through
-# __to_boolean. I think it helps handler_guts() if we don't have multiple sets of
-# return codes being checked for different things.
+# probably a lot of code out there supplying the return codes though, so
+# instead of changing is_applicable() to return 0 or 1, the return value is
+# passed through __to_boolean. I think it helps handler_guts() if we don't
+# have multiple sets of return codes being checked for different things -drb.
sub is_applicable
{
- my ($r) = @_;
+ my ($self) = @_;
- my $config = $r->config;
+ my $config = $self->config;
$config->ok_tables || $config->ok_tables( $config->display_tables );
$config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
- if ref $config->ok_tables eq "ARRAY";
+ if ref $config->ok_tables eq "ARRAY";
- my $table = $r->table;
+ my $table = $self->table;
warn "We don't have that table ($table).\n"
- . "Available tables are: "
- . join( ",", @{ $config->display_tables } )
- if $r->debug
+ . "Available tables are: "
+ . join( ",", @{ $config->display_tables } )
+ if $self->debug
and not $config->ok_tables->{$table}
- and $r->action; # I think this is always true
+ and $self->action; # this is probably always true
return DECLINED unless exists $config->ok_tables->{$table};
+ my $path_is_ok = 0;
+ if (exists $config->ok_tables->{ $self->{table} }) {
+ $path_is_ok = 1;
+ } else {
+ if ( $self->_have_default_table_view ) {
+ my $path_is_ok = $self->default_table_view($self->{path},$self->{args});
+ }
+ unless ($path_is_ok) {
+ 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 $self->{action};
+ }
+ }
+
+ return DECLINED() unless $path_is_ok;
+
# Is it public?
- return DECLINED unless $r->model_class->is_public( $r->action );
+ return DECLINED unless $self->model_class->is_public($self->action);
return OK;
}
# *only* intended for translating the return code from is_applicable()
sub __to_boolean { $_[0] == OK ? 1 : 0 }
-
-
sub call_authenticate
{
- my ($r) = @_;
+ my ($self) = @_;
- # Check if we have a model class
- return $r->model_class->authenticate($r)
- if $r->model_class
- and $r->model_class->can('authenticate');
+ # Check if we have a model class with an authenticate() to delegate to
+ return $self->model_class->authenticate($self)
+ if $self->model_class and $self->model_class->can('authenticate');
- # passing $r is unnecessary and redundant, but there's probably
- # a lot of code out there now using the 2nd instead of the 1st $r,
- # so we may as well leave it
- return $r->authenticate($r);
+ # Interface consistency is a Good Thing -
+ # the invocant and the argument may one day be different things
+ # (i.e. controller and request), like they are when authenticate()
+ # is called on a model class (i.e. model and request)
+ return $self->authenticate($self);
}
sub call_exception
{
- my ($r, $error) = @_;
+ my ($self, $error) = @_;
- # Check if we have a model class
- if ( $r->model_class && $r->model_class->can('exception') )
+ # Check if we have a model class with an exception() to delegate to
+ if ( $self->model_class && $self->model_class->can('exception') )
{
- my $status = $r->model_class->exception( $r, $error );
+ my $status = $self->model_class->exception( $self, $error );
return $status if $status == OK;
}
- return $r->exception($error);
+ return $self->exception($error);
+}
+
+sub default_table_view {
+ my ($self,$path,$args) = @_;
+ my $path_is_ok = 0;
+ my $default_table_view = __PACKAGE__->_default_table_view;
+ # (path class action field)
+ my @path = $self->{path} =~ m{([^/]+)/?}g;
+ my $search_value = shift(@path);
+ if ($default_table_view->{path}) {
+ if ($default_table_view->{path} eq $search_value) {
+ $search_value = shift(@path);
+ } else {
+ return 0;
+ }
+ }
+
+ $self->{table} = $default_table_view->{class};
+ $self->{action} = $default_table_view->{action};
+ $self->{args} = [ $search_value,@path ];
+ return $path_is_ok;
}
sub additional_data { }
sub parse_path
{
- my ($r) = @_;
+ my ($self) = @_;
- $r->path || $r->path('frontpage');
+ $self->path || $self->path('frontpage');
- my @pi = grep {length} split '/', $r->path;
+ my @pi = grep {length} split '/', $self->path;
- $r->table(shift @pi);
+ $self->table(shift @pi);
- $r->action( shift @pi or 'index' );
+ $self->action( shift @pi or 'index' );
- $r->args(\@pi);
+ $self->args(\@pi);
}
# like CGI::param(), but read only
sub param
{
- my ($r, $key) = @_;
+ my ($self, $key) = @_;
- return keys %{$r->params} unless defined $key;
+ return keys %{$self->params} unless defined $key;
- return unless exists $r->params->{$key};
+ return unless exists $self->params->{$key};
- my $val = $r->params->{$key};
+ my $val = $self->params->{$key};
return ref $val ? @$val : ($val) if wantarray;
sub get_template_root {'.'}
sub get_request { }
+sub get_protocol {
+ die "get_protocol is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
+}
+
sub parse_location {
- die "Do not use Maypole directly; use Apache::MVC or similar";
+ die "parse_location is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
+}
+
+sub redirect_request {
+ die "parse_location is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
}
sub send_output {
- die "Do not use Maypole directly; use Apache::MVC or similar";
+ die "send_output is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
}
# Session and Repeat Submission Handling
add
application-specific initialisation.
+=head3 new
+
+Constructs a very minimal new Maypole request object.
+
=head3 view_object
Get/set the Maypole::View object
Returns a Maypole::Constant to indicate whether the request is valid.
-The default implementation checks that C<$r-E<gt>table> is publicly
+The default implementation checks that C<$self-E<gt>table> is publicly
accessible
-and that the model class is configured to handle the C<$r-E<gt>action>
+and that the model class is configured to handle the C<$self-E<gt>action>
=head3 authenticate
view
templates.
-If the first item in C<$r-E<gt>args> can be C<retrieve()>d by the model
+If the first item in C<$self-E<gt>args> can be C<retrieve()>d by the model
class,
it will be removed from C<args> and the retrieved object will be added
to the
=head3 template_args
- $r->template_args->{foo} = 'bar';
+ $self->template_args->{foo} = 'bar';
Get/set a hash of template variables.
=head3 template
Get/set the template to be used by the view. By default, it returns
-C<$r-E<gt>action>
+C<$self-E<gt>action>
=head3 exception
=head3 make_random_id
-returns a unique id for this request can be used to prevent or detect repeat submissions.
+returns a unique id for this request can be used to prevent or detect repeat
+submissions.
+
+=head3 get_protocol
+
+Returns the protocol the request was made with, i.e. https
+
+=head3 redirect_request
+
+Sets output headers to redirect based on the arguments provided
+
+Accepts either a single argument of the full url to redirect to, or a hash of named parameters :
+
+$r->redirect_request('http://www.example.com/path');
+
+or
+
+$r->redirect_request(protocol=>'https', domain=>'www.example.com', path=>'/path/file?arguments', status=>'302', url=>'..');
+
+The named parameters are protocol, domain, path, status and url
+
+Only 1 named parameter is required but other than url, they can be combined as required and current values (from the request) will be used in place of any missing arguments. The url argument must be a full url including protocol and can only be combined with status.
=head3 handler
=head3 handler_guts
-This is the core of maypole. You don't want to know.
+This is the main request handling method and calls various methods to handle the request/response
+and defines the workflow within Maypole.
+
+Currently undocumented and liable to be refactored without warning.
=head1 SEE ALSO