Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

We’re showing branches in this repository, but you can also compare across forks.

base fork: anazawa/p5-Blosxom-Header
base: fec7cc5ff0
...
head fork: anazawa/p5-Blosxom-Header
compare: 46c50ef4c6
  • 2 commits
  • 4 files changed
  • 0 commit comments
  • 1 contributor
Commits on Apr 16, 2012
Ryo Anazawa push method pretend CORE::push a9e62ff
Ryo Anazawa Checking in changes prior to tagging of version 0.03001.
Changelog diff is:

diff --git a/Changes b/Changes
index 5aee1c5..57d9603 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,20 @@
 Revision history for Perl extension Blosxom::Header.

+0.03001  Apr 17th, 2012
+  - 'push' method carps like CORE::push.
+    And also receives multiple values:
+        $header->push( 'Set-Cookie' => @cookies )
+  - 'set' method receives the list of named parameters:
+        $header->set(
+            Foo => 'bar',
+            Bar => 'baz',
+        )
+    Separated internal '_set' method from 'set'
+  - 'delete' method receives the list of field names:
+        $header->delete( 'Foo', 'Bar' )
+
 0.03000  Apr 16th, 2012
-  - Suppose plugin developers always 'use Blosxom::Header',
+  - Suppose plugin developers always 'use Blosxom::Header'
     whenever they modify HTTP headers
   - Renamed &_norm to &_normalize_field_name
46c50ef
Showing with 83 additions and 50 deletions.
  1. +14 −1 Changes
  2. +6 −2 Makefile.PL
  3. +54 −41 lib/Blosxom/Header.pm
  4. +9 −6 t/15_push.t
15 Changes
View
@@ -1,7 +1,20 @@
Revision history for Perl extension Blosxom::Header.
+0.03001 Apr 17th, 2012
+ - 'push' method carps like CORE::push.
+ And also receives multiple values:
+ $header->push( 'Set-Cookie' => @cookies )
+ - 'set' method receives the list of named parameters:
+ $header->set(
+ Foo => 'bar',
+ Bar => 'baz',
+ )
+ Separated internal '_set' method from 'set'
+ - 'delete' method receives the list of field names:
+ $header->delete( 'Foo', 'Bar' )
+
0.03000 Apr 16th, 2012
- - Suppose plugin developers always 'use Blosxom::Header',
+ - Suppose plugin developers always 'use Blosxom::Header'
whenever they modify HTTP headers
- Renamed &_norm to &_normalize_field_name
8 Makefile.PL
View
@@ -1,11 +1,15 @@
use inc::Module::Install;
+
all_from 'lib/Blosxom/Header.pm';
+
repository 'https://github.com/anazawa/p5-Blosxom-Header';
requires 'Carp';
-test_requires 'Test::More';
+
test_requires 'Test::Base';
-test_requires 'YAML';
+test_requires 'Test::More';
test_requires 'Test::Pod';
+test_requires 'Test::Warn';
+test_requires 'YAML';
WriteAll;
95 lib/Blosxom/Header.pm
View
@@ -4,99 +4,112 @@ use strict;
use warnings;
use Carp;
-our $VERSION = '0.03000';
+our $VERSION = '0.03001';
sub new {
my $class = shift;
my $header = shift || $blosxom::header;
- croak 'Not a HASH reference' unless ref $header eq 'HASH';
+ croak( 'Not a HASH reference' ) unless ref $header eq 'HASH';
bless { header => $header }, $class;
}
sub get {
- my $self = shift;
+ my $header = shift->{header};
my $field = _normalize_field_name( shift );
- return unless $self->exists( $field );
- my $value = $self->{header}->{ $field };
+ my $value = $header->{ $field };
return $value unless ref $value eq 'ARRAY';
return @{ $value } if wantarray;
$value->[0];
}
sub delete {
- my ( $self, @fields ) = @_;
- @fields = map { _normalize_field_name( $_ ) } @fields;
- delete @{ $self->{header} }{ @fields };
+ my $header = shift->{header};
+ my @fields = map { _normalize_field_name( $_ ) } @_;
+ delete @{ $header }{ @fields };
+}
+
+sub exists {
+ my $header = shift->{header};
+ my $field = _normalize_field_name( shift );
+ exists $header->{ $field };
}
sub set {
my ( $self, @fields ) = @_;
- # why not 'while -> each %field'?
- while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
- $field = _normalize_field_name( $field );
-
- croak "The $field header can't be an ARRAY reference. See 'perldoc CGI'"
- if ref $value eq 'ARRAY' and $field ne '-cookie' and $field ne '-p3p';
-
- $self->{header}->{ $field } = $value;
+ if ( @fields == 2 ) {
+ $self->_set( @fields );
+ }
+ else {
+ while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
+ $self->_set( $field => $value );
+ }
}
return;
}
-sub exists {
+sub _set {
my $header = shift->{header};
my $field = _normalize_field_name( shift );
+ my $value = shift;
- exists $header->{ $field };
+ croak( "The $field header can't be an ARRAY reference. See 'perldoc CGI'" )
+ if ref $value eq 'ARRAY' and $field ne '-cookie' and $field ne '-p3p';
+
+ $header->{ $field } = $value;
+
+ return;
}
sub push {
- my ( $self, @fields ) = @_;
+ my $self = shift;
+ my $field = _normalize_field_name( shift );
+ my @values = @_;
- while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
- $field = _normalize_field_name( $field );
+ unless ( @values ) {
+ carp( 'Useless use of push with no values' );
+ return;
+ }
- if ( my $old_value = $self->{header}->{ $field } ) {
- if ( ref $old_value eq 'ARRAY' ) {
- push @{ $old_value }, $value;
- }
- else {
- $self->set( $field => [ $old_value, $value ] );
- }
- }
- else {
- $self->set( $field => $value );
+ if ( my $old_value = $self->{header}->{ $field } ) {
+ if ( ref $old_value eq 'ARRAY' ) {
+ push @{ $old_value }, @values;
+ return;
}
+ unshift @values, $old_value;
}
+ $self->_set( $field => @values > 1 ? \@values : shift @values );
+
return;
}
{
- # suppose read-only
- my %ALIAS_OF = (
- '-content-type' => '-type',
- '-set-cookie' => '-cookie',
- );
+ my %norm_of; # cache
- # how should I call this process?
sub _normalize_field_name {
my $field = shift;
return unless $field;
+ # use cache if exists
+ return $norm_of{ $field } if exists $norm_of{ $field };
+
# lowercase $field
- $field = lc $field; # Content_Type -> content_type
+ my $norm = lc $field;
# add initial dash if not exists
- $field = "-$field" unless $field =~ /^-/; # -> -content_type
+ $norm = "-$norm" unless $norm =~ /^-/;
# use dashes instead of underscores
- $field =~ tr{_}{-}; # -> -content-type
+ $norm =~ tr{_}{-};
+
+ # use alias if exists
+ $norm = '-type' if $norm eq '-content-type';
+ $norm = '-cookie' if $norm eq '-set-cookie';
- $ALIAS_OF{ $field } || $field;
+ $norm_of{ $field } = $norm;
}
}
15 t/15_push.t
View
@@ -1,5 +1,6 @@
use strict;
use Test::More;
+use Test::Warn;
use Blosxom::Header;
{
@@ -10,12 +11,9 @@ use Blosxom::Header;
{
my $header = Blosxom::Header->new({});
- $header->push(
- -foo => 'bar',
- -bar => 'baz',
- );
- my $expected = { -foo => 'bar', -bar => 'baz' };
- is_deeply $header->{header}, $expected, 'push multiple elements';
+ $header->push( -cookie => qw/foo bar/ );
+ my $expected = { -cookie => [ 'foo', 'bar' ] };
+ is_deeply $header->{header}, $expected, 'push multiple values';
}
{
@@ -40,4 +38,9 @@ use Blosxom::Header;
is $header->{header}->{-cookie}, \@cookies, 'push';
}
+{
+ my $header = Blosxom::Header->new({});
+ warning_is { $header->push( 'Foo' ) } 'Useless use of push with no values';
+}
+
done_testing;

No commit comments for this range

Something went wrong with that request. Please try again.