2.09 - maintain the order that plugins are loaded, add tests for Maypole::Application...

[maypole.git] / lib / CGI / Maypole.pm

diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index 88995ef0401e84d18030bca8a56ddf840b3fb323..f8c122962502a7d5c4a9454009e8bf4354050196 100644 (file)
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -3,48 +3,74 @@ use base 'Maypole';
 
 use strict;
 use warnings;
-our $VERSION = "0.3";
+use CGI::Simple;
+use Maypole::Headers;
+
+our $VERSION = '2.09';
 
 sub run {
-       my $self = shift;
-       return $self->handler();
+    my $self = shift;
+    return $self->handler();
 }
 
 sub get_request {
-       require CGI::Simple;
-       shift->{cgi} = CGI::Simple->new();
+    shift->{cgi} = CGI::Simple->new();
 }
 
+
 sub parse_location {
-     my $self = shift;
-     $self->{path} = $self->{cgi}->url(-absolute=>1, -path_info=>1);
-     my $loc = $self->{cgi}->url(-absolute=>1);
-     no warnings 'uninitialized';
-     $self->{path} =~ s/^($loc)?\///;
-     $self->parse_path;
-     $self->parse_args;
+    my $self = shift;
+    my $cgi = $self->{cgi};
+
+    # Reconstruct the request headers (as far as this is possible)
+    $self->headers_in(Maypole::Headers->new);
+    for my $http_header ($cgi->http) {
+        (my $field_name = $http_header) =~ s/^HTTPS?_//;
+        $self->headers_in->set($field_name => $cgi->http($http_header));
+    }
+
+    $self->{path} = $cgi->url( -absolute => 1, -path_info => 1 );
+    my $loc = $cgi->url( -absolute => 1 );
+    no warnings 'uninitialized';
+    $self->{path} .= '/' if $self->{path} eq $loc;
+    $self->{path} =~ s/^($loc)?\///;
+    $self->parse_path;
+    $self->parse_args;
 }
 
 sub parse_args {
-     my $self = shift;
-     $self->{params} = { $self->{cgi}->Vars };
-     $self->{query}  = { $self->{cgi}->Vars };
+    my $self = shift;
+    my (%vars) = $self->{cgi}->Vars;
+    while ( my ( $key, $value ) = each %vars ) {
+        my @values = split "\0", $value;
+        $vars{$key} = @values <= 1 ? $values[0] : \@values;
+    }
+    $self->{params} = {%vars};
+    $self->{query}  = {%vars};
 }
 
 sub send_output {
-     my $r = shift;    
-       print $r->{cgi}->header(-type => $r->{content_type},
-                                         -content_length => length $r->{output},
-                                         );
-     print $r->{output};
+    my $r = shift;
+
+    # Collect HTTP headers
+    my %headers = (
+        -type            => $r->{content_type},
+        -charset         => $r->{document_encoding},
+        -content_length  => do { use bytes; length $r->{output} },
+    );
+    foreach ($r->headers_out->field_names) {
+        next if /^Content-(Type|Length)/;
+        $headers{"-$_"} = $r->headers_out->get($_);
+    }
+
+    print $r->{cgi}->header(%headers), $r->{output};
 }
 
 sub get_template_root {
-     my $r = shift;
-     $r->{cgi}->document_root . "/". $r->{cgi}->url(-relative=>1);
+    my $r = shift;
+    $r->{cgi}->document_root . "/" . $r->{cgi}->url( -relative => 1 );
 }
 
-
 1;
 
 =head1 NAME
@@ -54,10 +80,11 @@ CGI::Maypole - CGI-based front-end to Maypole
 =head1 SYNOPSIS
 
      package BeerDB;
-     use base 'CGI::Maypole;
+     use base 'CGI::Maypole';
      BeerDB->setup("dbi:mysql:beerdb");
-     BeerDB->config->{uri_base} = "http://your.site/cgi-bin/beer.cgi/";
-     BeerDB->config->{display_tables} = [qw[beer brewery pub style]];
+     BeerDB->config->uri_base("http://your.site/cgi-bin/beer.cgi/");
+     BeerDB->config->display_tables([qw[beer brewery pub style]]);
+     BeerDB->config->template_root("/var/www/beerdb/");
      # Now set up your database:
      # has-a relationships
      # untaint columns
@@ -65,19 +92,55 @@ CGI::Maypole - CGI-based front-end to Maypole
      1;
 
      ## example beer.cgi:
-       
+
      #!/usr/bin/perl -w
      use strict;
      use BeerDB;
      BeerDB->run();
 
+Now to access the beer database, type this URL into your browser:
+http://your.site/cgi-bin/beer.cgi/frontpage
+
 =head1 DESCRIPTION
 
-This is a handler for Maypole which will use the CGI instead of Apache's
-C<mod_perl> 1.x. This handler can also be used for Apache 2.0.
+This is a CGI platform driver for Maypole. Your application can inherit from
+CGI::Maypole directly, but it is recommended that you use
+L<Maypole::Application>.
+
+
+=head1 METHODS
+
+=over
+
+=item run
+
+Call this from your CGI script to start the Maypole application.
+
+=back
+
+=head1 Implementation
+
+This class overrides a set of methods in the base Maypole class to provide it's
+functionality. See L<Maypole> for these:
+
+=over
+
+=item get_request
+
+=item get_template_root
+
+=item parse_args
+
+=item parse_location
+
+=item send_output
+
+=back
 
 =head1 AUTHORS
 
 Dave Ranney C<dave@sialia.com>
 
 Simon Cozens C<simon@cpan.org>
+
+=cut