lib/CGI/Maypole.pm

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