Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add Normalizer

  • Loading branch information...
commit d1be6a8321517f56a5de70d8efb674c5ef7030ad 1 parent e69ee58
Ryo Anazawa authored
5 Changes
View
@@ -1,11 +1,6 @@
Revision history for Perl extension CGI::Header.
- Remove CGI::Header#location and redirect
- - CGI::Header#normalize can't be overridden.
- I don't know how to make 'normalize' overridable at this time :(
- This issue is the most essential problem of this module,
- I mean, if you use this module, you have to agree with how this
- module normalizes property names.
0.58 (1.00-RC11) Jun 5th, 2013
12 README
View
@@ -206,12 +206,6 @@ DESCRIPTION
# at the indicated time & date
$header->expires( 'Thu, 25 Apr 1999 00:40:33 GMT' );
- $self = $header->location( $url )
- $url = $header->location
- Get or set the Location header.
-
- $header->location('http://somewhere.else/in/movie/land');
-
$self = $header->nph( $bool )
$bool = $header->nph
Get or set the "nph" property. If set to a true value, will issue
@@ -232,12 +226,6 @@ DESCRIPTION
P3P: policyref="/w3c/p3p.xml", CP="CAO DSP LAW CURa"
- $self = $header->redirect( $url[, $status] );
- Sets redirect URL with an optional HTTP status of the response,
- which defaults to "302 Found". Returns this object itself.
-
- $header->redirect('http://somewhere.else/in/movie/land');
-
$self = $header->status( $status )
$status = $header->status
Get or set the Status header.
79 lib/CGI/Header.pm
View
@@ -2,31 +2,16 @@ package CGI::Header;
use 5.008_009;
use strict;
use warnings;
+use CGI::Header::Normalizer;
use Carp qw/croak/;
our $VERSION = '0.58';
-my %PropertyAlias = (
- 'content-type' => 'type',
- 'cookie' => 'cookies',
- 'set-cookie' => 'cookies',
- 'window-target' => 'target',
-);
-
-# NOTE: can't be overridden
-sub normalize {
- my ( $class, $key ) = @_;
- my $prop = lc $key;
- $prop =~ s/^-//;
- $prop =~ tr/_/-/;
- $prop = $PropertyAlias{$prop} if exists $PropertyAlias{$prop};
- $prop;
-}
-
sub new {
my $class = shift;
- my $self = bless { header => {}, @_ }, $class;
- my $header = $self->{header};
+ my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
+ my $self = bless { %args }, $class;
+ my $header = $self->header;
for my $key ( keys %$header ) {
my $prop = $self->normalize( $key );
@@ -39,7 +24,7 @@ sub new {
}
sub header {
- $_[0]->{header};
+ $_[0]->{header} ||= {};
}
sub query {
@@ -52,33 +37,65 @@ sub _build_query {
CGI::self_or_default();
}
+sub handler {
+ $_[0]->{handler} ||= 'header';
+}
+
+sub normalizer {
+ my $self = shift;
+ $self->{normalizer} ||= $self->_build_normalizer;
+}
+
+sub _build_normalizer {
+ my $self = shift;
+
+ my %alias = (
+ 'content-type' => 'type',
+ 'cookie' => 'cookies',
+ 'set-cookie' => 'cookies',
+ 'window-target' => 'target',
+ );
+
+ if ( $self->handler eq 'redirect' ) {
+ $alias{uri} = 'location';
+ $alias{url} = 'location';
+ }
+
+ CGI::Header::Normalizer->new( alias => \%alias );
+}
+
+sub normalize {
+ my $self = shift;
+ $self->normalizer->normalize(@_);
+}
+
sub get {
my ( $self, $key ) = @_;
my $prop = $self->normalize( $key );
- $self->{header}->{$prop};
+ $self->header->{$prop};
}
sub set {
my ( $self, $key, $value ) = @_;
my $prop = $self->normalize( $key );
- $self->{header}->{$prop} = $value;
+ $self->header->{$prop} = $value;
}
sub exists {
my ( $self, $key ) = @_;
my $prop = $self->normalize( $key );
- exists $self->{header}->{$prop};
+ exists $self->header->{$prop};
}
sub delete {
my ( $self, $key ) = @_;
my $prop = $self->normalize( $key );
- delete $self->{header}->{$prop};
+ delete $self->header->{$prop};
}
sub clear {
my $self = shift;
- undef %{ $self->{header} };
+ undef %{ $self->header };
$self;
}
@@ -96,8 +113,9 @@ BEGIN {
/) {
my $body = sub {
my $self = shift;
- return $self->{header}->{$method} unless @_;
- $self->{header}->{$method} = shift;
+ my $prop = $self->normalize( $method );
+ return $self->header->{$method} unless @_;
+ $self->header->{$method} = shift;
$self;
};
@@ -109,16 +127,17 @@ BEGIN {
sub finalize {
my $self = shift;
my $query = $self->query;
- my $header = $self->{header};
+ my $header = $self->header;
+ my $method = $self->handler;
- $query->print( $query->header($header) );
+ $query->print( $query->$method($header) );
return;
}
sub clone {
my $self = shift;
- my %header = %{ $self->{header} };
+ my %header = %{ $self->header };
ref( $self )->new( %$self, header => \%header );
}
24 lib/CGI/Header/Normalizer.pm
View
@@ -0,0 +1,24 @@
+package CGI::Header::Normalizer;
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ bless { alias => {}, @_ }, $class;
+}
+
+sub alias {
+ $_[0]->{alias};
+}
+
+sub normalize {
+ my ( $self, $key ) = @_;
+ my $alias = $self->{alias};
+ my $prop = lc $key;
+ $prop =~ s/^-//;
+ $prop =~ tr/_/-/;
+ $prop = $alias->{$prop} if exists $alias->{$prop};
+ $prop;
+}
+
+1;
12 t/10_basic.t
View
@@ -1,12 +1,20 @@
use strict;
use warnings;
use CGI::Header;
+use CGI::Header::Normalizer;
use Test::More tests => 8;
use Test::Exception;
use Test::Output;
subtest 'normalization' => sub {
- my $class = 'CGI::Header';
+ my $normalizer = CGI::Header::Normalizer->new(
+ alias => {
+ 'content-type' => 'type',
+ 'cookie' => 'cookies',
+ 'set-cookie' => 'cookies',
+ 'window-target' => 'target',
+ },
+ );
my %data = (
'-Content_Type' => 'type',
@@ -16,7 +24,7 @@ subtest 'normalization' => sub {
);
while ( my ($input, $expected) = each %data ) {
- is $class->normalize($input), $expected;
+ is $normalizer->normalize($input), $expected;
}
};
Please sign in to comment.
Something went wrong with that request. Please try again.