Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add CGI::Header::Redirect

  • Loading branch information...
commit aabf6cb0fc1887b61b413a9c9b26899057ff2ba3 1 parent f534d11
Ryo Anazawa authored
Showing with 58 additions and 1 deletion.
  1. +41 −1 lib/CGI/Header/Redirect.pm
  2. +17 −0 t/cgi_redirect.t
View
42 lib/CGI/Header/Redirect.pm
@@ -3,13 +3,53 @@ use strict;
use warnings;
use base 'CGI::Header';
+my %ALIAS = (
+ content_type => 'type', window_target => 'target',
+ cookies => 'cookie', set_cookie => 'cookie',
+ uri => 'location', url => 'location',
+);
+
+sub get_alias {
+ $ALIAS{ $_[1] };
+}
+
sub new {
my ( $class, @args ) = @_;
+ unshift @args, '-location' if ref $args[0] ne 'HASH' and @args == 1;
+ $class->SUPER::new( @args );
+}
+
+for my $method (qw/flatten get exists SCALAR/) {
+ my $super = "SUPER::$method";
+ my $code = sub {
+ my $self = shift;
+ my $header = $self->{header};
+ local $header->{-location} = $self->_self_url if !$header->{-location};
+ local $header->{-status} = '302 Found' if !defined $header->{-status};
+ local $header->{-type} = q{} if !exists $header->{-type};
+ $self->$super( @_ );
+ };
+
+ no strict 'refs';
+ *{ $method } = $code;
+}
+
+sub _self_url {
+ my $self = shift;
+ $self->{self_url} ||= $self->query->self_url;
+}
+
+# NOTE: Cannot delete the Location header
+sub clear {
+ my $self = shift;
+ %{ $self->{header} } = ( -type => q{}, -status => q{} );
+ $self->query->cache( 0 );
+ $self;
}
sub as_string {
my $self = shift;
- $self->query->redirect( $header->{header} );
+ $self->query->redirect( $self->{header} );
}
1;
View
17 t/cgi_redirect.t
@@ -0,0 +1,17 @@
+use strict;
+use Data::Dumper;
+use CGI::Header::Redirect;
+use Test::More tests => 1;
+
+my $header = CGI::Header::Redirect->new;
+
+is $header->get('Status'), '302 Found';
+is $header->get('Location'), $header->query->self_url;
+ok !$header->exists('Content-Type');
+
+is_deeply [ $header->flatten ], [
+ 'Status', '302 Found',
+ 'Location', $header->query->self_url,
+];
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.