X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FCGI%2FMaypole.pm;h=bb6de3f79a1b892cadf91a58159884aaf8ea4107;hb=2e483f35964e1ddd2022df6adc2b6d6a631c0cbd;hp=7ea9ee7a9b153cf425946ca087227a645fef3dcc;hpb=5ca6a1765a44c39b23e7bab0e2ba636dbc6b57a8;p=maypole.git

diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index 7ea9ee7..bb6de3f 100644
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -5,8 +5,9 @@ use strict;
 use warnings;
 use CGI::Simple;
 use Maypole::Headers;
+use Maypole::Constants;
 
-our $VERSION = '2.08';
+our $VERSION = '2.10';
 
 sub run {
     my $self = shift;
@@ -17,6 +18,11 @@ sub get_request {
     shift->{cgi} = CGI::Simple->new();
 }
 
+sub get_protocol {
+  my $self = shift;
+  my $protocol = ($self->{cgi}->https()) ? 'https' : 'http';
+  return $protocol;
+}
 
 sub parse_location {
     my $self = shift;
@@ -49,6 +55,32 @@ sub parse_args {
     $self->{query}  = {%vars};
 }
 
+# FIXME: use headers_in to gather host and other information?
+sub redirect_request {
+  my $self = shift;
+  my $redirect_url = $_[0];
+  my $status = "302";
+  if ($_[1]) {
+    my %args = @_;
+    if ($args{url}) {
+      $redirect_url = $args{url};
+    } else {
+      my $path = $args{path} || $self->{cgi}->url(-absolute => 1, -query=>1);
+      my $host = $args{domain};
+      ($host = $self->{cgi}->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
+      my $protocol = $args{protocol} || ($self->{cgi}->https()) ? 'https' : 'http';
+      $redirect_url = "${protocol}://${host}/${path}";
+    }
+    $status = $args{status} if ($args{status});
+  }
+
+  $self->headers_out->set('Status' => $status);
+  $self->headers_out->set('Location' => $redirect_url);
+
+  return;
+}
+
+
 sub send_output {
     my $r = shift;
 
@@ -101,12 +133,15 @@ CGI::Maypole - CGI-based front-end to Maypole
 Now to access the beer database, type this URL into your browser:
 http://your.site/cgi-bin/beer.cgi/frontpage
 
+NOTE: this Maypole frontend requires additional modules that won't be installed or included with Maypole. Please see below.
+
 =head1 DESCRIPTION
 
 This is a CGI platform driver for Maypole. Your application can inherit from
 CGI::Maypole directly, but it is recommended that you use
 L<Maypole::Application>.
 
+This module requires CGI::Simple which you will have to install yourself via CPAN or manually.
 
 =head1 METHODS
 
@@ -137,6 +172,10 @@ functionality. See L<Maypole> for these:
 
 =back
 
+=head1 DEPENDANCIES
+
+CGI::Simple
+
 =head1 AUTHORS
 
 Dave Ranney C<dave@sialia.com>