X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FApache%2FMVC.pm;h=465311293f122422537a498dccff44b7790930e5;hb=2e483f35964e1ddd2022df6adc2b6d6a631c0cbd;hp=c9d6a32c762e4c11dc19babf369df6904061a2dd;hpb=808f88dcc99bd004c98cbefb759da90512da58eb;p=maypole.git

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index c9d6a32..4653112 100644
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -7,6 +7,7 @@ use warnings;
 
 use base 'Maypole';
 use Maypole::Headers;
+use Maypole::Constants;
 
 __PACKAGE__->mk_accessors( qw( ar ) );
 
@@ -14,7 +15,6 @@ BEGIN {
     my $version;
     eval 'use mod_perl2; $version = $mod_perl2::VERSION; ';
     if ($@) {
-	warn "no mod_perl 2.x using mod_perl 1.x\n";
 	use mod_perl;
 	$version = 0;
 	require Apache;
@@ -28,7 +28,6 @@ BEGIN {
     }
 
     use constant APACHE2 => $version;
-
 }
 
 sub get_request {
@@ -36,6 +35,12 @@ sub get_request {
     $self->{ar} = (APACHE2) ? Apache2::Request->new($r) : Apache::Request->new($r);
 }
 
+sub get_protocol {
+  my $self = shift;
+  my $protocol = ( $self->{ar}->protocol =~ m/https/i ) ? 'https' : 'http' ;
+  return $protocol;
+}
+
 sub parse_location {
     my $self = shift;
 
@@ -63,6 +68,29 @@ sub parse_args {
     $self->{query}  = { $self->_mod_perl_args( $self->{ar} ) };
 }
 
+# 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->{path};
+      my $host = $args{domain} || $self->{ar}->hostname;
+      my $protocol = $args{protocol} || ( $self->{ar}->protocol =~ m/https/i ) ? '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 OK;
+}
+
 sub send_output {
     my $r = shift;
     $r->{ar}->content_type(