LWP-UserAgent-Determined-1.07/ 0000755 0001750 0001750 00000000000 12352357326 015074 5 ustar chmrr chmrr LWP-UserAgent-Determined-1.07/META.yml 0000664 0001750 0001750 00000000750 12352357326 016351 0 ustar chmrr chmrr ---
abstract: 'a virtual browser that retries errors'
author:
- unknown
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: LWP-UserAgent-Determined
no_index:
directory:
- t
- inc
requires:
LWP: '0'
version: '1.07'
LWP-UserAgent-Determined-1.07/README 0000644 0001750 0001750 00000004330 12352351562 015750 0 ustar chmrr chmrr README for LWP::UserAgent::Determined
Time-stamp: "2004-04-08 22:37:47 ADT"
NAME
LWP::UserAgent::Determined - a virtual browser that retries errors
SYNOPSIS
use strict;
use LWP::UserAgent::Determined;
my $browser = LWP::UserAgent::Determined->new;
my $response = $browser->get($url, headers... );
DESCRIPTION
This class works just like LWP::UserAgent (and is based on it, by
being a subclass of it), except that when you use it to get a web page
but run into a possibly-temporary error (like a DNS lookup timeout),
it'll wait a few seconds and retry a few times.
It also adds some methods for controlling exactly what errors are
considered retry-worthy and how many times to wait and for how many
seconds, but normally you needn't bother about these, as the default
settings are relatively sane.
INSTALLATION
You install this module, as you would install any perl module library,
by running these commands:
perl Makefile.PL
make
make test
make install
If you want to install a private copy of this module in your home
directory, then you should try to produce the initial Makefile with
something like this command:
perl Makefile.PL LIB=~/perl
Then you may need something like
setenv PERLLIB "$HOME/perl"
in your shell initialization file (e.g., ~/.cshrc).
For further information, see perldoc perlmodinstall
DOCUMENTATION
POD-format documentation is included in this module. POD is readable
with the 'perldoc' utility. See ChangeLog for recent changes.
SUPPORT
Questions, bug reports, useful code bits, and suggestions for
this module should just be sent to me at sburke@cpan.org
AVAILABILITY
The latest version of this modules is available from the Comprehensive
Perl Archive Network (CPAN). Visit to
find a CPAN site near you.
COPYRIGHT
Copyright 2004, Sean M. Burke , all rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
AUTHOR
Sean M. Burke
LWP-UserAgent-Determined-1.07/Makefile.PL 0000644 0001750 0001750 00000001370 12352351562 017043 0 ustar chmrr chmrr
# Run this program to generate a makefile. See "perldoc perlmodinstall"
#
# Time-stamp: "2004-04-08 22:47:11 ADT"
#
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
require 5.004;
use strict;
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'LWP::UserAgent::Determined',
'VERSION_FROM' => 'lib/LWP/UserAgent/Determined.pm',
'ABSTRACT_FROM' => 'lib/LWP/UserAgent/Determined.pm',
'PREREQ_PM' => {
'LWP' => 0,
},
'dist' => { COMPRESS => 'gzip -6f', SUFFIX => 'gz', },
);
package MY;
sub libscan
{ # Determine things that should *not* be installed
my($self, $path) = @_;
return '' if $path =~ m/~/;
$path;
}
__END__
LWP-UserAgent-Determined-1.07/MANIFEST 0000644 0001750 0001750 00000000425 12352357327 016227 0 ustar chmrr chmrr ChangeLog
lib/LWP/UserAgent/Determined.pm
Makefile.PL
MANIFEST
README
t/01_about_verbose.t
t/10_determined_test.t
META.yml Module meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
LWP-UserAgent-Determined-1.07/META.json 0000664 0001750 0001750 00000001542 12352357326 016521 0 ustar chmrr chmrr {
"abstract" : "a virtual browser that retries errors",
"author" : [
"unknown"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "LWP-UserAgent-Determined",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"LWP" : "0"
}
}
},
"release_status" : "stable",
"version" : "1.07"
}
LWP-UserAgent-Determined-1.07/t/ 0000755 0001750 0001750 00000000000 12352357326 015337 5 ustar chmrr chmrr LWP-UserAgent-Determined-1.07/t/01_about_verbose.t 0000644 0001750 0001750 00000004261 12352351562 020662 0 ustar chmrr chmrr
require 5;
# Time-stamp: "2004-04-08 22:47:53 ADT"
# Summary of, well, things.
use Test;
BEGIN {plan tests => 2};
ok 1;
use LWP::UserAgent::Determined;
use LWP::UserAgent;
use LWP;
#chdir "t" if -e "t";
{
my @out;
push @out,
"\n\nPerl v",
defined($^V) ? sprintf('%vd', $^V) : $],
" under $^O ",
(defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
(defined $MacPerl::Version)
? ("(MacPerl version $MacPerl::Version)") : (),
"\n"
;
# Ugly code to walk the symbol tables:
my %v;
my @stack = (''); # start out in %::
my $this;
my $count = 0;
my $pref;
while(@stack) {
$this = shift @stack;
die "Too many packages?" if ++$count > 1000;
next if exists $v{$this};
next if $this eq 'main'; # %main:: is %::
#print "Peeking at $this => ${$this . '::VERSION'}\n";
if(defined ${$this . '::VERSION'} ) {
$v{$this} = ${$this . '::VERSION'}
} elsif(
defined *{$this . '::ISA'} or defined &{$this . '::import'}
or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
# If it has an ISA, an import, or any subs...
) {
# It's a class/module with no version.
$v{$this} = undef;
} else {
# It's probably an unpopulated package.
## $v{$this} = '...';
}
$pref = length($this) ? "$this\::" : '';
push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
#print "Stack: @stack\n";
}
push @out, " Modules in memory:\n";
delete @v{'', '[none]'};
foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
$indent = ' ' x (2 + ($p =~ tr/:/:/));
push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
}
push @out, sprintf "[at %s (local) / %s (GMT)]\n",
scalar(gmtime), scalar(localtime);
my $x = join '', @out;
$x =~ s/^/#/mg;
print $x;
}
print "# Running",
(chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
"#\n",
;
print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n";
print "# \%INC:\n";
foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
print "# [$x] = [", $INC{$x} || '', "]\n";
}
ok 1;
LWP-UserAgent-Determined-1.07/t/10_determined_test.t 0000644 0001750 0001750 00000006124 12352351562 021202 0 ustar chmrr chmrr
# Time-stamp: "0";
use strict;
use Test;
BEGIN { plan tests => 13 }
#use LWP::Debug ('+');
use LWP::UserAgent::Determined;
my $browser = LWP::UserAgent::Determined->new;
use HTTP::Headers;
use HTTP::Request;
use HTTP::Request::Common qw( GET );
sub set_response {
my ($code) = @_;
my $handler = sub {
return HTTP::Response->new($code, undef, HTTP::Headers->new(), 'n/a');
};
if( LWP::UserAgent->can('set_my_handler') ){ # 5.815
# forward compatible
$browser->set_my_handler(request_send => $handler);
}
else {
# backward compatible
*LWP::UserAgent::simple_request = $handler;
}
}
sub timings {
my $self = $browser;
# copied from module, line 20
my(@timing_tries) = ( $self->timing() =~ m<(\d+(?:\.\d+)*)>g );
}
#$browser->agent('Mozilla/4.76 [en] (Win98; U)');
ok 1;
print "# Hello from ", __FILE__, "\n";
print "# LWP::UserAgent::Determined v$LWP::UserAgent::Determined::VERSION\n";
print "# LWP::UserAgent v$LWP::UserAgent::VERSION\n";
print "# LWP v$LWP::VERSION\n" if $LWP::VERSION;
my @error_codes = qw(408 500 502 503 504);
ok( @error_codes == keys %{$browser->codes_to_determinate} );
ok( @error_codes == grep { $browser->codes_to_determinate->{$_} } @error_codes );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
set_response(503);
my $url = 'http://www.livejournal.com/~torgo_x/rss';
my $before_count = 0;
my $after_count = 0;
$browser->before_determined_callback( sub {
print "# /Trying ", $_[4][0]->uri, " at ", scalar(localtime), "...\n";
++$before_count;
});
$browser->after_determined_callback( sub {
print "# \\Just tried ", $_[4][0]->uri, " at ", scalar(localtime), ". ",
($after_count < scalar(timings) ? "Waiting " . (timings)[$after_count] . "s." : "Giving up."), "\n";
++$after_count;
});
my $resp = $browser->request( GET $url );
ok 1;
print "# That gave: ", $resp->status_line, "\n";
print "# Before_count: $before_count\n";
ok( $before_count > 1 );
print "# After_count: $after_count\n";
ok( $after_count > 1 );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
set_response(500);
$url = "http://www.aoeaoeaoeaoe.int:9876/sntstn";
$before_count = 0;
$after_count = 0;
print "# Trying unknown host/port, $url\n";
$resp = $browser->request( GET $url );
ok 1;
$browser->timing('1,2,3');
print "# Timing: ", $browser->timing, "\n";
print "# That gave: ", $resp->status_line, "\n";
print "# Before_count: $before_count\n";
ok $before_count, 4;
print "# After_count: $after_count\n";
ok $after_count, 4;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
set_response(404);
$url = "http://www.google.com/should-always-return-a-404";
$before_count = 0;
$after_count = 0;
print "# Trying a nonexistent address, $url\n";
$resp = $browser->request( GET $url );
ok 1;
$browser->timing('1,2,3');
print "# Timing: ", $browser->timing, "\n";
print "# That gave: ", $resp->status_line, "\n";
print "# Before_count: $before_count\n";
ok $before_count, 1;
print "# After_count: $after_count\n";
ok $after_count, 1;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
print "# Okay, bye from ", __FILE__, "\n";
ok 1;
LWP-UserAgent-Determined-1.07/lib/ 0000755 0001750 0001750 00000000000 12352357326 015642 5 ustar chmrr chmrr LWP-UserAgent-Determined-1.07/lib/LWP/ 0000755 0001750 0001750 00000000000 12352357326 016304 5 ustar chmrr chmrr LWP-UserAgent-Determined-1.07/lib/LWP/UserAgent/ 0000755 0001750 0001750 00000000000 12352357326 020201 5 ustar chmrr chmrr LWP-UserAgent-Determined-1.07/lib/LWP/UserAgent/Determined.pm 0000644 0001750 0001750 00000015472 12352356743 022632 0 ustar chmrr chmrr
package LWP::UserAgent::Determined;
$VERSION = '1.07';
use LWP::UserAgent ();
@ISA = ('LWP::UserAgent');
use strict;
die "Where's _elem?!!?" unless __PACKAGE__->can('_elem');
sub timing { shift->_elem('timing' , @_) }
sub codes_to_determinate { shift->_elem('codes_to_determinate' , @_) }
sub before_determined_callback { shift->_elem('before_determined_callback' , @_) }
sub after_determined_callback { shift->_elem( 'after_determined_callback' , @_) }
#==========================================================================
sub simple_request {
my ( $self, @args ) = @_;
my (@timing_tries) = ( $self->timing() =~ m<(\d+(?:\.\d+)*)>g );
my $determination = $self->codes_to_determinate();
my $resp;
my $before_c = $self->before_determined_callback;
my $after_c = $self->after_determined_callback;
my $request = $args[0];
foreach my $pause_if_unsuccessful ( @timing_tries, undef ) {
$args[0] = $request->clone;
$before_c and $before_c->(
$self, \@timing_tries, $pause_if_unsuccessful, $determination,
\@args
);
$resp = $self->SUPER::simple_request(@args);
$after_c and $after_c->(
$self, \@timing_tries, $pause_if_unsuccessful, $determination,
\@args, $resp
);
my $code = $resp->code;
unless ( $determination->{$code} ) {
# normal case: all is well (or 404, etc)
return $resp;
}
if ( defined $pause_if_unsuccessful ) {
# it's undef only on the last
sleep $pause_if_unsuccessful if $pause_if_unsuccessful;
}
}
return $resp;
}
#--------------------------------------------------------------------------
sub new {
my $self = shift->SUPER::new(@_);
$self->_determined_init();
return $self;
}
#--------------------------------------------------------------------------
sub _determined_init {
my $self = shift;
$self->timing('1,3,15');
$self->codes_to_determinate( { map { $_ => 1 }
'408', # Request Timeout
'500', # Internal Server Error
'502', # Bad Gateway
'503', # Service Unavailable
'504', # Gateway Timeout
} );
return;
}
#==========================================================================
1;
__END__
=head1 NAME
LWP::UserAgent::Determined - a virtual browser that retries errors
=head1 SYNOPSIS
use strict;
use LWP::UserAgent::Determined;
my $browser = LWP::UserAgent::Determined->new;
my $response = $browser->get($url, headers... );
=head1 DESCRIPTION
This class works just like L (and is based on it, by
being a subclass of it), except that when you use it to get a web page
but run into a possibly-temporary error (like a DNS lookup timeout),
it'll wait a few seconds and retry a few times.
It also adds some methods for controlling exactly what errors are
considered retry-worthy and how many times to wait and for how many
seconds, but normally you needn't bother about these, as the default
settings are relatively sane.
=head1 METHODS
This module inherits all of L's methods,
and adds the following.
=over
=item $timing_string = $browser->timing();
=item $browser->timing( "10,30,90" )
The C method gets or sets the string that controls how many
times it should retry, and how long the pauses should be.
If you specify empty-string, this means not to retry at all.
If you specify a string consisting of a single number, like "10", that
means that if the first request doesn't succeed, then
C<< $browser->get(...) >> (or any other method based on C
or C)
should wait 10 seconds and try again (and if that fails, then
it's final).
If you specify a string with several numbers in it (like "10,30,90"),
then that means C<$browser> can Itry as that many times (i.e., one
initial try, I a maximum of the three retries, because three numbers
there), and that it should wait first those numbers of seconds each time.
So C<< $browser->timing( "10,30,90" ) >> basically means:
try the request; return it unless it's a temporary-looking error;
sleep 10;
retry the request; return it unless it's a temporary-looking error;
sleep 30;
retry the request; return it unless it's a temporary-looking error;
sleep 90 the request;
return it;
The default value is "1,3,15".
=item $http_codes_hr = $browser->codes_to_determinate();
This returns the hash that is the set of HTTP codes that merit a retry
(like 500 and 408, but unlike 404 or 200). You can delete or add
entries like so;
$http_codes_hr = $browser->codes_to_determinate();
delete $http_codes_hr->{408};
$http_codes_hr->{567} = 1;
(You can actually set a whole new hashset with C<<
$browser->codes_to_determinate($new_hr) >>, but there's usually no
benefit to that as opposed to the above.)
The current default is 408 (Timeout) plus some 5xx codes.
=item $browser->before_determined_callback()
=item $browser->before_determined_callback( \&some_routine );
=item $browser->after_determined_callback()
=item $browser->after_determined_callback( \&some_routine );
These read (first two) or set (second two) callbacks that are
called before the actual HTTP/FTP/etc request is made. By default,
these are set to undef, meaning nothing special is called. If you
want to alter try requests, or inspect responses before any retrying
is considered, you can set up these callbacks.
The arguments passed to these routines are:
=over
=item 0: the current $browser object
=item 1: an arrayref to the list of timing pauses (based on $browser->timing)
=item 2: the duration of the number of seconds we'll pause if this request
fails this time, or undef if this is the last chance.
=item 3: the value of $browser->codes_to_determinate
=item 4: an arrayref of the arguments we pass to LWP::UserAgent::simple_request
(the first of which is the request object)
=item (5): And, only for after_determined_callback, the response we
just got.
=back
Example use:
$browser->before_determined_callback( sub {
print "Trying ", $_[4][0]->uri, " ...\n";
});
=back
=head1 IMPLEMENTATION
This class works by overriding LWP::UserAgent's C method
with its own around-method that just loops. See the source of this
module; it's straightforward. Relatively.
=head1 SEE ALSO
L, L
=head1 COPYRIGHT AND DISCLAIMER
Copyright 2004, Sean M. Burke, all rights
reserved. This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
This program is distributed in the hope that it will be useful,
but without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
=head1 AUTHOR
Originally created by Sean M. Burke, C
Currently maintained by Jesse Vincent C
=cut
LWP-UserAgent-Determined-1.07/ChangeLog 0000644 0001750 0001750 00000001106 12352356726 016647 0 ustar chmrr chmrr Revision history for Perl extension LWP::Determined::UserAgent
1.07 2014-06-24
- Prevent changes to request object (such as Cookie headers) from being
added once for each request [cpan #96497]
1.06 2012.05-20
- Mock http responses to avoid unnecessary network requests -- Randy
Stauner
1.05 2011-01-03
- Fix for RT#55591: Incorrect default value for 'codes_to_determinate'
from yibe via github.
1.04 2009-04-04
- New Maintainer (Jesse vincent)
- Resolves [cpan #42123] and [cpan #41508]
1.03 2004-04-08
- Doc-typo bugfix
1.02 2004-04-07
- First public release