Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add CGI::Header::Extended to examples/

  • Loading branch information...
commit ee37da3f9b4a6cb2344f6804fcd400c6e8ea25ac 1 parent e2747d7
Ryo Anazawa authored
View
29 examples/lib/CGI/Header/Extended.pm
@@ -0,0 +1,29 @@
+package CGI::Header::Extended;
+use strict;
+use warnings;
+use parent 'CGI::Header';
+
+sub merge {
+ my ( $self, @args ) = @_;
+ my $header = $self->header;
+
+ if ( @args == 1 ) {
+ my %header = %{ $args[0] };
+ ref( $self )->new( header => \%header ); # rehash %header
+ %$header = ( %$header, %header );
+ }
+ else {
+ while ( my ($key, $value) = splice @args, 0, 2 ) {
+ $header->{ $self->normalize($key) } = $value; # overwrite
+ }
+ }
+
+ $self;
+}
+
+sub replace {
+ my $self = shift;
+ $self->clear->merge(@_);
+}
+
+1;
View
21 examples/t/cgi_header_extended.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+BEGIN {
+ use_ok 'CGI::Header::Extended';
+}
+
+my $header = CGI::Header::Extended->new(
+ header => {
+ foo => 'bar',
+ },
+);
+
+can_ok $header, qw( merge replace );
+
+is $header->merge( bar => 'baz' ), $header;
+is_deeply $header->header, { foo => 'bar', bar => 'baz' };
+
+is $header->replace( baz => 'qux' ), $header;
+is_deeply $header->header, { baz => 'qux' };
View
2  examples/t/cgi_redirect.t
@@ -17,7 +17,7 @@ my %data = (
);
while ( my ($input, $expected) = each %data ) {
- is $redirect->_normalize($input), $expected;
+ is $redirect->normalize($input), $expected;
}
is $redirect->location('http://somewhere.else/in/movie/land'), $redirect;
View
19 lib/CGI/Header.pm
@@ -7,8 +7,9 @@ use Carp qw/croak/;
our $VERSION = '0.61';
sub new {
- my ( $class, @args ) = @_;
- ( bless { @args }, $class )->_rehash;
+ my $class = shift;
+ my %args = @_ == 1 ? %{$_[0]} : @_;
+ ( bless \%args => $class )->_rehash;
}
sub header {
@@ -27,7 +28,7 @@ sub _build_query {
sub _alias {
my $self = shift;
- $self->{_alias} ||= $self->_build_alias;
+ $self->{alias} ||= $self->_build_alias;
}
sub _build_alias {
@@ -37,7 +38,7 @@ sub _build_alias {
};
}
-sub _normalize {
+sub normalize {
my ( $self, $key ) = @_;
my $alias = $self->_alias;
my $prop = lc $key;
@@ -52,7 +53,7 @@ sub _rehash {
my $header = $self->header;
for my $key ( keys %$header ) {
- my $prop = $self->_normalize( $key );
+ 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
@@ -63,25 +64,25 @@ sub _rehash {
sub get {
my ( $self, $key ) = @_;
- my $prop = $self->_normalize( $key );
+ my $prop = $self->normalize( $key );
$self->header->{$prop};
}
sub set {
my ( $self, $key, $value ) = @_;
- my $prop = $self->_normalize( $key );
+ my $prop = $self->normalize( $key );
$self->header->{$prop} = $value;
}
sub exists {
my ( $self, $key ) = @_;
- my $prop = $self->_normalize( $key );
+ my $prop = $self->normalize( $key );
exists $self->header->{$prop};
}
sub delete {
my ( $self, $key ) = @_;
- my $prop = $self->_normalize( $key );
+ my $prop = $self->normalize( $key );
delete $self->header->{$prop};
}
View
2  t/10_basic.t
@@ -16,7 +16,7 @@ subtest 'normalization' => sub {
);
while ( my ($input, $expected) = each %data ) {
- is $header->_normalize($input), $expected;
+ is $header->normalize($input), $expected;
}
};
Please sign in to comment.
Something went wrong with that request. Please try again.