X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FCGI%2FMaypole.pm;h=88abc3cebf7218ed1f8c419937834ca04c96d5bd;hb=271fd90b8a1b9f843853601a75a1334407ff87c4;hp=88995ef0401e84d18030bca8a56ddf840b3fb323;hpb=848b997e719a53b09936a570527c0f3b9366709b;p=maypole.git diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm index 88995ef..88abc3c 100644 --- a/lib/CGI/Maypole.pm +++ b/lib/CGI/Maypole.pm @@ -3,48 +3,61 @@ use base 'Maypole'; use strict; use warnings; -our $VERSION = "0.3"; +use CGI::Simple; + +our $VERSION = '2.05'; 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; + $self->{path} = $self->{cgi}->url( -absolute => 1, -path_info => 1 ); + my $loc = $self->{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; + my %processed = map { "-".$_,$r->{extra_headers}{$_} } + keys %{$r->{extra_headers}}; + print $r->{cgi}->header( + -type => $r->{content_type}, + -charset => $r->{document_encoding}, + -content_length => do { use bytes; length $r->{output} }, + %processed + ? %processed + : {} + ); + print $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 +67,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,17 +79,49 @@ 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 1.x. This handler can also be used for Apache 2.0. +=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 parse_args + +=item parse_location + +=item send_output + +=back + =head1 AUTHORS Dave Ranney C