[Maypole] CGI::Maypole -- minor modification

Dave Ranney dave@sialia.com
Mon, 8 Mar 2004 22:11:50 -0800


Here's a new version of CGI::Maypole, with one small change. I've 
removed the requirement of CGI::Simple as the CGI class. It'll still 
use CGI::Simple by default, but there's no reason why someone shouldn't 
be able to subclass and override get_request() to use CGI.pm or any 
other module. (This is obviously akin to CGI::Application.)

-Dave

------

Dave Ranney
Ladera Ranch, Orange County, CA
dave@sialia.com
CA Birding Lists Digest: http://www.sialia.com/s/calists.pl


############################################

package CGI::Maypole;
use base 'Maypole';

use strict;
use warnings;
our $VERSION = "0.2";

sub run {
	my $self = shift;
	return $self->handler();
}

sub get_request {
	require CGI::Simple;
	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->{path} ||= "frontpage";
     my @pi = split /\//, $self->{path};
     shift @pi while @pi and !$pi[0];
     $self->{table} = shift @pi;
     $self->{action} = shift @pi;
     $self->{args} = \@pi;	
     $self->{params} = { $self->{cgi}->Vars };
     $self->{query}  = { $self->{cgi}->Vars };
}

sub send_output {
     my $r = shift;	
	print $r->{cgi}->header(-type => $r->{content_type},
					  -content_length => length $r->{output},
					  );
     print $r->{output};
}

sub get_template_root {
     my $r = shift;
     $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]];
     # Now set up your database:
     # has-a relationships
     # untaint columns

     1;

     ## example beer.cgi:
	
     #!/usr/bin/perl -w
     use strict;
     use BeerDB;
     BeerDB->run();