merged in TEEJAY Changes with current head

[maypole.git] / lib / Apache / MVC.pm

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index c9d6a32c762e4c11dc19babf369df6904061a2dd..465311293f122422537a498dccff44b7790930e5 100644 (file)
--- 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(