use Maypole::Config;
use Maypole::Constants;
use Maypole::Headers;
+use URI();
our $VERSION = '2.11';
__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)
+ headers_in headers_out stash session)
);
__PACKAGE__->config( Maypole::Config->new() );
__PACKAGE__->init_done(0);
$self->__load_model;
- my $applicable = __to_boolean( $self->is_applicable );
+ my $applicable = $self->is_model_applicable;
$self->__setup_plain_template unless $applicable;
+
+ $self->session($self->call_get_session);
- # We authenticate every request, needed for proper session management
my $status;
-
+
eval { $status = $self->call_authenticate };
if ( my $error = $@ )
# 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
+sub is_model_applicable
{
my ($self) = @_;
+ # cater for applications that are using obsolete version
+ if ($self->can('is_applicable'))
+ {
+ warn "DEPRECATION WARNING: rewrite is_applicable to the interface ".
+ "of Maypole::is_model_applicable\n";
+ return $self->is_applicable == OK;
+ }
+
+ # Establish which tables should be processed by the model
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";
+
+ my $ok_tables = $config->ok_tables;
+ # Does this request concern a table to be processed by the model?
my $table = $self->table;
- warn "We don't have that table ($table).\n"
- . "Available tables are: "
- . join( ",", @{ $config->ok_tables } )
- if $self->debug
- and not $config->ok_tables->{$table}
- 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};
- }
+ my $ok = 0;
+
+ if (exists $ok_tables->{$table})
+ {
+ $ok = 1;
+ }
+# implements tj's default_table_view(), but there's no _default_table_view()
+# or _have_default_table_view() yet
+# else
+# {
+# $ok = $self->default_table_view($self->path, $self->args)
+# if $self->_have_default_table_view;
+# }
+
+ if (not $ok)
+ {
+ warn "We don't have that table ($table).\n"
+ . "Available tables are: "
+ . join( ",", keys %$ok_tables )
+ if $self->debug and not $ok_tables->{$table};
+
+ return 0;
}
-
- return DECLINED() unless $path_is_ok;
-
- # Is it public?
- return DECLINED unless $self->model_class->is_public($self->action);
- return OK;
+ # Is the action public?
+ my $action = $self->action;
+ return 1 if $self->model_class->is_public($action);
+
+ warn "The action '$action' is not applicable to the table $table"
+ if $self->debug;
+
+ return 0;
}
-# *only* intended for translating the return code from is_applicable()
-sub __to_boolean { $_[0] == OK ? 1 : 0 }
-
sub call_authenticate
{
my ($self) = @_;
return $self->authenticate($self);
}
+sub call_get_session {
+ my ($self) = @_;
+ return $self->get_session($self);
+}
+
sub call_exception
{
my ($self, $error) = @_;
sub authenticate { return OK }
+sub get_session { }
+
sub exception { return ERROR }
+sub preprocess_path { };
+
sub parse_path
{
my ($self) = @_;
+ $self->preprocess_path;
+
$self->path || $self->path('frontpage');
my @pi = grep {length} split '/', $self->path;
- $self->table(shift @pi);
+ $self->table || $self->table(shift @pi);
- $self->action( shift @pi or 'index' );
+ $self->action || $self->action( shift @pi or 'index' );
- $self->args(\@pi);
+ $self->args || $self->args(\@pi);
}
+
+sub make_path
+{
+ my $r = shift;
+
+ my %args;
+
+ if (@_ == 1 and ref $_[0] and ref $_[0] eq 'HASH')
+ {
+ %args = %{$_[0]};
+ }
+ elsif ( @_ > 1 and @_ < 4 )
+ {
+ $args{table} = shift;
+ $args{action} = shift;
+ $args{additional} = shift;
+ }
+ else
+ {
+ %args = @_;
+ }
+
+ do { die "no $_" unless $args{$_} } for qw( table action );
+
+ my $additional = $args{additional} || $args{id};
+
+ my @add = ();
+
+ if ($additional)
+ {
+ # if $additional is a href, make_uri() will transform it into a query
+ @add = (ref $additional eq 'ARRAY') ? @$additional : ($additional);
+ }
+
+ my $uri = $r->make_uri($args{table}, $args{action}, @add);
+
+ return $uri->as_string;
+}
+
+sub make_uri
+{
+ my ($r, @segments) = @_;
+
+ my $query = (ref $segments[-1] eq 'HASH') ? pop(@segments) : undef;
+
+ my $base = $r->config->uri_base;
+ $base =~ s|/$||;
+
+ my $uri = URI->new($base);
+ $uri->path_segments($uri->path_segments, grep {length} @segments);
+
+ my $abs_uri = $uri->abs('/');
+ $abs_uri->query_form($query) if $query;
+ return $abs_uri;
+}
+
+
# like CGI::param(), but read only
sub param
{
=head3 parse_path
-Parses the request path and sets the C<args>, C<action> and C<table>
-properties
+Parses the request path and sets the C<args>, C<action> and C<table>
+properties. Calls preprocess_path before parsing path and setting properties.
+
+=head3 make_path( %args or \%args or @args )
+
+This is the counterpart to C<parse_path>. It generates a path to use
+in links, form actions etc. To implement your own path scheme, just override
+this method and C<parse_path>.
+
+ %args = ( table => $table,
+ action => $action,
+ additional => $additional, # optional - generally an object ID
+ );
+
+ \%args = as above, but a ref
+
+ @args = ( $table, $action, $additional ); # $additional is optional
+
+C<id> can be used as an alternative key to C<additional>.
+
+C<$additional> can be a string, an arrayref, or a hashref. An arrayref is
+expanded into extra path elements, whereas a hashref is translated into a query
+string.
+
+=head3 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.
+
+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
+
+=head3 make_uri( @segments )
+
+Make a L<URI> object given table, action etc. Automatically adds
+the C<uri_base>.
+
+If the final element in C<@segments> is a hash ref, C<make_uri> will render it
+as a query string.
=head3 table
Returns a Maypole::Constant to indicate whether the request is valid.
-The default implementation checks that C<$self-E<gt>table> is publicly
-accessible
-and that the model class is configured to handle the C<$self-E<gt>action>
+B<This method is deprecated> as of version 2.11. If you have overridden it,
+please override C<is_model_applicable> instead, and change the return type
+from Maypole:Constants to true/false.
+
+=head3 is_model_applicable
+
+Returns true or false to indicate whether the request is valid.
+
+The default implementation checks that C<< $r->table >> is publicly
+accessible and that the model class is configured to handle the
+C<< $r->action >>.
=head3 authenticate
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 redirect_internal_request
+
=head3 handler
This method sets up the class if it's not done yet, sets some
=head1 AUTHOR
-Maypole is currently maintained by Simon Flack C<simonflk#cpan.org>
+Maypole is currently maintained by Aaron Trevena
=head1 AUTHOR EMERITUS
projects / maypole.git / blobdiff