use strict;
use warnings;
+use URI;
+use URI::QueryParam;
+
use base 'Maypole';
use Maypole::Headers;
use Maypole::Constants;
our $modperl_version;
BEGIN {
- eval 'use Apache;';
- if ($@) {
- eval 'use mod_perl2; $modperl_version = $mod_perl2::VERSION; ';
- if ($@) {
- $modperl_version = $Apache2::RequestRec::VERSION;
- }
- require Apache2::RequestIO;
- require Apache2::RequestRec;
- require Apache2::RequestUtil;
- require APR::URI;
- require HTTP::Body;
- $MODPERL2 = 1;
+ $MODPERL2 = ( exists $ENV{MOD_PERL_API_VERSION} and
+ $ENV{MOD_PERL_API_VERSION} >= 2 );
+ if ($MODPERL2) {
+ eval 'use mod_perl2; $modperl_version = $mod_perl2::VERSION;';
+ if ($@) {
+ $modperl_version = $Apache2::RequestRec::VERSION;
+ }
+ require Apache2::RequestIO;
+ require Apache2::RequestRec;
+ require Apache2::RequestUtil;
+ eval 'use Apache2::Const -compile => qw/REDIRECT/;'; # -compile 4 no import
+ require APR::URI;
+ require HTTP::Body;
} else {
- eval ' use mod_perl; ';
- require Apache;
- require Apache::Request;
- $MODPERL2 = 0;
- $modperl_version = 1;
+ eval ' use mod_perl; ';
+ require Apache;
+ require Apache::Request;
+ eval 'use Apache::Constants -compile => qw/REDIRECT/;';
+ $modperl_version = 1;
}
}
$path =~ s/^($loc)?\///;
}
$self->path($path);
-
$self->parse_path;
$self->parse_args;
}
=cut
-# FIXME: use headers_in to gather host and other information?
-sub redirect_request
+sub redirect_request
{
my $r = shift;
my $redirect_url = $_[0];
- my $status = "302";
+ my $status = $MODPERL2 ? eval 'Apache2::Const::REDIRECT;' :
+ eval 'Apache::Constants::REDIRECT;'; # why have to eval this?
if ($_[1]) {
my %args = @_;
if ($args{url}) {
$status = $args{status} if ($args{status});
}
- $r->headers_out->set('Status' => $status);
- $r->headers_out->set('Location' => $redirect_url);
+ $r->ar->status($status);
+ $r->ar->headers_out->set('Location' => $redirect_url);
return OK;
}
} else {
my $body = $self->_prepare_body($apr);
%args = %{$body->param};
+ my $uri = URI->new($self->ar->uri);
+ foreach my $key ($uri->query_param) {
+ if (ref $args{$key}) {
+ push (@{$args{$key}}, $uri->query_param($key));
+ } else {
+ if ($args{$key}) {
+ $args{$key} = [ $args{$key}, $uri->query_param($key) ];
+ } else {
+ my @args = $uri->query_param($key);
+ if (scalar @args > 1) {
+ $args{$key} = [ $uri->query_param($key) ];
+ } else {
+ $args{$key} = $uri->query_param($key);
+ }
+ }
+ }
+ }
}
return %args;
}