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);
}
+=item warn
+
+=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 parse_location
=cut
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;
} else {
my $body = $self->_prepare_body($apr);
%args = %{$body->param};
- my $uri = URI->new($self->ar->uri);
+ 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));