diff --git a/.travis.yml b/.travis.yml index a11b6b17..99d4fb30 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,6 @@ language: perl perl: + - "5.26" - "5.24" - "5.22" - "5.20" diff --git a/cpanfile b/cpanfile index c3a7748b..77a256f7 100644 --- a/cpanfile +++ b/cpanfile @@ -23,10 +23,14 @@ requires "strict" => "0"; requires "warnings" => "0"; on 'test' => sub { + requires "Cwd" => "0"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; + requires "File::Temp" => "0"; requires "PerlIO::encoding" => "0"; requires "Test::More" => "0.88"; + requires "Test::Needs" => "0"; + requires "Test::Warnings" => "0"; requires "Time::Local" => "0"; requires "Try::Tiny" => "0"; requires "perl" => "5.008001"; diff --git a/lib/HTTP/Response.pm b/lib/HTTP/Response.pm index efb6d6b5..2d57becf 100644 --- a/lib/HTTP/Response.pm +++ b/lib/HTTP/Response.pm @@ -215,7 +215,19 @@ sub dump sub is_info { HTTP::Status::is_info (shift->{'_rc'}); } -sub is_success { HTTP::Status::is_success (shift->{'_rc'}); } +sub is_success { + my $self = shift; + if ( HTTP::Status::is_success( $self->{'_rc'} ) + && $self->header( 'X-Died' ) ) + { + my $warning = <<'EOF'; +The HTTP status code implies success, but the X-Died header has been set +internally. Something has gone wrong: ' +EOF + warn $warning . $self->header('X-Died'); + } + return HTTP::Status::is_success( $self->{'_rc'} ); +} sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); } sub is_error { HTTP::Status::is_error (shift->{'_rc'}); } sub is_client_error { HTTP::Status::is_client_error (shift->{'_rc'}); } diff --git a/t/x-died.t b/t/x-died.t new file mode 100644 index 00000000..ffffba19 --- /dev/null +++ b/t/x-died.t @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use Cwd 'realpath'; +use File::Temp 'tempfile'; +use Test::Needs { 'LWP::UserAgent' => 6.05 }; +use Test::More; +use Test::Warnings ':all'; + +my($tmpfh,$tmpfile) = tempfile(UNLINK => 1); +close $tmpfh; +chmod 0400, $tmpfile or die $!; + +my $res = LWP::UserAgent->new->get('file://' . realpath($0), ':content_file' => $tmpfile); +ok $res->header('X-Died'), 'X-Died header seen'; +like(warning { $res->is_success }, qr{X\-Died}, 'warning about X-Died header seen.'); + +done_testing();