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;
}
}
sub get_request {
my ($self, $r) = @_;
- my $ar = ($MODPERL2) ? $r : Apache::Request->instance($r);
+ my $ar;
+ if ($MODPERL2) {
+ $ar = eval {require Apache2::Request} ? Apache2::Request->new($r) : $r;
+ }
+ else { $ar = Apache::Request->instance($r); }
$self->ar($ar);
}
=cut
+sub warn {
+ my ($self,@args) = @_;
+ my ($package, $line) = (caller)[0,2];
+ if ( $args[0] and ref $self ) {
+ $self->{ar}->warn("[$package line $line] ", @args) ;
+ } else {
+ print "warn called by ", caller, " with ", @_, "\n";
+ }
+ return;
+}
+
+=item warn
+
+=cut
+
sub parse_location {
my $self = shift;
$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->unparsed_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;
}