Permalink
Browse files

handler is readonly

  • Loading branch information...
Ryo Anazawa
Ryo Anazawa committed Jun 8, 2013
1 parent bd95889 commit c54b1fb2636d6507b9ac945700b2dd535a0d00c9
Showing with 31 additions and 48 deletions.
  1. +25 −38 lib/CGI/Header.pm
  2. +5 −7 t/10_basic.t
  3. +1 −3 t/30_adapter.t
View
@@ -7,9 +7,18 @@ use Carp qw/croak/;
our $VERSION = '0.58';
sub new {
- my $class = shift;
- my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
- ( bless { %args }, $class )->rehash;
+ my $class = shift;
+ my $self = bless { @_ }, $class;
+ my $header = $self->header;
+
+ for my $key ( keys %$header ) {
+ my $prop = $self->_normalize( $key );
+ next if $key eq $prop; # $key is normalized
+ croak "Property '$prop' already exists" if exists $header->{$prop};
+ $header->{$prop} = delete $header->{$key}; # rename $key to $prop
+ }
+
+ $self;
}
sub header {
@@ -27,11 +36,7 @@ sub _build_query {
}
sub handler {
- my $self = shift;
- return $self->{handler} ||= 'header' unless @_;
- $self->{handler} = shift;
- $self->_clear_alias;
- $self->rehash;
+ $_[0]->{handler} ||= 'header';
}
sub _alias {
@@ -43,8 +48,8 @@ sub _build_alias {
my $self = shift;
my %alias = (
- 'cookie' => 'cookies',
'content-type' => 'type',
+ 'cookie' => 'cookies',
);
if ( $self->handler eq 'redirect' ) {
@@ -55,10 +60,6 @@ sub _build_alias {
\%alias;
}
-sub _clear_alias {
- delete $_[0]->{_alias};
-}
-
sub _normalize {
my ( $self, $key ) = @_;
my $alias = $self->_alias;
@@ -69,20 +70,6 @@ sub _normalize {
$prop;
}
-sub rehash {
- my $self = shift;
- my $header = $self->header;
-
- for my $key ( keys %$header ) {
- my $prop = $self->_normalize( $key );
- next if $key eq $prop; # $key is normalized
- croak "Property '$prop' already exists" if exists $header->{$prop};
- $header->{$prop} = delete $header->{$key}; # rename $key to $prop
- }
-
- $self;
-}
-
sub get {
my ( $self, $key ) = @_;
my $prop = $self->_normalize( $key );
@@ -138,21 +125,13 @@ BEGIN {
}
}
-sub redirect {
- my ( $self, $url, $status ) = @_;
- $self->handler('redirect');
- $self->location( $url ) if $url;
- $self->status( $status ) if $status;
- $self;
-}
-
sub finalize {
my $self = shift;
my $query = $self->query;
- my $header = $self->header;
+ my $args = $self->header;
my $method = $self->handler;
- $query->print( $query->$method($header) );
+ $query->print( $query->$method($args) );
return;
}
@@ -276,7 +255,7 @@ by the module.
Returns the header hash reference associated with this CGI::Header object.
This attribute defaults to a reference to an empty hash.
-=item $self = $header->handler('redirect')
+=item $method_name = $header->handler
Returns a method name in C<query> object, which is used to C<finalize> header
props. This attribute defaults to C<header>. The argument can be
@@ -427,6 +406,14 @@ expiration interval. The following forms are all valid for this field:
# at the indicated time & date
$header->expires( 'Thu, 25 Apr 1999 00:40:33 GMT' );
+=item $self = $header->location( $url )
+
+=item $url = $header->location
+
+Get or set the Location header.
+
+ $header->location('http://somewhere.else/in/movie/land');
+
=item $self = $header->nph( $bool )
=item $bool = $header->nph
View
@@ -1,8 +1,7 @@
use strict;
use warnings;
use CGI::Header;
-use CGI::Header::Normalizer;
-use Test::More tests => 9;
+use Test::More tests => 8;
use Test::Exception;
use Test::Output;
@@ -39,11 +38,6 @@ subtest 'CGI::Header#new' => sub {
} qr{^Property 'type' already exists};
};
-subtest 'CGI::Header#handler' => sub {
- my $header = CGI::Header->new;
- is $header->handler('redirect'), $header;
-};
-
subtest 'header fields' => sub {
my $header = CGI::Header->new;
is $header->set( 'Foo' => 'bar' ), 'bar';
@@ -67,6 +61,9 @@ subtest 'header props.' => sub {
is $header->expires('+3d'), $header;
is $header->expires, '+3d';
+ is $header->location('http://somewhere.else/in/movie/land'), $header;
+ is $header->location, 'http://somewhere.else/in/movie/land';
+
is $header->nph(1), $header;
ok $header->nph;
@@ -87,6 +84,7 @@ subtest 'header props.' => sub {
charset => 'utf-8',
cookies => 'ID=123456; path=/',
expires => '+3d',
+ location => 'http://somewhere.else/in/movie/land',
nph => '1',
p3p => 'CAO DSP LAW CURa',
status => '304 Not Modified',
View
@@ -4,7 +4,7 @@ use Test::MockTime qw/set_fixed_time/;
use CGI;
use CGI::Cookie;
use CGI::Header::Adapter;
-use Test::More tests => 4;
+use Test::More tests => 3;
use Test::Exception;
set_fixed_time( 1341637509 );
@@ -42,5 +42,3 @@ is_deeply $header->as_arrayref, [
is $header->as_string, $header->query->header( @args );
throws_ok { $header->finalize } qr{^call to abstract method};
-
-is $header->handler('redirect')->as_string, $header->query->redirect( @args );

0 comments on commit c54b1fb

Please sign in to comment.