CGI::Maypole - rearranged pod, removed direct hash access, added cgi()

accessor (!), changed $self to $r

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

diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index a4835b8a3c6adfdc74d37e636577d7b4c0a3a572..27b74f261d4cf4bf20c1d1c01a0efe47c0d39dcc 100644 (file)
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -9,55 +9,137 @@ use Maypole::Constants;
 
 our $VERSION = '2.10';
 
-sub run {
+__PACKAGE__->mk_accessors( qw( cgi ) );
+
+=head1 NAME
+
+CGI::Maypole - CGI-based front-end to Maypole
+
+=head1 SYNOPSIS
+
+     package BeerDB;
+     use Maypole::Application;
+
+     ## 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
+
+NOTE: this Maypole frontend requires additional modules that won't be installed
+or included with Maypole. Please see below.
+
+=head1 DESCRIPTION
+
+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>.
+
+This module requires CGI::Simple which you will have to install yourself via
+CPAN or manually.
+
+=head1 METHODS
+
+=over
+
+=item run
+
+Call this from your CGI script to start the Maypole application.
+
+=back
+
+=cut
+
+sub run 
+{
     my $self = shift;
-    return $self->handler();
+    return $self->handler;
 }
 
-sub get_request {
-    shift->{cgi} = CGI::Simple->new();
+=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
+
+=cut
+
+sub get_request 
+{
+    shift->cgi( CGI::Simple->new );
 }
 
-sub get_protocol {
+=item get_protocol
+
+=cut
+
+sub get_protocol 
+{
   my $self = shift;
-  my $protocol = ($self->{cgi}->https()) ? 'https' : 'http';
+  my $protocol = ($self->cgi->https) ? 'https' : 'http';
   return $protocol;
 }
 
-sub parse_location {
-    my $self = shift;
-    my $cgi = $self->{cgi};
+=item parse_location
+
+=cut
+
+sub parse_location 
+{
+    my $r = shift;
+    my $cgi = $r->cgi;
 
     # Reconstruct the request headers (as far as this is possible)
-    $self->headers_in(Maypole::Headers->new);
+    $r->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));
+        $r->headers_in->set($field_name => $cgi->http($http_header));
     }
 
-    $self->{path} = $cgi->url( -absolute => 1, -path_info => 1 );
+    my $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;
+    {
+        no warnings 'uninitialized';
+        $path .= '/' if $path eq $loc;
+        $path =~ s/^($loc)?\///;
+    }
+    $r->path($path);
+    
+    $r->parse_path;
+    $r->parse_args;
 }
 
-sub parse_args {
-    my $self = shift;
-    my (%vars) = $self->{cgi}->Vars;
+=item parse_args
+
+=cut
+
+sub parse_args 
+{
+    my $r = shift;
+    my (%vars) = $r->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};
+    $r->params( {%vars} );
+    $r->query( $r->params );
 }
 
+=item redirect_request
+
+=cut
+
 # FIXME: use headers_in to gather host and other information?
-sub redirect_request {
-  my $self = shift;
+sub redirect_request 
+{
+  my $r = shift;
   my $redirect_url = $_[0];
   my $status = "302";
   if ($_[1]) {
@@ -65,115 +147,54 @@ sub redirect_request {
     if ($args{url}) {
       $redirect_url = $args{url};
     } else {
-      my $path = $args{path} || $self->{cgi}->url(-absolute => 1, -query=>1);
+      my $path = $args{path} || $r->cgi->url(-absolute => 1, -query=>1);
       my $host = $args{domain};
-      ($host = $self->{cgi}->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
-      my $protocol = $args{protocol} || ($self->{cgi}->https()) ? 'https' : 'http';
+      ($host = $r->cgi->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
+      my $protocol = $args{protocol} || ($r->cgi->https()) ? 'https' : 'http';
       $redirect_url = "${protocol}://${host}/${path}";
     }
     $status = $args{status} if ($args{status});
   }
 
-  $self->headers_out->set('Status' => $status);
-  $self->headers_out->set('Location' => $redirect_url);
+  $r->headers_out->set('Status' => $status);
+  $r->headers_out->set('Location' => $redirect_url);
 
   return;
 }
 
+=item send_output
 
-sub send_output {
+=cut
+
+sub send_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} },
+        -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};
+    print $r->cgi->header(%headers), $r->output;
 }
 
+=item get_template_root
+
+=cut
+
 sub get_template_root {
     my $r = shift;
-    $r->{cgi}->document_root . "/" . $r->{cgi}->url( -relative => 1 );
+    $r->cgi->document_root . "/" . $r->cgi->url( -relative => 1 );
 }
 
 1;
 
-=head1 NAME
-
-CGI::Maypole - CGI-based front-end to Maypole
-
-=head1 SYNOPSIS
-
-     package BeerDB;
-     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->template_root("/var/www/beerdb/");
-     # Now set up your database:
-     # has-a relationships
-     # untaint columns
-
-     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
-
-NOTE: this Maypole frontend requires additional modules that won't be installed or included with Maypole. Please see below.
-
-=head1 DESCRIPTION
-
-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>.
-
-This module requires CGI::Simple which you will have to install yourself via CPAN or manually.
-
-=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 get_protocol
-
-=item parse_args
-
-=item parse_location
-
-=item send_output
-
-=item redirect_request
-
 
 =back