Permalink
Browse files

simplify TIEHASH()

  • Loading branch information...
1 parent 8be8197 commit 18c29225bff0fe5c7b892f31276061942bf33c2f Ryo Anazawa committed May 6, 2012
Showing with 77 additions and 183 deletions.
  1. +24 −147 lib/Blosxom/Header.pm
  2. +11 −13 lib/Blosxom/Header/Class.pm
  3. +5 −2 t/00_compile.t
  4. +26 −8 t/02_singleton.t
  5. +0 −3 t/10_tiehash.t
  6. +11 −10 t/11_methods.t
View
@@ -2,62 +2,29 @@ package Blosxom::Header;
use 5.008_009;
use strict;
use warnings;
-use Carp qw/carp croak/;
our $VERSION = '0.03005';
-# Parameters recognized by CGI::header()
-#use constant ATTRIBUTES
-# => qw/attachment charset cookie expires nph p3p status target type/;
-
# Naming conventions
# $field : raw field name (e.g. Foo-Bar)
# $norm : normalized field name (e.g. foo_bar)
our $INSTANCE;
-sub instance {
- require Blosxom::Header::Class;
- Blosxom::Header::Class->instance;
- #my $class = shift;
-
- #return $INSTANCE if defined $INSTANCE;
-
- #unless ( ref $blosxom::header eq 'HASH' ) {
- #croak q{$blosxom::header hasn't been initialized yet};
- #}
-
- #my %header;
- #while ( my ( $field, $value ) = each %{ $blosxom::header } ) {
- #$header{ _normalize_field_name( $field ) } = {
- #key => $field,
- #value => $value,
- #};
- #}
-
- #$INSTANCE = bless \%header, $class;
- #my %header;
- #tie %header, $class;
- #bless \%header, $class;
-}
-
-#sub TIEHASH { shift->instance }
-
sub TIEHASH {
my $class = shift;
return $INSTANCE if defined $INSTANCE;
unless ( ref $blosxom::header eq 'HASH' ) {
- croak q{$blosxom::header hasn't been initialized yet};
+ require Carp;
+ Carp::croak q{$blosxom::header hasn't been initialized yet};
}
my %header;
while ( my ( $field, $value ) = each %{ $blosxom::header } ) {
- $header{ _normalize_field_name( $field ) } = {
- key => $field,
- value => $value,
- };
+ my $norm = _normalize_field_name( $field );
+ $header{ $norm } = $field;
}
$INSTANCE = bless \%header, $class;
@@ -66,61 +33,57 @@ sub TIEHASH {
sub FETCH {
my $self = shift;
my $norm = _normalize_field_name( shift );
- return unless exists $self->{ $norm };
- $self->{$norm}->{value};
+ my $field = $self->{ $norm };
+ $blosxom::header->{ $field } if $field;
}
sub STORE {
my ( $self, $field, $value ) = @_;
my $norm = _normalize_field_name( $field );
- if ( my $old = $self->{ $norm } ) {
- $blosxom::header->{ $old->{key} } = $value; # overwrite
- $old->{value} = $value;
+ if ( my $old_key = $self->{ $norm } ) {
+ $blosxom::header->{ $old_key } = $value; # overwrite
}
else {
$blosxom::header->{ $field } = $value;
- $self->{ $norm } = {
- key => $field,
- value => $value,
- };
+ $self->{ $norm } = $field;
}
return;
}
-sub EXISTS {
- my $self = shift;
- my $norm = _normalize_field_name( shift );
- exists $self->{ $norm };
-}
-
sub DELETE {
my $self = shift;
my $norm = _normalize_field_name( shift );
my $deleted = delete $self->{ $norm };
- delete $blosxom::header->{ $deleted->{key} } if $deleted;
+ delete $blosxom::header->{ $deleted } if $deleted;
}
sub CLEAR {
my $self = shift;
%{ $self } = %{ $blosxom::header } = ();
}
+sub EXISTS {
+ my $self = shift;
+ my $norm = _normalize_field_name( shift );
+ exists $self->{ $norm };
+}
+
sub FIRSTKEY {
my $self = shift;
keys %{ $self };
my $first_key = each %{ $self };
return unless defined $first_key;
- $self->{$first_key}->{key};
+ $self->{ $first_key };
}
sub NEXTKEY {
my $self = shift;
my $next_key = each %{ $self };
return unless defined $next_key;
- $self->{$next_key}->{key};
+ $self->{ $next_key };
}
{
@@ -143,100 +106,14 @@ sub NEXTKEY {
}
}
+sub instance {
+ require Blosxom::Header::Class;
+ Blosxom::Header::Class->instance;
+}
+
# new() is deprecated and will be removed in 0.04.
# use instance() istead
-#sub new { shift->instance }
-
-# Following methods are derivatives of FETCH(), STORE(), EXISTS(),
-# DELETE() and CLEAR()
-
-#sub exists { shift->EXISTS( @_ ) }
-#sub clear { shift->CLEAR }
-#sub exists { exists shift->{ $_[0] } }
-#sub clear { shift->CLEAR }
-#sub clear { %{ $_[0] } = () }
-
-#sub delete {
- #my $self = shift;
- #map { $self->DELETE( $_ ) } @_;
-# my ( $self, @fields ) = @_;
-# delete @{ $self }{ @fields };
-#}
-
-#sub get {
-# my $self = shift;
- #my $value = $self->FETCH( shift );
- #die $self->{ $_[0] };
-# my $value = $self->{ $_[0] };
-# return $value unless ref $value eq 'ARRAY';
-# return @{ $value } if wantarray;
-# return $value->[0] if defined wantarray;
-# carp 'Useless use of get() in void context';
-#}
-
-#sub set {
-# my ( $self, @fields ) = @_;
-
-# return unless @fields;
-
-# if ( @fields == 2 ) {
-# #$self->STORE( @fields );
-# $self->{ $fields[0] } = $fields[1];
-# }
-# elsif ( @fields % 2 == 0 ) {
-# while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
-# #$self->STORE( $field => $value );
-# $self->{ $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, $field, @values ) = @_;
-
-# unless ( @values ) {
-# carp 'Useless use of _push() with no values';
-# return;
-# }
-
- #if ( my $value = $self->FETCH( $field ) ) {
-# if ( my $value = $self->{ $field } ) {
-# return push @{ $value }, @values if ref $value eq 'ARRAY';
-# unshift @values, $value;
-# }
-
- #$self->STORE( $field => @values > 1 ? \@values : $values[0] );
-# $self->{ $field } = @values > 1 ? \@values : $values[0] ;
-
-# scalar @values if defined wantarray;
-#}
-
-# push() is deprecated and will be removed in 0.04.
-# use push_cookie() or push_p3p() instead
-#sub push { shift->_push( @_ ) }
-
-# make accessors
-#for my $attr ( ATTRIBUTES ) {
-# my $slot = __PACKAGE__ . "::$attr";
-# my $field = "-$attr";
-
-# no strict 'refs';
-
-# *$slot = sub {
-# my $self = shift;
- #$self->STORE( $field => shift ) if @_;
-# $self->{ $field } = shift if @_;
-# $self->get( $field );
-# }
-#}
+sub new { shift->instance }
1;
@@ -2,7 +2,7 @@ package Blosxom::Header::Class;
use strict;
use warnings;
use Blosxom::Header;
-use Carp;
+use Carp qw/carp croak/;
# Parameters recognized by CGI::header()
use constant ATTRIBUTES
@@ -12,22 +12,17 @@ our $INSTANCE;
sub instance {
my $class = shift;
-
return $INSTANCE if defined $INSTANCE;
-
- #my %header;
- #tie %header, 'Blosxom::Header';
tie my %header, 'Blosxom::Header';
-
$INSTANCE = bless \%header, $class;
}
sub exists { exists $_[0]->{ $_[1] } }
-sub clear { %{ $_[0] } = () }
+sub clear { %{ $_[0] } = () }
sub delete {
- my ( $self, @fields ) = @_;
- delete @{ $self }{ @fields };
+ my $self = shift;
+ delete @{ $self }{ @_ };
}
sub get {
@@ -48,7 +43,7 @@ sub set {
}
elsif ( @fields % 2 == 0 ) {
while ( my ( $field, $value ) = splice @fields, 0, 2 ) {
- $self->{ $field } = $value ;
+ $self->{ $field } = $value;
}
}
else {
@@ -79,17 +74,20 @@ sub _push {
scalar @values if defined wantarray;
}
+# push() is deprecated and will be removed in 0.04.
+# use push_cookie() or push_p3p() instead
+sub push { shift->_push( @_ ) }
+
# make accessors
for my $attr ( ATTRIBUTES ) {
my $slot = __PACKAGE__ . "::$attr";
- my $field = "-$attr";
no strict 'refs';
*$slot = sub {
my $self = shift;
- $self->{ $field } = shift if @_;
- $self->get( $field );
+ $self->{ $attr } = shift if @_;
+ $self->get( $attr );
}
}
View
@@ -1,4 +1,7 @@
use strict;
-use Test::More tests => 1;
+use Test::More tests => 2;
-BEGIN { use_ok "Blosxom::Header" }
+BEGIN {
+ use_ok 'Blosxom::Header';
+ use_ok 'Blosxom::Header::Class';
+}
View
@@ -1,19 +1,37 @@
use strict;
use Blosxom::Header;
-use Test::More tests => 5;
+use Blosxom::Header::Class;
+use Test::More tests => 10;
{
package blosxom;
our $header = { -type => 'text/html' };
}
-ok !$Blosxom::Header::Class::INSTANCE, 'no Blosxom::Header instance yet';
+ok !$Blosxom::Header::INSTANCE, 'no Blosxom::Header instance yet';
-my $h1 = Blosxom::Header->instance;
-ok $h1, 'created Blosxom::Header instance 1';
+{
+ my $h1 = tie my %h1, 'Blosxom::Header';
+ ok $h1, 'created Blosxom::Header instance 1';
+
+ my $h2 = tie my %h2, 'Blosxom::Header';
+ ok $h2, 'created Blosxom::Header instance 2';
+
+ is $h1, $h2, 'both instances are the same object';
+ is $Blosxom::Header::INSTANCE, $h1, 'Blosxom::Header has instance';
+}
+
+ok !$Blosxom::Header::Class::INSTANCE, 'no Blosxom::Header::Class instance yet';
+
+{
+ my $h1 = Blosxom::Header::Class->instance;
+ ok $h1, 'created Blosxom::Header::Class instance 1';
+
+ my $h2 = Blosxom::Header::Class->instance;
+ ok $h2, 'created Blosxom::Header::Class instance 2';
+
+ is $h1, $h2, 'both instances are the same object';
+ is $Blosxom::Header::Class::INSTANCE, $h1, 'Blosxom::Header::Class has instance';
+}
-my $h2 = Blosxom::Header->instance;
-ok $h2, 'created Blosxom::Header instance 2';
-is $h1, $h2, 'both instances are the same object';
-is $Blosxom::Header::Class::INSTANCE, $h1, 'Blosxom::Header has instance';
View
@@ -47,7 +47,4 @@ is delete $header{Bar}, 'baz', 'DELETE(), not case-sensitive';
is_deeply $blosxom::header, { -baz => 'qux' };
-#my $header = bless \%header, 'Blosxom::Header';
-#warn $header->get( 'Baz' );
-
done_testing;
Oops, something went wrong.

0 comments on commit 18c2922

Please sign in to comment.