Added doc stubs for Aaron's new methods.

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

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index 6bbe9b61cc4e0330773d1dea16b841ddedf5043f..827d5d21df3703d8579845364393d9af2e3e4ad1 100644 (file)
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -1,29 +1,44 @@
 package Apache::MVC;
 
-our $VERSION = '2.06';
+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