Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Checking in changes prior to tagging of version 0.03.

Changelog diff is:

diff --git a/Changes b/Changes
index 24f0dfb..29d7993 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension CGI::Header.

+0.03 Oct 7th, 2012
+  - add a benchmark against HTTP::Parser::XS
+  - update POD
+  - add t/server.t
+  - tests require CGI.pm 3.51 because the distribution contains t/headers.t
+
 0.02 Oct 4th, 2012
   - tests require CGI.pm 3.60 and HTTP::Date
   - fix typo
  • Loading branch information...
commit d2ca2e0e424bffea5110b81c719dfd5f7c77fd57 1 parent 53c8039
Ryo Anazawa authored
Showing with 33 additions and 10 deletions.
  1. +6 −0 Changes
  2. +6 −4 MANIFEST
  3. +10 −5 lib/CGI/Header.pm
  4. +11 −1 t/27_server.t
View
6 Changes
@@ -1,5 +1,11 @@
Revision history for Perl extension CGI::Header.
+0.03 Oct 7th, 2012
+ - add a benchmark against HTTP::Parser::XS
+ - update POD
+ - add t/server.t
+ - tests require CGI.pm 3.51 because the distribution contains t/headers.t
+
0.02 Oct 4th, 2012
- tests require CGI.pm 3.60 and HTTP::Date
- fix typo
View
10 MANIFEST
@@ -19,10 +19,12 @@ t/11_basic.t
t/12_tie.t
t/20_content_type.t
t/21_date.t
-t/22_p3p.t
-t/23_set_cookie.t
-t/24_content_disposition.t
-t/25_window_target.t
+t/22_expires.t
+t/23_p3p.t
+t/24_set_cookie.t
+t/25_content_disposition.t
+t/26_window_target.t
+t/27_server.t
t/30_as_string.t
tools/benchmark.pl
xt/pod.t
View
15 lib/CGI/Header.pm
@@ -8,7 +8,7 @@ use Carp qw/carp croak/;
use Scalar::Util qw/refaddr/;
use List::Util qw/first/;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
my %header;
@@ -71,8 +71,9 @@ my %get = (
$tags && qq{policyref="/w3c/p3p.xml", CP="$tags"};
},
-server => sub {
- my $header = shift;
- $header->{-nph} ? $ENV{SERVER_SOFTWARE} || 'cmdline' : undef;
+ my ( $header, $norm ) = @_;
+ return $ENV{SERVER_SOFTWARE} || 'cmdline' if $header->{-nph};
+ $header->{ $norm };
},
-set_cookie => sub { shift->{-cookie} },
-window_target => sub { shift->{-target} },
@@ -157,7 +158,10 @@ my %exists = (
exists $header->{ $norm }
|| first { $header->{$_} } qw(-nph -expires -cookie );
},
- -server => sub { shift->{-nph} },
+ -server => sub {
+ my ( $header, $norm ) = @_;
+ $header->{-nph} || exists $header->{ $norm };
+ },
-set_cookie => sub { exists shift->{-cookie} },
-window_target => sub { exists shift->{-target} },
);
@@ -347,10 +351,11 @@ sub as_string {
my @lines;
+ # add Status-Line
if ( $header->{-nph} ) {
my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
my $status = $header->{-status} || '200 OK';
- push @lines, "$protocol $status"; # add Status-Line
+ push @lines, "$protocol $status";
}
# add response headers
View
12 t/27_server.t
@@ -1,16 +1,26 @@
use strict;
use warnings;
use CGI::Header;
-use Test::More tests => 3;
+use Test::More tests => 8;
my %adaptee;
tie my %adapter, 'CGI::Header', \%adaptee;
%adaptee = ();
is $adapter{Server}, undef;
+ok !exists $adapter{Server};
+
+%adaptee = ( -server => 'Apache/1.3.27 (Unix)' );
+is $adapter{Server}, 'Apache/1.3.27 (Unix)';
+ok exists $adapter{Server};
%adaptee = ( -nph => 1 );
+
local $ENV{SERVER_SOFTWARE};
is $adapter{Server}, 'cmdline';
+ok exists $adapter{Server};
+
$ENV{SERVER_SOFTWARE} = 'Apache/1.3.27 (Unix)';
is $adapter{Server}, 'Apache/1.3.27 (Unix)';
+ok exists $adapter{Server};
+
Please sign in to comment.
Something went wrong with that request. Please try again.