X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FApache%2FMVC.pm;h=831527639e58336d5cb0afb8af647cbeaf1fb5eb;hb=2c5d6782f89dc1532398b1b79c8f67b982c758ac;hp=1695bf5f525d0332a5810b565f4acdc8f02c5886;hpb=32ecafee815b0fd8043c0acc2c785f5748fc20ff;p=maypole.git diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 1695bf5..8315276 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -101,6 +101,10 @@ sub get_request { $self->ar($ar); } +=item warn + +=cut + sub warn { my ($self,@args) = @_; my ($package, $line) = (caller)[0,2]; @@ -112,6 +116,7 @@ sub warn { return; } + =item parse_location =cut @@ -127,13 +132,20 @@ sub parse_location { for (keys %headers) { $self->headers_in->set($_, $headers{$_}); } + my $path = $self->ar->uri; my $loc = $self->ar->location; + { no warnings 'uninitialized'; $path .= '/' if $path eq $loc; - $path =~ s/^($loc)?\///; + if ($loc =~ /\/$/) { + $path =~ s/^($loc)?//; + } else { + $path =~ s/^($loc)?\///; + } } + $self->path($path); $self->parse_path; $self->parse_args; @@ -151,6 +163,24 @@ sub parse_args { =item 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. + =cut sub redirect_request