hopefully fixed Apache::MVC with HTTP::Body fallback to handle url args

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@482 48953598-375a-da11-a14b-00016c27c3ee

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index 3fcdaacf0c8b701586cbed5ccc3e492f6af0fce9..0f6b7d0e9fc8c0dda03506ff398da25900b17cf0 100644 (file)
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -5,6 +5,9 @@ our $VERSION = '2.11';
 use strict;
 use warnings;
 
+use URI;
+use URI::QueryParam;
+
 use base 'Maypole';
 use Maypole::Headers;
 use Maypole::Constants;
@@ -14,10 +17,7 @@ __PACKAGE__->mk_accessors( qw( ar ) );
 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) {
@@ -41,8 +41,6 @@ BEGIN {
 
 }
 
-
-
 =head1 NAME
 
 Apache::MVC - Apache front-end to Maypole
@@ -122,7 +120,6 @@ sub parse_location {
         $path =~ s/^($loc)?\///;
     }
     $self->path($path);
-    
     $self->parse_path;
     $self->parse_args;
 }
@@ -141,8 +138,6 @@ sub 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;
@@ -164,7 +159,6 @@ sub redirect_request
 
   $r->ar->status($status);
   $r->ar->headers_out->set('Location' => $redirect_url);
-  #$r->output("");
   return OK;
 }
 
@@ -230,6 +224,23 @@ sub _mod_perl_args {
     } 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;
 }

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index 2dd0c3d3ae36925019de469d7c67e81e75855f0a..ab05605105bdde76df8a486519ae46e8099b15e7 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -12,7 +12,7 @@ use URI::QueryParam;
 use NEXT;
 use File::MMagic::XS qw(:compat);
 
-our $VERSION = '2.11_pre1';
+our $VERSION = '2.11_pre2';
 our $mmagic = File::MMagic::XS->new();
 
 # proposed privacy conventions: