LWP-UserAgent-Determined-1.06/000755 000765 000024 00000000000 11756307636 016345 5ustar00jessestaff000000 000000 LWP-UserAgent-Determined-1.06/ChangeLog000644 000765 000024 00000001272 11756307601 020111 0ustar00jessestaff000000 000000 Revision history for Perl extension LWP::Determined::UserAgent 2012.05-20 Jesse Vincent * Release 1.06 * Mock http responses to avoid unnecessary network requests -- Randy Stauner 2011-01-03 Jesse Vincent * Release 1.05 * Fix for RT#55591: Incorrect default value for 'codes_to_determinate' from yibe via github. 2009-04-04 Jesse Vincent * Release 1.04 -- Keeping pace with LWP updates * New Maintainer * Resolves [cpan #42123] and [cpan #41508] 2004-04-08 Sean M. Burke sburke@cpan.org * Release 1.03 -- just a doc-typo bugfix version. 2004-04-07 Sean M. Burke sburke@cpan.org * Release 1.02 -- First public release. LWP-UserAgent-Determined-1.06/lib/000755 000765 000024 00000000000 11756307636 017113 5ustar00jessestaff000000 000000 LWP-UserAgent-Determined-1.06/Makefile.PL000644 000765 000024 00000001370 11620523272 020302 0ustar00jessestaff000000 000000 # 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.06/MANIFEST000644 000765 000024 00000000443 11756307637 017500 0ustar00jessestaff000000 000000 ChangeLog lib/LWP/UserAgent/Determined.pm Makefile.PL MANIFEST MANIFEST.SKIP 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.06/MANIFEST.SKIP000644 000765 000024 00000000151 11620523272 020222 0ustar00jessestaff000000 000000 ^MANIFEST\.bak$ ^[-_a-zA-Z0-9]+[0-9]+\.[0-9]+(?:_[0-9]+)?$ Makefile(\.old)?$ t/.*.rtf$ \.rej$ CVS blib ~ LWP-UserAgent-Determined-1.06/META.json000644 000765 000024 00000001534 11756307636 017771 0ustar00jessestaff000000 000000 { "abstract" : "a virtual browser that retries errors", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.113640", "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.06" } LWP-UserAgent-Determined-1.06/META.yml000644 000765 000024 00000000736 11756307636 017624 0ustar00jessestaff000000 000000 --- 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.62, CPAN::Meta::Converter version 2.113640' 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.06 LWP-UserAgent-Determined-1.06/README000644 000765 000024 00000004330 11620523272 017207 0ustar00jessestaff000000 000000 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.06/t/000755 000765 000024 00000000000 11756307636 016610 5ustar00jessestaff000000 000000 LWP-UserAgent-Determined-1.06/t/01_about_verbose.t000644 000765 000024 00000004261 11620523272 022121 0ustar00jessestaff000000 000000 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.06/t/10_determined_test.t000644 000765 000024 00000006124 11756307123 022446 0ustar00jessestaff000000 000000 # 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.06/lib/LWP/000755 000765 000024 00000000000 11756307636 017555 5ustar00jessestaff000000 000000 LWP-UserAgent-Determined-1.06/lib/LWP/UserAgent/000755 000765 000024 00000000000 11756307636 021452 5ustar00jessestaff000000 000000 LWP-UserAgent-Determined-1.06/lib/LWP/UserAgent/Determined.pm000644 000765 000024 00000015070 11756307575 024075 0ustar00jessestaff000000 000000 package LWP::UserAgent::Determined; $VERSION = '1.06'; 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; foreach my $pause_if_unsuccessful (@timing_tries, undef) { $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