Changeset 17

Show
Ignore:
Timestamp:
10/30/07 21:17:23 (6 years ago)
Author:
jesus
Message:

first whack at resolving mod_perl2 support. refs #8

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lib/Mungo.pm

    r16 r17  
    77use strict; 
    88use IO::File; 
    9 use Apache; 
    10 use Apache::Constants qw( OK NOT_FOUND ); 
     9eval " 
     10  use Apache2::RequestRec; 
     11  use Apache2::RequestUtil; 
     12  use Apache2::Const qw ( OK NOT_FOUND ); 
     13"; 
     14if($@) { 
     15  print STDERR "mod_perl2 not found: $@"; 
     16  eval " 
     17    use Apache; 
     18    use Apache::Constants qw( OK NOT_FOUND ); 
     19  "; 
     20  die $@ if $@; 
     21} 
    1122use MIME::Base64 qw/encode_base64 decode_base64/; 
    1223use Data::Dumper; 
    …… 
    7990  if($name =~ /Mungo::FilePage::([^:]+)::__content/) { 
    8091    my $filename = decode_base64($1); 
    81     my $r = Apache->request(); 
     92    my $r = $self->{'Apache::Request'}; 
    8293    if(UNIVERSAL::can($r, 'document_root')) { 
    8394      my $base = $r->document_root(); 
    …… 
    211222sub handler($$) { 
    212223  my ($self, $r) = @_; 
     224  if (ref $self eq 'Apache2::RequestRec') { 
     225    $r = $self; 
     226    $self = __PACKAGE__; 
     227  } 
    213228  # Short circuit if we can't fine the file. 
    214   return NOT_FOUND if(! -r $r->filename); 
     229  return NOT_FOUND() if(! -r $r->filename); 
    215230 
    216231  $self = $self->new($r) unless(ref $self); 

  • trunk/lib/Mungo/Cookie.pm

    r2 r17  
    77use strict; 
    88use Mungo::Utils; 
     9eval "use APR::Table;"; 
    910 
    1011my %reserved = ( 
    …… 
    2829  my $class = shift; 
    2930  my $arg = shift; 
    30   my $cstr =  (ref $arg && UNIVERSAL::can($arg, 'header_in')) ? # pull from 
    31                 $arg->header_in('Cookie') :         # Apache::Request 
    32                 $arg;                               # or a passed string 
     31  my $cstr =  (ref $arg && UNIVERSAL::can($arg, 'headers_in')) ? # pull from 
     32                $arg->headers_in->get('Cookie') :      # Apache2::RequestRec 
     33                (ref $arg && UNIVERSAL::can($arg, 'header_in')) ? 
     34                  $arg->header_in('Cookie') :          # Apache::Request 
     35                  $arg;                                # or a passed string 
    3336  my $self = bless {}, $class; 
    3437  foreach my $cookie (split /;\s*/, $cstr) {        # ; seperated cookies 
    …… 
    99102  } 
    100103  die __PACKAGE__ . 
    101     "->inject_header requires Apache::Request or Mungo::Response" 
    102       if(!$r || !UNIVERSAL::can($r, 'header_out')); 
     104    "->inject_header requires Apache2::RequestRec or Apache::Request or Mungo::Response" 
     105      if(!$r || (!UNIVERSAL::can($r, 'headers_out') && 
     106                 !UNIVERSAL::can($r, 'header_out'))); 
    103107  # $r is our Apache::Request at this point 
    104108  while(my ($cname, $info) = each %$self) { 
    105     $r->header_out('Set-Cookie', $self->make_cookie_string($cname, $info)); 
     109    my $cookiestr = $self->make_cookie_string($cname, $info); 
     110    $r->can('headers_out') ? 
     111      $r->headers_out->add('Set-Cookie', $cookiestr) : 
     112      $r->header_out('Set-Cookie', $cookiestr); 
    106113  } 
    107114  return; 

  • trunk/lib/Mungo/MultipartFormData.pm

    r11 r17  
    99use Mungo; 
    1010use Mungo::Request; 
     11eval "use Apache2::RequestIO;"; 
    1112 
    1213sub new { 
    …… 
    2122        $self->{$part->{name}} = $part; 
    2223        # Make this payload into an IO::Scalar 
    23         if($part->{payload}) { 
     24        if(exists($part->{payload})) { 
    2425          $part->{handle} = IO::Scalar->new(\$part->{payload}); 
    2526          delete $part->{payload}; 
    2627        } 
    27         $part->{handle}->seek(0,0); 
     28        $part->{handle}->seek(0,0) if(UNIVERSAL::can($part->{handle}, 'seek')); 
    2829      } 
    2930      else { 

  • trunk/lib/Mungo/Request.pm

    r13 r17  
    88use Mungo::Cookie; 
    99use Mungo::MultipartFormData; 
     10eval "use APR::Table;"; 
    1011our $AUTOLOAD; 
    1112 
    …… 
    2122    'Mungo' => $parent, 
    2223  ); 
    23   my $cl = $r->header_in('Content-Length'); 
    24   my $ct = $r->header_in('Content-Type'); 
     24  my $cl = $r->can('headers_in') ? $r->headers_in->get('Content-length') : 
     25                                   $r->header_in('Content-length'); 
     26  my $ct = $r->can('headers_in') ? $r->headers_in->get('Content-Type') : 
     27                                   $r->header_in('Content-Type'); 
    2528  if($r->method eq 'POST' && $cl) { 
    2629    $core_data{TotalBytes} = $cl; 
    …… 
    6366sub QueryString { 
    6467  my $self = shift; 
    65   my %qs = $self->{'Mungo'}->{'Apache::Request'}->args; 
     68  my (@params) = $self->{'Mungo'}->{'Apache::Request'}->args; 
     69  my %qs; 
     70  if(@params == 1) { 
     71    # in mod_perl2 ->args is just a string 
     72    %qs = (map { (split /=/, $_, 2) } (split /&/, $params[0])); 
     73  } 
     74  else { 
     75    # mod_perl1 splits it up for us 
     76    %qs = @params; 
     77  } 
    6678  return exists($qs{$_[0]})?$qs{$_[0]}:undef if(@_); 
    6779  return %qs if wantarray; 

  • trunk/lib/Mungo/Response.pm

    r15 r17  
    6969  } 
    7070  else { 
    71     $r->header_out('Cache-Control', $self->{CacheControl}); 
     71    if($r->can('headers_out')) { 
     72      $r->headers_out->set('Cache-Control' => $self->{CacheControl}); 
     73    } 
     74    else { 
     75      $r->header_out('Cache-Control' => $self->{CacheControl}); 
     76    } 
    7277  } 
    7378  $self->{Cookies}->inject_headers($r); 
    7479  $r->status($self->{Status}); 
    75   $r->send_http_header($self->{ContentType}); 
     80  $r->can('send_http_header') ? 
     81    $r->send_http_header($self->{ContentType}) : 
     82    $r->content_type($self->{ContentType});; 
    7683} 
    7784 
    …… 
    100107  my $r = $self->{'Apache::Request'}; 
    101108  die "Headers already sent." if($self->{'__HEADERS_SENT__'}); 
    102   $r->header_out(@_); 
     109  $r->can('headers_out') ? $r->headers_out->set(@_) : $r->header_out(@_); 
    103110} 
    104111sub Cookies { 
    …… 
    113120  die "Cannot redirect, headers already sent\n" if($self->{'__HEADERS_SENT__'}); 
    114121  $self->{Status} = shift || 302; 
    115   $self->{'Apache::Request'}->header_out('Location', $url); 
     122  my $r = $self->{'Apache::Request'}; 
     123  $r->can('headers_out') ? $r->headers_out->set('Location', $url) : 
     124                           $r->header_out('Location', $url); 
    116125  $self->send_http_header(); 
    117126  $self->End(); 

  • trunk/tests/pages/fileupload.asp

    r2 r17  
    1414  use Data::Dumper; 
    1515  print Dumper($a = $Request->Form()); 
     16 
     17  my $up1 = $Request->Form('upfile1'); 
     18  if($up1) { 
     19    my $fh = $up1->{handle}; 
     20    my $length = 0; 
     21    while(<$fh>) { 
     22      $length += length($_); 
     23    } 
     24    print "Length of upfile1: $length\n"; 
     25  } 
    1626%> 
    1727</pre> 

  • trunk/tests/pages/qs.asp

    r2 r17  
    2121print Dumper(%qs_hash); 
    2222 
    23 print "a=".$Request->QueryString('a')."\n"; 
    2423%> 
    2524</pre>