Rearranged pod for new methods

[maypole.git] / lib / Maypole.pm

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 36f085880f02f11b1f523ebdf577510eb2d8870e..34446a2ad147b5ef3b651883486aabecb040be9e 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -6,6 +6,7 @@ use warnings;
 use Maypole::Config;
 use Maypole::Constants;
 use Maypole::Headers;
+use URI();
 
 our $VERSION = '2.11';
 
@@ -284,9 +285,6 @@ sub is_model_applicable
     return 0;
 }
 
-# *only* intended for translating the return code from is_applicable()
-sub __to_boolean { $_[0] == OK ? 1 : 0 }
-
 sub call_authenticate 
 {
     my ($self) = @_;
@@ -358,6 +356,63 @@ sub parse_path
     $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 
 { 
@@ -488,6 +543,35 @@ Returns the request path
 Parses the request path and sets the C<args>, C<action> and C<table> 
 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 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
 
 The table part of the Maypole request path
@@ -688,6 +772,8 @@ 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