X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FApache%2FMVC.pm;h=827d5d21df3703d8579845364393d9af2e3e4ad1;hb=7c1eccbb6e4b547e61e82ece501c824785c25480;hp=c9d6a32c762e4c11dc19babf369df6904061a2dd;hpb=fdef988c4b6e0c95310edfed99bcb1bb959a6da4;p=maypole.git

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index c9d6a32..827d5d2 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(
@@ -160,12 +188,16 @@ functionality. See L<Maypole> for these:
 
 =item get_template_root
 
+=item get_protocol
+
 =item parse_args
 
 =item parse_location
 
 =item send_output
 
+=item redirect_request
+
 =back
 
 =head1 AUTHOR