merged in TEEJAY Changes with current head

[maypole.git] / lib / CGI / Maypole.pm

diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm
index b7e5ca26c7966570f32afb669052d4dd08ed51ad..bb6de3f79a1b892cadf91a58159884aaf8ea4107 100644 (file)
--- a/lib/CGI/Maypole.pm
+++ b/lib/CGI/Maypole.pm
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 use CGI::Simple;
 use Maypole::Headers;
+use Maypole::Constants;
 
 our $VERSION = '2.10';
 
@@ -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;