zby

zby@zby:~/progs/pa$ perl -Ilib t/00-all.t
.
.
.
ok 27
5 second tarpit (tolerance 2)...
not ok 28
#   Failed test at t/00-all.t line 180.
3 second tarpit (tolerance 4)...
ok 29

zby

# dying in a tarpit
print "5 second tarpit (tolerance 2)...\n";
$ua->timeout(2);
$res = $ua->get("$HELPER_SERVER/1.5");
ok(! $res->is_success);

zby

# dying in a tarpit
print "5 second tarpit (tolerance 2)...\n";
$ua->timeout(2);
$res = $ua->get("$HELPER_SERVER/1.5");
ok(!  $res->is_success) or warn Dumper( $res ); use Data::Dumper;

zby

$VAR1 = bless(
    {
        '_protocol' => 'HTTP/1.0',
        '_content'  => '[1/5]
[2/5]
',
        '_rc'      => 200,
        '_headers' => bless(
            {
                'client-date' => 'Fri, 31 Jul 2009 08:56:17 GMT',

zby

die "read timeout" unless $self->can_read($timeout);

zby

confess( "read timeout" ) unless $self->can_read($timeout); use Carp 'confess';

zby

'x-died' => 'read timeout at lib/LWPx/Protocol/http_paranoid.pm line 394
        LWPx::Protocol::http_paranoid::SocketMethods::sysread(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at /usr/local/share/perl/5.8.8/Net/HTTP/Methods.pm line 236
        Net::HTTP::Methods::my_read(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at /usr/local/share/perl/5.8.8/Net/HTTP/Methods.pm line 541
        Net::HTTP::Methods::read_entity_body(\'LWPx::Protocol::http_paranoid::Socket=GLOB(0x8a22d4c)\', \'\', 4096) called at lib/LWPx/Protocol/http_paranoid.pm line 352
        LWPx::Protocol::http_paranoid::__ANON__ called at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 157
        eval {...} called at /usr/local/share/perl/5.8.8/LWP/Protocol.pm line 99
        LWP::Protocol::collect(\'LWPx::Protocol::http_paranoid=HASH(0x8a227dc)\', \'undef\', \'HTTP::Response=HASH(0x8a2fdc0)\', \'CODE(0x8a324b4)\') called at lib/LWPx/Protocol/http_paranoid.pm line 358
        LWP

zby

--- lib/LWPx/ParanoidAgent.pm (revision 18)
+++ lib/LWPx/ParanoidAgent.pm (working copy)
@@ -314,11 +314,12 @@
$response = $protocol->request($request, $proxy,
$arg, $size, $timeout);
};
- if ($@) {
- $@ =~ s/ at .* line \d+.*//s; # remove file/line number
+ my $error = $@ || $response->header( 'x-died' );
+ if ($error) {

zby

sub index :Path :Args(0) {
    my ($self, $c) = @_;

zby

$VAR1 = bless( { 
    '_application' => 'DVDzbr',
    'namespace' => '',
    'action_namespace' => '',
    '_controller_actions' => {}
}, 'DVDzbr::Controller::Root' );