use strict;
use warnings;
+use URI;
+use URI::QueryParam;
+
use base 'Maypole';
use Maypole::Headers;
use Maypole::Constants;
our $MODPERL2;
our $modperl_version;
-# pjs -- fixed to use standard way from perl.apache.org
BEGIN {
- #eval 'use Apache;'; # could fuck shit up if you have some file na
- # named Apache.pm in your path forex CGI/Apache.pm
$MODPERL2 = ( exists $ENV{MOD_PERL_API_VERSION} and
$ENV{MOD_PERL_API_VERSION} >= 2 );
if ($MODPERL2) {
}
-
-
=head1 NAME
Apache::MVC - Apache front-end to Maypole
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?
-# pjs 4-7-06 fixed so it works but did not fix headers_in issue
sub redirect_request
{
my $r = shift;
$r->ar->status($status);
$r->ar->headers_out->set('Location' => $redirect_url);
- #$r->output("");
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;
}