8 use Maypole::Constants;
10 our $VERSION = '2.12';
12 __PACKAGE__->mk_accessors( qw/cgi/ );
16 CGI::Maypole - CGI-based front-end to Maypole
21 use Maypole::Application;
30 Now to access the beer database, type this URL into your browser:
31 http://your.site/cgi-bin/beer.cgi/frontpage
33 NOTE: this Maypole frontend requires additional modules that won't be installed
34 or included with Maypole. Please see below.
38 This is a CGI platform driver for Maypole. Your application can inherit from
39 CGI::Maypole directly, but it is recommended that you use
40 L<Maypole::Application>.
42 This module requires CGI::Simple which you will have to install yourself via
51 Call this from your CGI script to start the Maypole application.
60 return $self->handler;
65 This class overrides a set of methods in the base Maypole class to provide it's
66 functionality. See L<Maypole> for these:
76 my $request_options = $self->config->request_options || {};
77 $CGI::Simple::POST_MAX = $request_options->{POST_MAX} if ($request_options->{POST_MAX});
78 $self->cgi( CGI::Simple->new );
90 # Reconstruct the request headers (as far as this is possible)
91 $r->headers_in(Maypole::Headers->new);
92 for my $http_header ($cgi->http) {
93 (my $field_name = $http_header) =~ s/^HTTPS?_//;
94 $r->headers_in->set($field_name => $cgi->http($http_header));
97 $r->preprocess_location();
99 my $path = $cgi->url( -absolute => 1, -path_info => 1 );
100 my $loc = $cgi->url( -absolute => 1 );
102 no warnings 'uninitialized';
103 $path .= '/' if $path eq $loc;
105 $path =~ s/^($loc)?//;
107 $path =~ s/^($loc)?\///;
121 my ($self,@args) = @_;
122 my ($package, $line) = (caller)[0,2];
123 warn "[$package line $line] ", @args ;
134 my (%vars) = $r->cgi->Vars;
135 while ( my ( $key, $value ) = each %vars ) {
136 my @values = split "\0", $value;
137 $vars{$key} = @values <= 1 ? $values[0] : \@values;
139 $r->params( {%vars} );
140 $r->query( $r->params );
143 =item redirect_request
147 # FIXME: use headers_in to gather host and other information?
151 my $redirect_url = $_[0];
156 $redirect_url = $args{url};
158 my $path = $args{path} || $r->cgi->url(-absolute => 1, -query=>1);
159 my $host = $args{domain};
160 ($host = $r->cgi->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
161 my $protocol = $args{protocol} || $r->get_protocol;
162 $redirect_url = "${protocol}://${host}/${path}";
164 $status = $args{status} if ($args{status});
167 $r->headers_out->set('Status' => $status);
168 $r->headers_out->set('Location' => $redirect_url);
180 my $protocol = ($self->cgi->https) ? 'https' : 'http';
186 Generates output (using C<collect_output>) and prints it.
193 print $r->collect_output;
198 Gathers headers and output together into a string and returns it.
200 Splitting this code out of C<send_output> supports L<Maypole::HTTPD::Frontend>.
208 # Collect HTTP headers
210 -type => $r->content_type,
211 -charset => $r->document_encoding,
212 -content_length => do { use bytes; length $r->output },
214 foreach ($r->headers_out->field_names) {
215 next if /^Content-(Type|Length)/;
216 $headers{"-$_"} = $r->headers_out->get($_);
219 return $r->cgi->header(%headers) . $r->output;
222 =item get_template_root
226 sub get_template_root {
228 $r->cgi->document_root . "/" . $r->cgi->url( -relative => 1 );
242 Dave Ranney C<dave@sialia.com>
244 Simon Cozens C<simon@cpan.org>