# 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};
# 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');
- # if the driver ($r) and the request ($r) ever get separated out
- # properly, then passing the request as an argument will make more sense
- 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 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;
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 handler
projects / maypole.git / commitdiff