From 129325beabc5a676a89589fb3f080e2fec7b8b53 Mon Sep 17 00:00:00 2001 From: Chris Hamilton Date: Sun, 7 Jun 2015 19:12:07 +0000 Subject: [PATCH 1/3] Improve whitespace consistency --- Changes | 23 ++++---- Makefile.PL | 18 +++---- lib/Test/HTTP/Response.pm | 107 +++++++++++++++++++++++--------------- t/02_simple_api.t | 22 ++++---- t/author_tests/kwalitee.t | 10 ++-- 5 files changed, 102 insertions(+), 78 deletions(-) diff --git a/Changes b/Changes index 1dbaaaa..24147fb 100644 --- a/Changes +++ b/Changes @@ -1,22 +1,23 @@ Revision history for Perl extension Test::HTTP::Response. 0.06 Jan 08 2013 - Added missing dependancy on HTTP::Cookies, added LICENSE to meta.json + Added missing dependancy on HTTP::Cookies, added LICENSE to meta.json + 0.05 Jan 05 2013 - Hopefully fixed bug RT #81644 'Test failures due to hash randomisation in perl 5.17.6' - Added git repo metadata + Hopefully fixed bug RT #81644 'Test failures due to hash randomisation in perl 5.17.6' + Added git repo metadata 0.04 Mar 22 2011 - Added headers_match (Robin Edwards) - Added headers_all_match (Robin Edwards) + Added headers_match (Robin Edwards) + Added headers_all_match (Robin Edwards) 0.03 Dec 3 2009 - Tiny pod improvement - Fixed dependancies in Makefile.PL + Tiny pod improvement + Fixed dependancies in Makefile.PL 0.02 Nov 27 2009 - Fix caching of cookies - POD fixes/improvements + Fix caching of cookies + POD fixes/improvements -0.01 Nov 26 2009 - Initial Release +0.01 Nov 26 2009 + Initial Release diff --git a/Makefile.PL b/Makefile.PL index c302104..c63078f 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,15 +5,15 @@ WriteMakefile( NAME => 'Test::HTTP::Response', VERSION_FROM => 'lib/Test/HTTP/Response.pm', # finds $VERSION PREREQ_PM => { - 'HTTP::Message' => 5.828, - 'HTTP::Cookies' => 5.827, - }, # e.g., Module::Name => 1.1 + 'HTTP::Message' => 5.828, + 'HTTP::Cookies' => 5.827, + }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 - (AUTHOR => 'Aaron Trevena ') : ()), - META_MERGE => { - resources => { - repository => 'https://github.com/hashbangperl/Test--HTTP--Response', + (AUTHOR => 'Aaron Trevena ') : ()), + META_MERGE => { + resources => { + repository => 'https://github.com/hashbangperl/Test--HTTP--Response', + }, }, - }, - ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : ()), + ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : ()), ); diff --git a/lib/Test/HTTP/Response.pm b/lib/Test/HTTP/Response.pm index 0486904..5edd14d 100644 --- a/lib/Test/HTTP/Response.pm +++ b/lib/Test/HTTP/Response.pm @@ -22,7 +22,7 @@ Test::HTTP::Response - Perl testing module for HTTP responses status_error($response); - cookie_matches($response, { key => 'sessionid' },'sessionid exists ok'); # check matching cookie found in response + cookie_matches($response, { key => 'sessionid' }, 'sessionid exists ok'); # check matching cookie found in response my $cookies = extract_cookies($response); @@ -40,13 +40,13 @@ use HTTP::Request; use HTTP::Response; use HTTP::Cookies; -use base qw( Exporter Test::Builder::Module); +use base qw(Exporter Test::Builder::Module); our @EXPORT = qw(status_matches status_ok status_redirect status_not_found status_error - header_matches - headers_match - all_headers_match - cookie_matches extract_cookies); + header_matches + headers_match + all_headers_match + cookie_matches extract_cookies); our $VERSION = '0.06'; @@ -101,43 +101,55 @@ Pass if response has status of 'OK', i.e. 500 sub status_matches { my ($response, $code, $comment, $diag) = @_; + my $tb = $CLASS->builder; my $match = (ref($code) eq 'Regexp') ? $response->code =~ m/$code/ : $response->code == $code; - my $ok = $tb->ok( $match, $comment); + + my $ok = $tb->ok($match, $comment); + unless ($ok) { - $diag ||= "status doesn't match, expected HTTP status code '$code', got " . $response->code . "\n"; - $tb->diag($diag); + $diag ||= "status doesn't match, expected HTTP status code '$code', got " . $response->code . "\n"; + $tb->diag($diag); } + return $ok; } sub status_ok { my ($response, $comment) = @_; + $comment ||= 'Response has HTTP OK (2xx) status'; my $diag = "status is not HTTP OK, expected 200 or similar, got " . $response->code . "\n"; - return status_matches($response, qr/2\d\d/, $comment, $diag ); + + return status_matches($response, qr/2\d\d/, $comment, $diag); } sub status_redirect { my ($response, $comment) = @_; + $comment ||= 'Response has HTTP REDIRECT (3xx) status'; my $diag = "status is not HTTP REDIRECT, expected 301 or similar, got " . $response->code . "\n"; - return status_matches($response, qr/3\d\d/, $comment, $diag ); + + return status_matches($response, qr/3\d\d/, $comment, $diag); } sub status_not_found { my ($response, $comment) = @_; + $comment ||= 'Response has HTTP Not Found (404) status'; my $diag = "status is not HTTP Not Found, expected 404 or similar, got " . $response->code . "\n"; - return status_matches($response, 404, $comment, $diag ); + + return status_matches($response, 404, $comment, $diag); } sub status_error { my ($response, $comment) = @_; + $comment ||= 'Response has HTTP Error (5xx) status'; my $diag = "status is not HTTP ERROR, expected 500 or similar, got " . $response->code . "\n"; - return status_matches($response, qr/5\d\d/, $comment, $diag ); + + return status_matches($response, qr/5\d\d/, $comment, $diag); } =head2 header_matches @@ -153,11 +165,14 @@ sub header_matches { my $match = (ref($value) eq 'Regexp') ? scalar $response->header($field) =~ $value : scalar $response->header($field) eq $value; - my $ok = $tb->ok( $match, $comment); + + my $ok = $tb->ok($match, $comment); + unless ($ok) { my $diag = "header doesn't match, expected HTTP header field $field to be '$value', got '" . $response->header($field) . "'\n"; $tb->diag($diag); } + return $ok; } @@ -219,6 +234,7 @@ sub all_headers_match { $expected = { map { lc($_) => $expected->{$_} } keys %$expected }; my $ok; + for my $header (sort map{ lc } $response->headers->header_field_names) { unless($ok = exists $expected->{$header}) { $tb->ok($ok, "Test for HTTP header field '$header'"); @@ -233,7 +249,7 @@ sub all_headers_match { Test that a cookie with matching attributes is in the response headers - cookie_matches($response, { key => 'sessionid' },'sessionid exists ok'); # check matching cookie found in response + cookie_matches($response, { key => 'sessionid' }, 'sessionid exists ok'); # check matching cookie found in response Passes when match found, fails if no matches found. @@ -242,33 +258,37 @@ Takes a list of arguments filename/response, hashref of attributes and strings o =cut sub cookie_matches { - my ($response,$attr_ref,$name) = @_; + my ($response, $attr_ref, $name) = @_; + my $tb = $CLASS->builder; my $cookies = _get_cookies($response); my $match = 0; my $failure = 'no cookie matching key/name : ' . $attr_ref->{key}; + if ($cookies->{$attr_ref->{key}}) { - $match = 1; - my $cookie_name = $attr_ref->{key}; - foreach my $field ( sort keys %$attr_ref ) { - my $pattern = $attr_ref->{$field}; - my $this_match = (ref($attr_ref->{$field}) eq 'Regexp') ? - $cookies->{$cookie_name}{$field} =~ m/$pattern/ : $cookies->{$cookie_name}{$field} eq $attr_ref->{$field} ; - - unless ($this_match) { - $match = 0; - $failure = join('',"$field doesn't match ", $attr_ref->{$field}, "got ", $cookies->{$cookie_name}{$field} || '' , "instead\n"); - last; - } - } + $match = 1; + my $cookie_name = $attr_ref->{key}; + + foreach my $field (sort keys %$attr_ref) { + my $pattern = $attr_ref->{$field}; + my $this_match = (ref($attr_ref->{$field}) eq 'Regexp') ? + $cookies->{$cookie_name}{$field} =~ m/$pattern/ : $cookies->{$cookie_name}{$field} eq $attr_ref->{$field} ; + + unless ($this_match) { + $match = 0; + $failure = join('', "$field doesn't match ", $attr_ref->{$field}, "got ", $cookies->{$cookie_name}{$field} || '' , "instead\n"); + last; + } + } } - my $ok = $tb->ok( $match, $name); + my $ok = $tb->ok($match, $name); unless ($ok) { - $tb->diag($failure); + $tb->diag($failure); } + return $ok; } @@ -286,7 +306,9 @@ Returns hashref sub extract_cookies { my ($response) = @_; + my $cookies = _get_cookies($response); + return $cookies; } @@ -297,18 +319,19 @@ my $cookies; sub _get_cookies { my $response = shift; + if (ref $response and not defined $cookies->{"$response"}) { - unless ($response->request) { - $response->request(HTTP::Request->new(GET => 'http://www.example.com/')); - } - my $cookie_jar = HTTP::Cookies->new; - $cookie_jar->extract_cookies($response); - $cookie_jar->scan( sub { - my %cookie = (); - @cookie{qw(version key value path domain port path domain port path_spec secure expires discard hash)} = @_; - $cookies->{"$response"}{$cookie{key}} = \%cookie; - } - ); + unless ($response->request) { + $response->request(HTTP::Request->new(GET => 'http://www.example.com/')); + } + + my $cookie_jar = HTTP::Cookies->new; + $cookie_jar->extract_cookies($response); + $cookie_jar->scan(sub { + my %cookie = (); + @cookie{qw(version key value path domain port path domain port path_spec secure expires discard hash)} = @_; + $cookies->{"$response"}{$cookie{key}} = \%cookie; + }); } return $cookies->{"$response"}; diff --git a/t/02_simple_api.t b/t/02_simple_api.t index ab34785..5cbb6e5 100644 --- a/t/02_simple_api.t +++ b/t/02_simple_api.t @@ -23,17 +23,17 @@ cookie_matches($response, { key => 'ID', value=>"123456" }, 'ID value correct'); my $cookies = extract_cookies($response); my $expected_cookie = { - 'discard' => undef, - 'value' => '123456', - 'version' => 0, - 'path' => 1, - 'port' => undef, - 'key' => 'ID', - 'hash' => undef, - 'domain' => undef, - 'path_spec' => 1, - 'expires' => undef - }; + 'discard' => undef, + 'value' => '123456', + 'version' => 0, + 'path' => 1, + 'port' => undef, + 'key' => 'ID', + 'hash' => undef, + 'domain' => undef, + 'path_spec' => 1, + 'expires' => undef + }; is_deeply ( [@{$cookies->{ID}}{sort keys %$expected_cookie}], [@{$expected_cookie}{sort keys %$expected_cookie}], 'extracted cookie data matches'); # diff --git a/t/author_tests/kwalitee.t b/t/author_tests/kwalitee.t index eaf96e0..7a91d35 100644 --- a/t/author_tests/kwalitee.t +++ b/t/author_tests/kwalitee.t @@ -1,9 +1,9 @@ require Test::Kwalitee; Test::Kwalitee->import( tests => [qw/ - use_strict - has_readme has_manifest has_changelog has_tests - proper_libs no_symlinks - has_test_pod has_test_pod_coverage no_pod_errors - /] ); + use_strict + has_readme has_manifest has_changelog has_tests + proper_libs no_symlinks + has_test_pod has_test_pod_coverage no_pod_errors + /] ); From 3320e88cb6e5ff6e01e5e6f33bcfece26027e2a7 Mon Sep 17 00:00:00 2001 From: Chris Hamilton Date: Sun, 7 Jun 2015 19:36:08 +0000 Subject: [PATCH 2/3] Add missing CGI::Cookie dependency --- Makefile.PL | 3 ++- README | 5 +++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index c63078f..f5014d3 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,8 +5,9 @@ WriteMakefile( NAME => 'Test::HTTP::Response', VERSION_FROM => 'lib/Test/HTTP/Response.pm', # finds $VERSION PREREQ_PM => { - 'HTTP::Message' => 5.828, + 'CGI::Cookie' => 1.31, 'HTTP::Cookies' => 5.827, + 'HTTP::Message' => 5.828, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (AUTHOR => 'Aaron Trevena ') : ()), diff --git a/README b/README index 7563074..8543c83 100644 --- a/README +++ b/README @@ -16,8 +16,9 @@ DEPENDENCIES This module requires these other modules and libraries: -Test::More -HTTP::Response +CGI::Cookie +HTTP::Cookies +HTTP::Message COPYRIGHT AND LICENCE From ebdbed80389755f46b6afba5c19587ca51d7aa17 Mon Sep 17 00:00:00 2001 From: Chris Hamilton Date: Sun, 7 Jun 2015 19:44:21 +0000 Subject: [PATCH 3/3] Increment version --- Changes | 3 +++ lib/Test/HTTP/Response.pm | 4 ++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 24147fb..d8b951b 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension Test::HTTP::Response. +0.07 Jun 07 2015 + Added missing dependency on CGI::Cookie + 0.06 Jan 08 2013 Added missing dependancy on HTTP::Cookies, added LICENSE to meta.json diff --git a/lib/Test/HTTP/Response.pm b/lib/Test/HTTP/Response.pm index 5edd14d..ef94d87 100644 --- a/lib/Test/HTTP/Response.pm +++ b/lib/Test/HTTP/Response.pm @@ -28,7 +28,7 @@ Test::HTTP::Response - Perl testing module for HTTP responses =head1 VERSION -0.06 +0.07 =head1 DESCRIPTION @@ -48,7 +48,7 @@ our @EXPORT = qw(status_matches status_ok status_redirect status_not_found statu all_headers_match cookie_matches extract_cookies); -our $VERSION = '0.06'; +our $VERSION = '0.07'; my $Test = Test::Builder->new; my $CLASS = __PACKAGE__;