lib/CGI/Maypole.pm

   1 package CGI::Maypole;
   2 use base 'Maypole';
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '2.05';
   8
   9 sub run {
  10     my $self = shift;
  11     return $self->handler();
  12 }
  13
  14 sub get_request {
  15     require CGI::Simple;
  16     shift->{cgi} = CGI::Simple->new();
  17 }
  18
  19 sub parse_location {
  20     my $self = shift;
  21     $self->{path} = $self->{cgi}->url( -absolute => 1, -path_info => 1 );
  22     my $loc = $self->{cgi}->url( -absolute => 1 );
  23     no warnings 'uninitialized';
  24     $self->{path} =~ s/^($loc)?\///;
  25     $self->{path} .= '/' if $self->{path} eq $loc;
  26     $self->parse_path;
  27     $self->parse_args;
  28 }
  29
  30 sub parse_args {
  31     my $self = shift;
  32     my (%vars) = $self->{cgi}->Vars;
  33     while ( my ( $key, $value ) = each %vars ) {
  34         my @values = split "\0", $value;
  35         $vars{$key} = @values <= 1 ? $values[0] : \@values;
  36     }
  37     $self->{params} = {%vars};
  38     $self->{query}  = {%vars};
  39 }
  40
  41 sub send_output {
  42     my $r = shift;
  43     print $r->{cgi}->header(
  44         -type           => $r->{content_type},
  45         -charset        => $r->{document_encoding},
  46         -content_length => do { use bytes; length $r->{output} },
  47     );
  48     print $r->{output};
  49 }
  50
  51 sub get_template_root {
  52     my $r = shift;
  53     $r->{cgi}->document_root . "/" . $r->{cgi}->url( -relative => 1 );
  54 }
  55
  56 1;
  57
  58 =head1 NAME
  59
  60 CGI::Maypole - CGI-based front-end to Maypole
  61
  62 =head1 SYNOPSIS
  63
  64      package BeerDB;
  65      use base 'CGI::Maypole';
  66      BeerDB->setup("dbi:mysql:beerdb");
  67      BeerDB->config->uri_base("http://your.site/cgi-bin/beer.cgi/");
  68      BeerDB->config->display_tables([qw[beer brewery pub style]]);
  69      BeerDB->config->template_root("/var/www/beerdb/");
  70      # Now set up your database:
  71      # has-a relationships
  72      # untaint columns
  73
  74      1;
  75
  76      ## example beer.cgi:
  77
  78      #!/usr/bin/perl -w
  79      use strict;
  80      use BeerDB;
  81      BeerDB->run();
  82
  83 Now to access the beer database, type this URL into your browser:
  84 http://your.site/cgi-bin/beer.cgi/frontpage
  85
  86 =head1 DESCRIPTION
  87
  88 This is a handler for Maypole which will use the CGI instead of Apache's
  89 C<mod_perl> 1.x. This handler can also be used for Apache 2.0.
  90
  91 =head1 METHODS
  92
  93 =over
  94
  95 =item run
  96
  97 Call this from your CGI script to start the Maypole application.
  98
  99 =back
 100
 101 =head1 Implementation
 102
 103 This class overrides a set of methods in the base Maypole class to provide it's
 104 functionality. See L<Maypole> for these:
 105
 106 =over
 107
 108 =item get_request
 109
 110 =item get_template_root
 111
 112 =item parse_args
 113
 114 =item parse_location
 115
 116 =item send_output
 117
 118 =back
 119
 120 =head1 AUTHORS
 121
 122 Dave Ranney C<dave@sialia.com>
 123
 124 Simon Cozens C<simon@cpan.org>