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

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index 45dd897..827d5d2 100644
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -1,29 +1,44 @@
 package Apache::MVC;
 
-our $VERSION = '2.07';
+our $VERSION = '2.10';
 
 use strict;
 use warnings;
 
 use base 'Maypole';
-use mod_perl;
 use Maypole::Headers;
+use Maypole::Constants;
+
+__PACKAGE__->mk_accessors( qw( ar ) );
+
+BEGIN {
+    my $version;
+    eval 'use mod_perl2; $version = $mod_perl2::VERSION; ';
+    if ($@) {
+	use mod_perl;
+	$version = 0;
+	require Apache;
+	require Apache::Request;
+    } else {
+	require Apache2::RequestIO;
+	require Apache2::RequestRec;
+	require Apache2::RequestUtil;
+	require APR::URI;
+	require Apache2::Request;
+    }
 
-use constant APACHE2 => $mod_perl::VERSION >= 1.99;
-
-if (APACHE2) {
-    require Apache2;
-    require Apache::RequestIO;
-    require Apache::RequestRec;
-    require Apache::RequestUtil;
-    require APR::URI;
+    use constant APACHE2 => $version;
 }
-else { require Apache }
-require Apache::Request;
 
 sub get_request {
     my ( $self, $r ) = @_;
-    $self->{ar} = Apache::Request->new($r);
+    $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 {
@@ -53,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(
@@ -150,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