use Maypole::Headers;
use Maypole::Constants;
-our $VERSION = '2.10';
+our $VERSION = '2.13';
-__PACKAGE__->mk_accessors( qw( cgi ) );
+__PACKAGE__->mk_accessors( qw/cgi/ );
=head1 NAME
=cut
-sub run
-{
- my $self = shift;
- return $self->handler;
+sub run {
+ my $self = shift;
+ my $status = $self->handler;
+ if ($status != OK) {
+ print <<EOT;
+Status: 500 Maypole application error
+Content-Type: text/html
+
+<title>Maypole application error</h1>
+<h1>Maypole application error</h1>
+EOT
+ }
+ return $status;
}
=head1 Implementation
=cut
-sub get_request
-{
- shift->cgi( CGI::Simple->new );
-}
-
-=item get_protocol
-
-=cut
-
-sub get_protocol
-{
+sub get_request {
my $self = shift;
- my $protocol = ($self->cgi->https) ? 'https' : 'http';
- return $protocol;
+ my $request_options = $self->config->request_options || {};
+ $CGI::Simple::POST_MAX = $request_options->{POST_MAX} if ($request_options->{POST_MAX});
+ $self->cgi( CGI::Simple->new );
}
=item parse_location
$r->headers_in->set($field_name => $cgi->http($http_header));
}
+ $r->preprocess_location();
+
my $path = $cgi->url( -absolute => 1, -path_info => 1 );
my $loc = $cgi->url( -absolute => 1 );
{
no warnings 'uninitialized';
$path .= '/' if $path eq $loc;
- $path =~ s/^($loc)?\///;
+ if ($loc =~ /\/$/) {
+ $path =~ s/^($loc)?//;
+ } else {
+ $path =~ s/^($loc)?\///;
+ }
}
$r->path($path);
$r->parse_args;
}
+=item warn
+
+=cut
+
+sub warn {
+ my ($self,@args) = @_;
+ my ($package, $line) = (caller)[0,2];
+ warn "[$package line $line] ", @args ;
+ return;
+}
+
=item parse_args
=cut
my $path = $args{path} || $r->cgi->url(-absolute => 1, -query=>1);
my $host = $args{domain};
($host = $r->cgi->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
- my $protocol = $args{protocol} || ($r->cgi->https()) ? 'https' : 'http';
+ my $protocol = $args{protocol} || $r->get_protocol;
$redirect_url = "${protocol}://${host}/${path}";
}
$status = $args{status} if ($args{status});
return;
}
+=item get_protocol
+
+=cut
+
+sub get_protocol
+{
+ my $self = shift;
+ my $protocol = ($self->cgi->https) ? 'https' : 'http';
+ return $protocol;
+}
+
=item send_output
+Generates output (using C<collect_output>) and prints it.
+
=cut
sub send_output
{
my $r = shift;
+ print $r->collect_output;
+}
+
+=item collect_output
+
+Gathers headers and output together into a string and returns it.
+
+Splitting this code out of C<send_output> supports L<Maypole::HTTPD::Frontend>.
+=cut
+
+sub collect_output
+{
+ my $r = shift;
+
# Collect HTTP headers
my %headers = (
-type => $r->content_type,
$headers{"-$_"} = $r->headers_out->get($_);
}
- print $r->cgi->header(%headers), $r->output;
+ return $r->cgi->header(%headers) . $r->output;
}
=item get_template_root