]> git.decadent.org.uk Git - maypole.git/blobdiff - lib/Maypole.pm
Empty session attribute, and get_session method added to Maypole.pm, get_session...
[maypole.git] / lib / Maypole.pm
index 908662f844431fdfa6ca4dc2664abb672f9a8b86..cae420fea4bcf68d88ce41abdeafbfb15b167dbb 100644 (file)
@@ -6,8 +6,9 @@ use warnings;
 use Maypole::Config;
 use Maypole::Constants;
 use Maypole::Headers;
+use URI();
 
-our $VERSION = '2.10';
+our $VERSION = '2.11';
 
 # proposed privacy conventions:
 # - no leading underscore     - public to custom application code and plugins
@@ -19,7 +20,7 @@ __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
 __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 )
+        headers_in headers_out stash session)
 );
 __PACKAGE__->config( Maypole::Config->new() );
 __PACKAGE__->init_done(0);
@@ -115,13 +116,14 @@ sub handler_guts
     
     $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 = $@ ) 
@@ -225,37 +227,65 @@ sub __load_model
 # 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->display_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};
-
-    # Is it public?
-    return DECLINED unless $self->model_class->is_public($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 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) = @_;
@@ -271,6 +301,11 @@ sub call_authenticate
     return $self->authenticate($self);   
 }
 
+sub call_get_session {
+   my ($self) = @_;
+   return $self->get_session($self);
+}
+
 sub call_exception 
 {
     my ($self, $error) = @_;
@@ -285,27 +320,111 @@ sub call_exception
     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 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 || $self->action( shift @pi or 'index' );
+    
+    $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};
     
-    $self->action( shift @pi or 'index' );
+    my @add = ();
     
-    $self->args(\@pi);
+    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 
 { 
@@ -325,12 +444,24 @@ sub param
 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 redirect_internal_request {
+
 }
 
 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
@@ -421,8 +552,49 @@ Returns the request path
 
 =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
 
@@ -484,14 +656,23 @@ You should only need to define this method if you are writing a new
 Maypole backend. It should return something that looks like an Apache
 or CGI request object, it defaults to blank.
 
+=head3 default_table_view
 
 =head3 is_applicable
 
 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
 
@@ -531,6 +712,10 @@ C<objects> list. See L<Maypole::Model> for more information.
 
 Get/set a hash of template variables.
 
+=head3 stash
+
+A place to put custom application data. Not used by Maypole itself. 
+
 =head3 template
 
 Get/set the template to be used by the view. By default, it returns
@@ -591,6 +776,28 @@ exception method of your Maypole application.
 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 redirect_internal_request 
+
 =head3 handler
 
 This method sets up the class if it's not done yet, sets some
@@ -598,7 +805,10 @@ defaults and leaves the dirty work to handler_guts.
 
 =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
 
@@ -611,7 +821,7 @@ L<Maypole::Application>, L<Apache::MVC>, L<CGI::Maypole>.
 
 =head1 AUTHOR
 
-Maypole is currently maintained by Simon Flack C<simonflk#cpan.org>
+Maypole is currently maintained by Aaron Trevena
 
 =head1 AUTHOR EMERITUS