Skip to content
Browse files

rename Handler to Dispatcher

  • Loading branch information...
1 parent c1bb376 commit b82c3230cf296ed89ad0108b48fec5acf17039a9 Ryo Anazawa committed
Showing with 100 additions and 139 deletions.
  1. +26 −115 lib/CGI/Header.pm
  2. +68 −20 lib/CGI/Header/{Handler.pm → Dispatcher.pm}
  3. +1 −1 t/00_compile.t
  4. +5 −3 t/10_normalization.t
View
141 lib/CGI/Header.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use overload q{""} => 'as_string', fallback => 1;
use Carp qw/carp croak/;
-use CGI::Header::Handler qw/get_handler/;
+use CGI::Header::Dispatcher;
use HTTP::Date qw//;
use List::Util qw/first/;
use Scalar::Util qw/refaddr/;
@@ -38,74 +38,10 @@ sub DESTROY {
return;
}
-sub get {
- my $self = shift;
- my $norm = $self->_normalize( shift );
- my $this = refaddr $self;
- my $header = $header_of{ $this };
-
- return unless $norm;
-
- if ( my $get = get_handler($norm, 'get') ) {
- return $get->( $header );
- }
-
- $header->{ $norm };
-}
-
-
-sub set {
- my $self = shift;
- my $norm = $self->_normalize( shift );
- my $value = shift;
- my $this = refaddr $self;
- my $header = $header_of{ $this };
-
- return unless $norm;
-
- if ( my $set = get_handler($norm, 'set') ) {
- $set->( $header, $value );
- return;
- }
-
- $header->{ $norm } = $value;
-
- return;
-}
-
-sub delete {
- my $self = shift;
- my $field = shift;
- my $norm = $self->_normalize( $field );
- my $value = defined wantarray && $self->get( $field );
- my $this = refaddr $self;
- my $header = $header_of{ $this };
-
- return unless $norm;
-
- if ( my $delete = get_handler($norm, 'delete') ) {
- $delete->( $header );
- }
-
- delete $header->{ $norm };
-
- $value;
-}
-
-sub exists {
- my $self = shift;
- my $norm = $self->_normalize( shift );
- my $this = refaddr $self;
- my $header = $header_of{ $this };
-
- return unless $norm;
-
- if ( my $exists = get_handler($norm, 'exists') ) {
- return $exists->( $header );
- }
-
- $header->{ $norm };
-}
+sub get { shift->dispatch( 'get', @_ ) }
+sub set { shift->dispatch( 'set', @_ ) }
+sub delete { shift->dispatch( 'delete', @_ ) }
+sub exists { shift->dispatch( 'exists', @_ ) }
sub clear {
my $self = shift;
@@ -224,35 +160,13 @@ sub p3p_tags {
}
sub target {
- my $self = shift;
- my $this = refaddr $self;
+ my $self = shift;
+ my $this = refaddr $self;
my $header = $header_of{ $this };
-
- if ( @_ ) {
- $header->{-target} = shift;
- return;
- }
-
+ $header->{-target} = shift if @_;
$header->{-target};
}
-sub dump {
- my $self = shift;
- my $this = refaddr $self;
-
- require Data::Dumper;
-
- local $Data::Dumper::Indent = 1;
-
- my %dump = (
- __PACKAGE__, {
- header => $header_of{ $this },
- },
- @_,
- );
-
- Data::Dumper::Dumper( \%dump );
-}
sub content_type {
my $self = shift;
@@ -424,6 +338,24 @@ sub as_string {
join $eol, @lines, q{};
}
+sub dump {
+ my $self = shift;
+ my $this = refaddr $self;
+
+ require Data::Dumper;
+
+ local $Data::Dumper::Indent = 1;
+
+ my %dump = (
+ __PACKAGE__, {
+ header => $header_of{ $this },
+ },
+ @_,
+ );
+
+ Data::Dumper::Dumper( \%dump );
+}
+
BEGIN { *clone = \&Storable::dclone }
sub STORABLE_freeze {
@@ -439,27 +371,6 @@ sub STORABLE_thaw {
$self;
}
-my %norm_of = (
- -attachment => q{}, -charset => q{},
- -cookie => q{}, -nph => q{},
- #-set_cookie => q{-cookie}, -target => q{},
- -target => q{},
- -type => q{}, -window_target => q{-target},
-);
-
-sub _normalize {
- my $class = shift;
- my $field = lc shift;
-
- # transliterate dashes into underscores
- $field =~ tr{-}{_};
-
- # add an initial dash
- $field = "-$field";
-
- exists $norm_of{$field} ? $norm_of{ $field } : $field;
-}
-
my %field_name_of = (
-attachment => 'Content-Disposition', -cookie => 'Set-Cookie',
-p3p => 'P3P', -target => 'Window-Target',
View
88 lib/CGI/Header/Handler.pm → lib/CGI/Header/Dispatcher.pm
@@ -1,13 +1,13 @@
-package CGI::Header::Handler;
+package CGI::Header::Dispatcher;
use strict;
use warnings;
use Exporter 'import';
use List::Util qw/first/;
use CGI::Util qw/expires/;
use HTTP::Date qw/time2str str2time/;
-use Carp qw/carp/;
+use Carp qw/carp croak/;
-our @EXPORT_OK = qw( get_handler );
+our @EXPORT = qw( dispatch );
my %Content_Type = (
get => sub {
@@ -43,8 +43,8 @@ my %Content_Type = (
},
delete => sub {
my $header = shift;
- delete $header->{-charset};
$header->{-type} = q{};
+ delete $header->{-charset};
},
);
@@ -62,8 +62,8 @@ my %Expires = (
my %P3P = (
get => sub {
my $header = shift;
- my $p3p = $header->{-p3p};
- my $tags = ref $p3p eq 'ARRAY' ? join ' ', @{ $p3p } : $p3p;
+ my $tags = $header->{-p3p};
+ $tags = join ' ', @{ $tags } if ref $tags eq 'ARRAY';
$tags && qq{policyref="/w3c/p3p.xml", CP="$tags"};
},
set => sub {
@@ -93,53 +93,101 @@ my %Content_Disposition = (
},
);
+my $is_fixed = sub {
+ my $header = shift;
+ $header->{-nph} || $header->{-expires} || $header->{-cookie};
+};
+
my %Date = (
get => sub {
my $header = shift;
- my $is_fixed = first { $header->{$_} } qw(-nph -expires -cookie);
- return time2str( time ) if $is_fixed;
+ return time2str( time ) if $is_fixed->( $header );
$header->{-date};
},
set => sub {
my ( $header, $value ) = @_;
- my $is_fixed = first { $header->{$_} } qw(-nph -expires -cookie);
- return carp 'The Date header is fixed' if $is_fixed;
+ return carp 'The Date header is fixed' if $is_fixed->( $header );
$header->{-date} = $value;
},
exists => sub {
my $header = shift;
- $header->{-date} || first { $header->{$_} } qw(-nph -expires -cookie);
+ $header->{-date} || $is_fixed->( $header );
},
delete => sub {
my $header = shift;
- my $is_fixed = first { $header->{$_} } qw(-nph -expires -cookie);
- return carp 'The Date header is fixed' if $is_fixed;
+ carp 'The Date header is fixed' if $is_fixed->( $header );
},
);
my %Set_Cookie = (
- get => sub { shift->{-cookie} },
set => sub {
my ( $header, $value ) = @_;
delete $header->{-date};
$header->{-cookie} = $value;
},
- exists => sub { shift->{-cookie} },
- delete => sub { delete shift->{-cookie} },
);
my %Handler = (
-content_disposition => \%Content_Disposition,
-content_type => \%Content_Type,
- -set_cookie => \%Set_Cookie,
+ -cookie => \%Set_Cookie,
-date => \%Date,
-expires => \%Expires,
-p3p => \%P3P,
);
-sub get_handler {
- my ( $norm, $operator ) = @_;
- exists $Handler{ $norm } && $Handler{ $norm }{ $operator };
+sub dispatch {
+ my $self = shift;
+ my $operator = shift;
+ my $field = shift;
+ my $norm = _normalize( $field );
+ my $header = $self->header;
+
+ return if !$operator or !$norm;
+
+ my $handler = exists $Handler{ $norm } && $Handler{ $norm }{ $operator };
+
+ if ( $operator eq 'get' ) {
+ return $handler ? $handler->( $header ) : $header->{ $norm };
+ }
+ elsif ( $operator eq 'set' ) {
+ my $value = shift;
+ $handler->( $header, $value ) if $handler;
+ $header->{ $norm } = $value unless $handler;
+ }
+ elsif ( $operator eq 'exists' ) {
+ return $handler ? $handler->( $header ) : $header->{ $norm };
+ }
+ elsif ( $operator eq 'delete' ) {
+ my $value = defined wantarray && $self->get( $field );
+ $handler->( $header ) if $handler;
+ delete $header->{ $norm };
+ return $value;
+ }
+ else {
+ croak "Unknown operator '$operator' passed to dispatch()";
+ }
+
+ return;
+}
+
+my %norm_of = (
+ -attachment => q{}, -charset => q{},
+ -cookie => q{}, -nph => q{},
+ -target => q{}, -type => q{},
+ -window_target => q{-target}, -set_cookie => q{-cookie},
+);
+
+sub _normalize {
+ my $field = lc shift;
+
+ # transliterate dashes into underscores
+ $field =~ tr{-}{_};
+
+ # add an initial dash
+ $field = "-$field";
+
+ exists $norm_of{$field} ? $norm_of{ $field } : $field;
}
1;
View
2 t/00_compile.t
@@ -2,6 +2,6 @@ use strict;
use Test::More tests => 2;
BEGIN {
- use_ok 'CGI::Header::Handler';
+ use_ok 'CGI::Header::Dispatcher';
use_ok 'CGI::Header';
}
View
8 t/10_normalization.t
@@ -1,15 +1,17 @@
use strict;
use warnings;
-use CGI::Header;
+use CGI::Header::Dispatcher;
use Test::Base;
plan tests => 1 * blocks();
-my $header = 'CGI::Header';
+#my $header = 'CGI::Header';
+my $normalize = CGI::Header::Dispatcher->can( '_normalize' );
run {
my $block = shift;
- is $header->_normalize( $block->input ), $block->expected;
+ #is $header->_normalize( $block->input ), $block->expected;
+ is $normalize->( $block->input ), $block->expected;
};
__DATA__

0 comments on commit b82c323

Please sign in to comment.
Something went wrong with that request. Please try again.