Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

インスタンス変数のデータ構造を変えた

  • Loading branch information...
commit 63c5e6669df60cd1d8c06d44d0a88615f6c55142 1 parent 227837f
Ryo Anazawa authored
View
4 Makefile.PL
@@ -4,8 +4,8 @@ all_from 'lib/Blosxom/Header.pm';
repository 'https://github.com/anazawa/p5-Blosxom-Header';
-requires Carp => '1.10';
-requires constant => '1.17';
+requires Carp => '1.10';
+requires 'Class::Singleton';
test_requires 'Test::Base';
test_requires 'Test::More' => '0.98';
View
142 lib/Blosxom/Header.pm
@@ -2,66 +2,79 @@ package Blosxom::Header;
use 5.008_009;
use strict;
use warnings;
+use parent 'Class::Singleton';
use Carp qw/carp croak/;
-use List::MoreUtils qw/any/;
-
-# parameters recognized by CGI::header()
-use constant ATTRIBUTES
- => qw/attachment charset cookie expires nph p3p status target type/;
our $VERSION = '0.03004';
-sub TIEHASH {
+sub _new_instance {
my $class = shift;
- my $header = shift || $blosxom::header;
- croak( 'Not a HASH reference' ) unless ref $header eq 'HASH';
- bless { header => $header, is => 'rw' }, $class;
+
+ my %header;
+ while ( my ( $field, $value ) = each %{ $blosxom::header } ) {
+ my $norm = _normalize_field_name( $field );
+ $header{$norm} = {
+ key => $field,
+ value => $value,
+ };
+ }
+
+ bless \%header, $class;
}
+sub TIEHASH { shift->instance }
+
sub FETCH {
my $self = shift;
- my $field = _normalize_field_name( shift );
- $self->{header}->{$field};
+ my $norm = _normalize_field_name( shift );
+ $self->{$norm}->{value} if exists $self->{$norm};
}
sub STORE {
- my $self = shift;
- my $field = _normalize_field_name( shift );
- my $value = shift;
+ my ( $self, $field, $value ) = @_;
+ my $norm = _normalize_field_name( $field );
- $self->{header}->{$field} = $value;
+ $self->{$norm} = {
+ key => $field,
+ value => $value,
+ };
+
+ $blosxom::header->{$norm} = $value;
return;
}
sub EXISTS {
my $self = shift;
- my $field = _normalize_field_name( shift );
- exists $self->{header}->{$field};
+ my $norm = _normalize_field_name( shift );
+ exists $self->{$norm};
}
sub DELETE {
my $self = shift;
- my $field = _normalize_field_name( shift );
- delete $self->{header}->{$field};
+ my $norm = _normalize_field_name( shift );
+ delete $self->{$norm};
+ delete $blosxom::header->{$norm};
}
sub CLEAR {
my $self = shift;
- %{ $self->{header} } = ();
+ %{ $self } = %{ $blosxom::header } = ();
}
sub FIRSTKEY {
my $self = shift;
- keys %{ $self->{header} };
- my $first_key = each %{ $self->{header} };
- _denormalize_field_name( $first_key ) if $first_key;
+ keys %{ $self };
+ my $first_key = each %{ $self };
+ return unless defined $first_key;
+ $self->{$first_key}->{key};
}
sub NEXTKEY {
my $self = shift;
- my $next_key = each %{ $self->{header} };
- _denormalize_field_name( $next_key ) if $next_key;
+ my $next_key = each %{ $self };
+ return unless defined $next_key;
+ $self->{$next_key}->{key};
}
{
@@ -85,85 +98,6 @@ sub NEXTKEY {
}
}
-sub _denormalize_field_name {
- my $field = shift;
- $field =~ s/^-//;
- return $field if any { $_ eq $field } ATTRIBUTES;
- ucfirst $field;
-}
-
-sub new { shift->TIEHASH( @_ ) }
-sub exists { shift->EXISTS( @_ ) }
-sub delete { shift->DELETE( @_ ) }
-sub clear { shift->CLEAR }
-
-sub get {
- my $self = shift;
- my $value = $self->FETCH( shift );
- return $value unless ref $value eq 'ARRAY';
- return @{ $value } if wantarray;
- return $value->[0] if defined wantarray;
-}
-
-sub set {
- my ( $self, @fields ) = @_;
-
- if ( @fields == 2 ) {
- $self->STORE( @fields );
- }
- elsif ( @fields % 2 == 0 ) {
- while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
- $self->STORE( $field => $value );
- }
- }
- else {
- croak( 'Odd number of elements are passed to set()' );
- }
-
- return;
-}
-
-sub push_cookie { shift->_push( -cookie => @_ ) }
-sub push_p3p { shift->_push( -p3p => @_ ) }
-
-sub _push {
- my $self = shift;
- my $field = _normalize_field_name( shift );
- my @values = @_;
-
- unless ( @values ) {
- carp( 'Useless use of _push() with no values' );
- return;
- }
-
- if ( my $old_value = $self->{header}->{$field} ) {
- return push @{ $old_value }, @values if ref $old_value eq 'ARRAY';
- unshift @values, $old_value;
- }
-
- $self->STORE( $field => @values > 1 ? \@values : $values[0] );
-
- # returns the number of elements in @values like CORE::push
- scalar @values if defined wantarray;
-}
-
-# Will be removed in 0.04
-sub push { shift->_push( @_ ) }
-
-# make accessors
-for my $method ( ATTRIBUTES ) {
- my $slot = __PACKAGE__ . "::$method";
- my $field = "-$method";
-
- no strict 'refs';
-
- *$slot = sub {
- my $self = shift;
- $self->STORE( $field => shift ) if @_;
- $self->FETCH( $field );
- };
-}
-
1;
__END__
View
45 t/02_denormalize_field_name.t
@@ -1,45 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::Base;
-plan tests => 1 * blocks;
-
-run {
- my $block = shift;
- my $got = Blosxom::Header::_denormalize_field_name( $block->input );
- is $got, $block->expected;
-};
-
-__DATA__
-===
---- input: -foo
---- expected: Foo
-===
---- input: -foo-bar
---- expected: Foo-bar
-===
---- input: -attachment
---- expected: attachment
-===
---- input: -charset
---- expected: charset
-===
---- input: -cookie
---- expected: cookie
-===
---- input: -expires
---- expected: expires
-===
---- input: -nph
---- expected: nph
-===
---- input: -p3p
---- expected: p3p
-===
---- input: -status
---- expected: status
-===
---- input: -target
---- expected: target
-===
---- input: -type
---- expected: type
View
75 t/10_basic.t
@@ -0,0 +1,75 @@
+use strict;
+use Blosxom::Header;
+use Test::More;
+
+{
+ package blosxom;
+ our $header = {};
+}
+
+{
+ %{ $blosxom::header } = ( -foo => 'bar' );
+ tie my %header, 'Blosxom::Header';
+
+ ok exists $header{-foo}, 'EXISTS returns true';
+ ok !exists $header{-bar}, 'EXISTS returns false';
+ ok exists $header{Foo}, 'EXISTS, not case-sensitive';
+
+ is $header{-foo}, 'bar', 'FETCH';
+ #is $header{-bar}, undef, 'FETCH undef';
+ is $header{-bar}, q{}, 'FETCH undef';
+ is $header{Foo}, 'bar', 'FETCH, not case-sensitive';
+
+ %header = ();
+ is_deeply $blosxom::header, {}, 'CLEAR';
+}
+
+{
+ tie my %header, 'Blosxom::Header';
+ %header = (
+ Last_Modified => 'Thu, 03 Feb 1994 00:00:00 GMT',
+ status => '304 Not Modified',
+ type => 'text/html',
+ );
+ #use Data::Dumper;
+ #die Dumper( \%header );
+
+
+ my @got = sort keys %header;
+ my @expected = qw/Last_Modified status type/;
+ is_deeply \@got, \@expected, 'keys';
+}
+
+{
+ tie my %header, 'Blosxom::Header';
+ %header = ();
+
+ $header{-foo} = 'bar';
+ is $header{-foo}, 'bar', 'STORE';
+
+ $header{Bar} = 'baz';
+ is $header{-bar}, 'baz', 'STORE, not case-sensitive';
+
+ my %expected = (
+ -foo => 'bar',
+ -bar => 'baz'
+ );
+
+ is_deeply $blosxom::header, \%expected;
+}
+
+{
+ tie my %header, 'Blosxom::Header';
+ %header = (
+ -foo => 'bar',
+ -bar => 'baz',
+ );
+
+ is delete $header{-foo}, 'bar', 'DELETE';
+ is delete $header{-foo}, undef, 'DELETE nothing';
+ is delete $header{Bar}, 'baz', 'DELETE, not case-sensitive';
+
+ is_deeply $blosxom::header, {};
+}
+
+done_testing;
View
38 t/10_new.t
@@ -1,38 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::More;
-
-{
- package blosxom;
- our $header;
-}
-
-{
- undef $blosxom::header;
- eval { Blosxom::Header->new };
- like $@, qr{^Not a HASH reference};
-}
-
-{
- undef $blosxom::header;
- my $header_ref = {};
- my $header = Blosxom::Header->new( $header_ref );
- isa_ok $header, 'Blosxom::Header';
- can_ok $header, qw( new get set push_cookie push_p3p exists delete );
- is $header->{header}, $header_ref;
-}
-
-{
- $blosxom::header = {};
- my $header = Blosxom::Header->new;
- is $header->{header}, $blosxom::header;
-}
-
-{
- $blosxom::header = {};
- my $header_ref = {};
- my $header = Blosxom::Header->new( $header_ref );
- is $header->{header}, $header_ref;
-}
-
-done_testing;
View
11 t/11_clear.t
@@ -1,11 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::More;
-
-{
- my $header = Blosxom::Header->new({});
- $header->clear;
- is_deeply $header->{header}, {}, 'clear';
-}
-
-done_testing;
View
12 t/12_exists.t
@@ -1,12 +0,0 @@
-use strict;
-use Test::More;
-use Blosxom::Header;
-
-{
- my $header = Blosxom::Header->new({ '-foo' => 'bar' });
- ok $header->exists( '-foo' ), 'exists returns true';
- ok !$header->exists( '-bar' ), 'exists returns false';
- ok $header->exists( 'Foo' ), 'exists, not case-sensitive';
-}
-
-done_testing;
View
39 t/13_delete.t
@@ -1,39 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::More;
-
-{
- my $header = Blosxom::Header->new({
- -foo => 'bar',
- -bar => 'baz',
- });
-
- is_deeply [ $header->delete( '-foo' ) ], [ 'bar' ];
- is_deeply $header->{header}, { -bar => 'baz' }, 'delete';
-
- is $header->delete( '-foo' ), undef;
- is_deeply $header->{header}, { -bar => 'baz' }, 'delete nothing';
-}
-
-#{
-# my $header = Blosxom::Header->new({
-# -foo => 'bar',
-# -bar => 'baz',
-# -baz => 'qux',
-# });
-
-# is_deeply [ $header->delete( '-foo', '-bar' ) ], [ qw/bar baz/ ];
-# is_deeply $header->{header}, { -baz => 'qux' }, 'delete multiple elements';
-#}
-
-{
- my $header = Blosxom::Header->new({
- -foo => 'bar',
- -bar => 'baz',
- });
-
- $header->delete( 'Foo' );
- is_deeply $header->{header}, { -bar => 'baz' }, 'delete, not case-sensitive';
-}
-
-done_testing;
View
21 t/14_get.t
@@ -1,21 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::More;
-
-{
- my $header = Blosxom::Header->new({ -foo => 'bar' });
- is $header->get( '-foo' ), 'bar';
- is $header->get( 'Foo' ), 'bar', 'get, not case-sensitive';
- is $header->get( '-bar' ), undef, 'get undef';
-}
-
-{
- my @cookies = ( 'foo', 'bar' );
- my $header = Blosxom::Header->new({ -cookie => \@cookies });
- is $header->get( 'Set-Cookie' ), 'foo', 'get cookie in scalar context';
-
- my @got = $header->get( 'Set-Cookie' );
- is_deeply \@got, [ 'foo', 'bar' ], 'get cookie in list context';
-}
-
-done_testing;
View
61 t/15_set.t
@@ -1,61 +0,0 @@
-use strict;
-use Test::More;
-use Test::Warn;
-use Blosxom::Header;
-
-{
- my $header = Blosxom::Header->new({ -foo => 'bar' });
- $header->set( -bar => 'baz' );
- is_deeply $header->{header}, { -foo => 'bar', -bar => 'baz' }, 'set';
-}
-
-{
- my $header = Blosxom::Header->new({ -foo => 'bar' });
- $header->set( -bar => q{} );
- my $expected = { -foo => 'bar', -bar => q{} };
- is_deeply $header->{header}, $expected, 'set empty string';
-}
-
-{
- my $header = Blosxom::Header->new({ -foo => 'bar' });
- $header->set( -foo => 'baz' );
- is_deeply $header->{header}, { -foo => 'baz' }, 'set overwrite';
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->set(
- -foo => 'bar',
- -bar => 'baz',
- );
- my $expected = { -foo => 'bar', -bar => 'baz' };
- is_deeply $header->{header}, $expected, 'set multiple elements';
-}
-
-{
- my $header = Blosxom::Header->new({});
- eval { $header->set( '-foo' ) };
- like $@, qr{^Odd number of elements are passed to set()};
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->set( Foo => 'bar' );
- is_deeply $header->{header}, { -foo => 'bar' }, 'set, not case-sensitive';
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->set( 'Set-Cookie' => [ 'foo', 'bar' ] );
- my $expected = { -cookie => [ 'foo', 'bar' ] };
- is_deeply $header->{header}, $expected, 'set cookie arrayref';
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->set( P3P => [ 'foo', 'bar' ] );
- my $expected = { -p3p => [ 'foo', 'bar' ] };
- is_deeply $header->{header}, $expected, 'set p3p arrayref';
-}
-
-done_testing;
View
46 t/16_push.t
@@ -1,46 +0,0 @@
-use strict;
-use Test::More;
-use Test::Warn;
-use Blosxom::Header;
-
-{
- my $header = Blosxom::Header->new({});
- $header->_push( -foo => 'bar' );
- is_deeply $header->{header}, { -foo => 'bar' }, '_push()';
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->_push( -cookie => qw/foo bar/ );
- my $expected = { -cookie => [ 'foo', 'bar' ] };
- is_deeply $header->{header}, $expected, '_push() multiple values';
-}
-
-{
- my $header = Blosxom::Header->new({});
- $header->_push( Foo => 'bar' );
- is_deeply $header->{header}, { -foo => 'bar' }, '_push(), not case-sensitive';
-}
-
-{
- my $header = Blosxom::Header->new({ -cookie => 'foo' });
- $header->_push( Set_Cookie => 'bar' );
- my $expected = { -cookie => [ 'foo', 'bar' ] };
- is_deeply $header->{header}, $expected, '_push() cookie';
-}
-
-{
- my @cookies = ( 'foo' );
- my $header = Blosxom::Header->new({ -cookie => \@cookies });
- $header->_push( Set_Cookie => 'bar' );
- my $expected = { -cookie => [ 'foo', 'bar' ] };
- is_deeply $header->{header}, $expected, '_push()';
- 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;
View
13 t/17_accessors.t
@@ -1,13 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Test::More;
-
-{
- my $header = Blosxom::Header->new({ -expires => 'now' });
- can_ok $header, qw/attachment charset cookie expires nph status target p3p type/;
- is $header->expires, 'now';
- is $header->expires( '+1d' ), '+1d';
- is_deeply $header->{header}, { -expires => '+1d' };
-}
-
-done_testing;
View
39 t/20_tie.t
@@ -1,39 +0,0 @@
-use strict;
-use Blosxom::Header;
-use Data::Dumper;
-use Test::More;
-
-{
- package blosxom;
- our $header = { -type => 'text/html' };
-}
-
-{
- tie my %header, 'Blosxom::Header';
- is $header{Content_Type}, 'text/html', 'get';
- ok exists $header{Content_Type}, 'exists';
- ok %header;
-
- $header{Status} = '304 Not Modified';
- is $blosxom::header->{-status}, '304 Not Modified', 'set';
-
- is_deeply [ @header{'Content_Type', 'Status'} ],
- [ 'text/html', '304 Not Modified' ], 'slice';
-
- $header{Last_Modified} = 'foo';
- is_deeply [ sort keys %header ], [ 'Last-modified', 'status', 'type' ], 'keys';
-
- is delete $header{Status}, '304 Not Modified', 'delete';
- my %expected = ( -type => 'text/html', '-last-modified' => 'foo' );
- is_deeply $blosxom::header, \%expected;
-
- my @cookies = ( 'foo', 'bar' );
- $header{Set_Cookie} = \@cookies;
- is $header{Set_Cookie}, \@cookies, 'should return arrayref';
-
- %header = ();
- is_deeply $blosxom::header, {}, 'clear';
- ok !%header;
-}
-
-done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.