+=cut
+
+sub warn {
+ my ($self,@args) = @_;
+ my ($package, $line) = (caller)[0,2];
+ if ( $args[0] and ref $self ) {
+ $self->{ar}->warn("[$package line $line] ", @args) ;
+ } else {
+ print "warn called by ", caller, " with ", @_, "\n";
+ }
+ return;
+}
+
+=item warn
+
+=cut
+
+sub parse_location {
+ my $self = shift;
+
+ # Reconstruct the request headers
+ $self->headers_in(Maypole::Headers->new);
+ my %headers;
+ if ($MODPERL2) { %headers = %{$self->ar->headers_in};
+ } else { %headers = $self->ar->headers_in; }
+ for (keys %headers) {
+ $self->headers_in->set($_, $headers{$_});
+ }
+ my $path = $self->ar->uri;
+ my $loc = $self->ar->location;
+ {
+ no warnings 'uninitialized';
+ $path .= '/' if $path eq $loc;
+ $path =~ s/^($loc)?\///;
+ }
+ $self->path($path);
+ $self->parse_path;
+ $self->parse_args;
+}
+
+=item parse_args
+
+=cut
+
+sub parse_args {
+ my $self = shift;
+ $self->params( { $self->_mod_perl_args( $self->ar ) } );
+ $self->query( $self->params );
+}
+
+=item redirect_request
+
+=cut
+
+sub redirect_request
+{
+ my $r = shift;
+ my $redirect_url = $_[0];
+ my $status = $MODPERL2 ? eval 'Apache2::Const::REDIRECT;' :
+ eval 'Apache::Constants::REDIRECT;'; # why have to eval this?
+ if ($_[1]) {
+ my %args = @_;
+ if ($args{url}) {
+ $redirect_url = $args{url};
+ } else {
+ my $path = $args{path} || $r->path;
+ my $host = $args{domain} || $r->ar->hostname;
+ my $protocol = $args{protocol} || $r->get_protocol;
+ $redirect_url = "${protocol}://${host}/${path}";
+ }
+ $status = $args{status} if ($args{status});
+ }
+
+ $r->ar->status($status);
+ $r->ar->headers_out->set('Location' => $redirect_url);
+ return OK;
+}
+
+=item get_protocol
+
+=cut
+
+sub get_protocol {
+ my $self = shift;
+ my $protocol = ( $self->ar->protocol =~ m/https/i ) ? 'https' : 'http' ;
+ return $protocol;
+}
+