From 3d8147141cf009d244c8fde36da4a84b6a8b52d4 Mon Sep 17 00:00:00 2001 From: David Baird Date: Fri, 4 Nov 2005 15:55:08 +0000 Subject: [PATCH] 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 --- lib/CGI/Maypole.pm | 229 +++++++++++++++++++++++++-------------------- 1 file changed, 125 insertions(+), 104 deletions(-) diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm index a4835b8..27b74f2 100644 --- 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. + +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 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. - -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 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 -- 2.39.5