Permalink
Browse files

add CGI::Redirect to examples/

  • Loading branch information...
1 parent 0b0fdda commit 8ac7377620b89b81407fc24d3ca02d8c02ae1d0c Ryo Anazawa committed Jun 15, 2013
Showing with 105 additions and 0 deletions.
  1. +2 −0 Changes
  2. +32 −0 examples/lib/CGI/Redirect.pm
  3. +35 −0 examples/lib/CGI/Redirect/Adapter.pm
  4. +25 −0 examples/t/cgi_redirect.t
  5. +11 −0 examples/t/cgi_redirect_adapter.t
View
@@ -1,5 +1,7 @@
Revision history for Perl extension CGI::Header.
+ - Add Blosxom::Header, MyApp::Header and CGI::Redirect to examples/
+
0.60 (1.00-RC13) Jun 16th, 2013
- Add examples/
@@ -0,0 +1,32 @@
+package CGI::Redirect;
+use strict;
+use warnings;
+use parent 'CGI::Header';
+
+sub location {
+ my $self = shift;
+ return $self->header->{location} unless @_;
+ $self->header->{location} = shift;
+ $self;
+}
+
+sub _build_alias {
+ +{
+ 'content-type' => 'type',
+ 'cookie' => 'cookies',
+ 'uri' => 'location',
+ 'url' => 'location',
+ };
+}
+
+sub finalize {
+ my $self = shift;
+ my $query = $self->query;
+ my $args = $self->header;
+
+ $query->print( $query->redirect($args) );
+
+ return;
+}
+
+1;
@@ -0,0 +1,35 @@
+package CGI::Redirect::Adapter;
+use strict;
+use warnings;
+use parent 'CGI::Header::Adapter';
+
+sub location {
+ my $self = shift;
+ return $self->header->{location} unless @_;
+ $self->header->{location} = shift;
+ $self;
+}
+
+sub _build_alias {
+ +{
+ 'content-type' => 'type',
+ 'cookie' => 'cookies',
+ 'uri' => 'location',
+ 'url' => 'location',
+ };
+}
+
+sub as_arrayref {
+ my $self = shift;
+ my $clone = $self->clone;
+ $clone->location( $self->query->self_url ) if !$clone->location;
+ $clone->status( '302 Found' ) if !defined $clone->status;
+ $clone->type( q{} ) if !$clone->_has_type;
+ $clone->SUPER::as_arrayref;
+}
+
+sub _has_type {
+ exists $_[0]->header->{type};
+}
+
+1;
View
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+use Test::More tests => 7;
+use Test::Output;
+
+BEGIN {
+ use_ok 'CGI::Redirect';
+}
+
+my $redirect = CGI::Redirect->new;
+
+my %data = (
+ '-Content_Type' => 'type',
+ '-Cookie' => 'cookies',
+ '-URI' => 'location',
+ '-URL' => 'location',
+);
+
+while ( my ($input, $expected) = each %data ) {
+ is $redirect->_normalize($input), $expected;
+}
+
+is $redirect->location('http://somewhere.else/in/movie/land'), $redirect;
+
+stdout_like { $redirect->finalize } qr{Status: 302 Found};
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+BEGIN {
+ use_ok 'CGI::Redirect::Adapter';
+}
+
+my $redirect = CGI::Redirect::Adapter->new;
+
+is $redirect->as_string, $redirect->query->redirect;

0 comments on commit 8ac7377

Please sign in to comment.