+=cut
+
+sub parse_location
+{
+ my $r = shift;
+ my $cgi = $r->cgi;
+
+ # Reconstruct the request headers (as far as this is possible)
+ $r->headers_in(Maypole::Headers->new);
+ for my $http_header ($cgi->http) {
+ (my $field_name = $http_header) =~ s/^HTTPS?_//;
+ $r->headers_in->set($field_name => $cgi->http($http_header));
+ }
+
+ $r->preprocess_location();
+
+ my $path = $cgi->url( -absolute => 1, -path_info => 1 );
+ my $loc = $cgi->url( -absolute => 1 );
+ {
+ no warnings 'uninitialized';
+ $path .= '/' if $path eq $loc;
+ if ($loc =~ /\/$/) {
+ $path =~ s/^($loc)?//;
+ } else {
+ $path =~ s/^($loc)?\///;
+ }
+ }
+ $r->path($path);
+
+ $r->parse_path;
+ $r->parse_args;
+}
+
+=item warn
+
+=cut
+
+sub warn {
+ my ($self,@args) = @_;
+ my ($package, $line) = (caller)[0,2];
+ warn "[$package line $line] ", @args ;
+ return;
+}
+
+=item parse_args
+
+=cut
+
+sub parse_args
+{
+ my $r = shift;
+ my (%vars) = $r->cgi->Vars;
+ while ( my ( $key, $value ) = each %vars ) {
+ my @values = split "\0", $value;
+ $vars{$key} = @values <= 1 ? $values[0] : \@values;
+ }
+ $r->params( {%vars} );
+ $r->query( $r->params );
+}
+
+=item redirect_request
+
+=cut
+
+# FIXME: use headers_in to gather host and other information?
+sub redirect_request
+{
+ my $r = shift;
+ my $redirect_url = $_[0];
+ my $status = "302";
+ if ($_[1]) {
+ my %args = @_;
+ if ($args{url}) {
+ $redirect_url = $args{url};
+ } else {
+ my $path = $args{path} || $r->cgi->url(-absolute => 1, -query=>1);
+ my $host = $args{domain};
+ ($host = $r->cgi->url(-base => 1)) =~ s/^https?:\/\///i unless ($host);
+ my $protocol = $args{protocol} || $r->get_protocol;
+ $redirect_url = "${protocol}://${host}/${path}";
+ }
+ $status = $args{status} if ($args{status});
+ }
+
+ $r->headers_out->set('Status' => $status);
+ $r->headers_out->set('Location' => $redirect_url);
+
+ return;
+}
+
+=item get_protocol
+
+=cut
+
+sub get_protocol
+{
+ my $self = shift;
+ my $protocol = ($self->cgi->https) ? 'https' : 'http';
+ return $protocol;
+}
+