[Bps-public-commit] lwp-useragent-determined branch, master, created. de4b3cfb664c93a54056b3c004dc81bedf9ef4d0
Alex Vandiver
alexmv at bestpractical.com
Tue Jun 24 15:37:29 EDT 2014
The branch, master has been created
at de4b3cfb664c93a54056b3c004dc81bedf9ef4d0 (commit)
- Log -----------------------------------------------------------------
commit c8140ef9bedb9abf27ae5956c9074e1916276795
Author: Sean M. Burke <sburke at cpan.org>
Date: Fri Apr 9 00:00:00 2004 -0400
initial import of LWP::UserAgent::Determined 1.03 from CPAN
git-cpan-module: LWP::UserAgent::Determined
git-cpan-version: 1.03
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..a109cf0
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,9 @@
+Revision history for Perl extension LWP::Determined::UserAgent
+ Time-stamp: "2004-04-08 23:10:29 ADT"
+
+
+2004-04-08 Sean M. Burke sburke at cpan.org
+ * Release 1.03 -- just a doc-typo bugfix version.
+
+2004-04-07 Sean M. Burke sburke at cpan.org
+ * Release 1.02 -- First public release.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..13fbd41
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,9 @@
+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)
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..c8c9c48
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,8 @@
+^MANIFEST\.bak$
+^[-_a-zA-Z0-9]+[0-9]+\.[0-9]+(?:_[0-9]+)?$
+Makefile(\.old)?$
+t/.*.rtf$
+\.rej$
+CVS
+blib
+~
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..087a2a5
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: LWP-UserAgent-Determined
+version: 1.03
+version_from: lib/LWP/UserAgent/Determined.pm
+installdirs: site
+requires:
+ LWP: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..3a86a4d
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,32 @@
+
+# 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__
diff --git a/README b/README
new file mode 100644
index 0000000..9a57bc1
--- /dev/null
+++ b/README
@@ -0,0 +1,84 @@
+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 at cpan.org
+
+
+AVAILABILITY
+
+The latest version of this modules is available from the Comprehensive
+Perl Archive Network (CPAN). Visit <http://www.perl.com/CPAN/> to
+find a CPAN site near you.
+
+
+COPYRIGHT
+
+Copyright 2004, Sean M. Burke <sburke at cpan.org>, 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 <sburke at cpan.org>
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
new file mode 100644
index 0000000..18ac25d
--- /dev/null
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -0,0 +1,243 @@
+
+package LWP::UserAgent::Determined;
+# Time-stamp: "2004-04-08 23:10:07 ADT" POD is at the end.
+$VERSION = '1.03';
+use LWP::UserAgent ();
+ at ISA = ('LWP::UserAgent');
+
+use strict;
+use LWP::Debug ();
+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) = @_;
+ LWP::Debug::trace('simple_request()');
+ my(@timing_tries) = ( $self->timing() =~ m<(\d+(?:\.\d+)*)>g );
+ my $determination = $self->codes_to_determinate();
+ LWP::Debug::debug("My retrial code policy is ["
+ . join(' ', sort keys %$determination) . "].");
+ LWP::Debug::debug("My retrial timing policy is [@timing_tries].");
+
+ my $resp;
+ my $before_c = $self->before_determined_callback;
+ my $after_c = $self->after_determined_callback;
+ foreach my $pause_if_unsuccessful (@timing_tries, undef) {
+ LWP::Debug::debug("Trying simple_request with args: ["
+ . join(',', map $_||"''", @args) . "]");
+
+ $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;
+ my $message = $resp->message;
+ $message =~ s/\s+$//s;
+ unless( $determination->{$code} ) { # normal case: all is well (or 404, etc)
+ LWP::Debug::debug("It returned a code ($code $message) blocking a retry");
+ return $resp;
+ }
+ if(defined $pause_if_unsuccessful) { # it's undef only on the last
+
+ LWP::Debug::debug("It returned a code ($code $message) that'll make me retry, after $pause_if_unsuccessful seconds.");
+ sleep $pause_if_unsuccessful if $pause_if_unsuccessful;
+ } else {
+ LWP::Debug::debug("I give up. I'm returning this \"$code $message\" response.");
+ }
+ }
+
+ 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<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.
+
+=head1 METHODS
+
+This module inherits all of L<LWP::UserAgent>'s methods,
+and adds the following.
+
+=over
+
+=item $timing_string = $browser->timing();
+
+=item $browser->timing( "10,30,90" )
+
+The C<timing> 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<request>
+or C<simple_request>)
+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 I<re>try as that many times (i.e., one
+initial try, I<plus> 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<simple_request> method
+with its own around-method that just loops. See the source of this
+module; it's straightforward. Relatively.
+
+
+=head1 SEE ALSO
+
+L<LWP>, L<LWP::UserAgent>
+
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+Copyright 2004, Sean M. Burke C<sburke at cpan.org>, 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
+
+Sean M. Burke, C<sburke at cpan.org>
+
+=cut
+
diff --git a/t/01_about_verbose.t b/t/01_about_verbose.t
new file mode 100644
index 0000000..ab37215
--- /dev/null
+++ b/t/01_about_verbose.t
@@ -0,0 +1,89 @@
+
+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;
+
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
new file mode 100644
index 0000000..e65c214
--- /dev/null
+++ b/t/10_determined_test.t
@@ -0,0 +1,87 @@
+
+# Time-stamp: "0";
+use strict;
+use Test;
+BEGIN { plan tests => 11 }
+
+#use LWP::Debug ('+');
+
+use LWP::UserAgent::Determined;
+my $browser = LWP::UserAgent::Determined->new;
+
+#$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 $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), ".\n";
+ ++$after_count;
+});
+
+my $resp = $browser->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 );
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+$url = "http://www.aoeaoeaoeaoe.int:9876/sntstn";
+$before_count = 0;
+ $after_count = 0;
+
+print "# Trying a nonexistent address, $url\n";
+
+$resp = $browser->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;
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+$url = "http://www.interglacial.com/always404alicious/";
+$before_count = 0;
+ $after_count = 0;
+
+print "# Trying a nonexistent address, $url\n";
+
+$resp = $browser->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;
+
commit 9c33d5b66a6fd03a545f4edf132b4754bf409225
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sat Apr 4 15:31:53 2009 -0400
1.04
diff --git a/ChangeLog b/ChangeLog
index a109cf0..4d13d7f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
Revision history for Perl extension LWP::Determined::UserAgent
- Time-stamp: "2004-04-08 23:10:29 ADT"
+
+2009-04-04 Jesse Vincent <jesse at cpan.org>
+ * Release 1.04 -- Keeping pace with LWP updates
+ * New Maintainer
+ * Resolves [cpan #42123] and [cpan #41508]
2004-04-08 Sean M. Burke sburke at cpan.org
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index 18ac25d..baa88be 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -1,12 +1,11 @@
package LWP::UserAgent::Determined;
-# Time-stamp: "2004-04-08 23:10:07 ADT" POD is at the end.
-$VERSION = '1.03';
+
+$VERSION = '1.04';
use LWP::UserAgent ();
@ISA = ('LWP::UserAgent');
use strict;
-use LWP::Debug ();
die "Where's _elem?!!?" unless __PACKAGE__->can('_elem');
sub timing { shift->_elem('timing' , @_) }
@@ -18,19 +17,13 @@ sub after_determined_callback { shift->_elem( 'after_determined_callback' , @_)
sub simple_request {
my($self, @args) = @_;
- LWP::Debug::trace('simple_request()');
my(@timing_tries) = ( $self->timing() =~ m<(\d+(?:\.\d+)*)>g );
my $determination = $self->codes_to_determinate();
- LWP::Debug::debug("My retrial code policy is ["
- . join(' ', sort keys %$determination) . "].");
- LWP::Debug::debug("My retrial timing policy is [@timing_tries].");
my $resp;
my $before_c = $self->before_determined_callback;
my $after_c = $self->after_determined_callback;
foreach my $pause_if_unsuccessful (@timing_tries, undef) {
- LWP::Debug::debug("Trying simple_request with args: ["
- . join(',', map $_||"''", @args) . "]");
$before_c and $before_c->(
$self, \@timing_tries, $pause_if_unsuccessful, $determination, \@args);
@@ -42,15 +35,11 @@ sub simple_request {
my $message = $resp->message;
$message =~ s/\s+$//s;
unless( $determination->{$code} ) { # normal case: all is well (or 404, etc)
- LWP::Debug::debug("It returned a code ($code $message) blocking a retry");
return $resp;
}
if(defined $pause_if_unsuccessful) { # it's undef only on the last
- LWP::Debug::debug("It returned a code ($code $message) that'll make me retry, after $pause_if_unsuccessful seconds.");
sleep $pause_if_unsuccessful if $pause_if_unsuccessful;
- } else {
- LWP::Debug::debug("I give up. I'm returning this \"$code $message\" response.");
}
}
commit fba383608a8a8c752767d408e4a97d957a469d1b
Author: Yuki Ibe <yibe at yibe.org>
Date: Sun Dec 5 01:11:12 2010 +0900
fix the default value for 'codes_to_determinate' (rt.cpan.org #55591)
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index baa88be..862073c 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -59,7 +59,7 @@ sub new {
sub _determined_init {
my $self = shift;
$self->timing( '1,3,15' );
- $self->codes_to_determinate( { map $_=>1,
+ $self->codes_to_determinate( { map { $_=>1 }
'408', # Request Timeout
'500', # Internal Server Error
'502', # Bad Gateway
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index e65c214..d7bd7ff 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -2,7 +2,7 @@
# Time-stamp: "0";
use strict;
use Test;
-BEGIN { plan tests => 11 }
+BEGIN { plan tests => 13 }
#use LWP::Debug ('+');
@@ -17,6 +17,10 @@ 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 );
+
my $url = 'http://www.livejournal.com/~torgo_x/rss';
my $before_count = 0;
my $after_count = 0;
commit 3e7b28f116817b023d95f6da2f4943ff0dbf9a4a
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Mon Jan 3 17:02:25 2011 +0800
changelog update
diff --git a/ChangeLog b/ChangeLog
index 4d13d7f..058b9e8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
Revision history for Perl extension LWP::Determined::UserAgent
+2011-01-03 Jesse Vincent <jesse at cpan.org>
+ * Release 1.05
+ * Fix for RT#55591: Incorrect default value for 'codes_to_determinate'
+ from yibe via github.
+
2009-04-04 Jesse Vincent <jesse at cpan.org>
* Release 1.04 -- Keeping pace with LWP updates
* New Maintainer
commit c9f5b7afe86c344ab5b3acc3b9601641c34e9dfa
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Mon Jan 3 17:03:17 2011 +0800
bump to 1.05
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index 862073c..dc91a3d 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -1,7 +1,7 @@
package LWP::UserAgent::Determined;
-$VERSION = '1.04';
+$VERSION = '1.05';
use LWP::UserAgent ();
@ISA = ('LWP::UserAgent');
commit 43c9efaa36703b9e7973314a45aa98a560103ba4
Author: Randy Stauner <randy at magnificent-tears.com>
Date: Fri Nov 4 11:19:05 2011 -0700
Sync diagnostic message
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index d7bd7ff..15d24bc 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -49,7 +49,7 @@ $url = "http://www.aoeaoeaoeaoe.int:9876/sntstn";
$before_count = 0;
$after_count = 0;
-print "# Trying a nonexistent address, $url\n";
+print "# Trying unknown host/port, $url\n";
$resp = $browser->get( $url );
ok 1;
commit 6c5354aa6bda02a24bb8a5f2ace5b8fa0bdf97cd
Author: Randy Stauner <randy at magnificent-tears.com>
Date: Fri Nov 4 11:19:46 2011 -0700
Display time-to-wait in 'just tried' message
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index 15d24bc..8c50857 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -9,6 +9,12 @@ BEGIN { plan tests => 13 }
use LWP::UserAgent::Determined;
my $browser = LWP::UserAgent::Determined->new;
+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;
@@ -30,7 +36,8 @@ $browser->before_determined_callback( sub {
++$before_count;
});
$browser->after_determined_callback( sub {
- print "# \\Just tried ", $_[4][0]->uri, " at ", scalar(localtime), ".\n";
+ print "# \\Just tried ", $_[4][0]->uri, " at ", scalar(localtime),
+ ". Waiting " . (timings)[$after_count] . "s.\n";
++$after_count;
});
commit 2aa8b0e19426ace67e3951cf8511663d4cb494c1
Author: Randy Stauner <randy at magnificent-tears.com>
Date: Fri Nov 4 11:29:57 2011 -0700
Display that we're giving up
instead of displaying "Waiting s."
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index 8c50857..af39ece 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -36,8 +36,8 @@ $browser->before_determined_callback( sub {
++$before_count;
});
$browser->after_determined_callback( sub {
- print "# \\Just tried ", $_[4][0]->uri, " at ", scalar(localtime),
- ". Waiting " . (timings)[$after_count] . "s.\n";
+ print "# \\Just tried ", $_[4][0]->uri, " at ", scalar(localtime), ". ",
+ ($after_count < scalar(timings) ? "Waiting " . (timings)[$after_count] . "s." : "Giving up."), "\n";
++$after_count;
});
commit 2fce08c7d82648087479b80bf0aec33609c44631
Author: Randy Stauner <randy at magnificent-tears.com>
Date: Fri Nov 4 11:37:36 2011 -0700
Mock responses to avoid unnecessary network requests
fixes rt-71491 where network tests sometimes hang indefinitely.
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index af39ece..40e1ff9 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -9,6 +9,16 @@ BEGIN { plan tests => 13 }
use LWP::UserAgent::Determined;
my $browser = LWP::UserAgent::Determined->new;
+use HTTP::Headers;
+use HTTP::Request;
+
+sub set_response {
+ my ($code) = @_;
+ $browser->set_my_handler(request_send => @_ ? sub {
+ return HTTP::Response->new($code, undef, HTTP::Headers->new(), 'n/a');
+ } : ());
+}
+
sub timings {
my $self = $browser;
# copied from module, line 20
@@ -27,6 +37,10 @@ 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;
@@ -52,6 +66,8 @@ ok( $after_count > 1 );
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+set_response(500);
+
$url = "http://www.aoeaoeaoeaoe.int:9876/sntstn";
$before_count = 0;
$after_count = 0;
@@ -73,6 +89,8 @@ ok $after_count, 4;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+set_response(404);
+
$url = "http://www.interglacial.com/always404alicious/";
$before_count = 0;
$after_count = 0;
commit 8e43bcce5e49f6aec4db03ec185288e2de53b911
Author: Randy Stauner <randy at magnificent-tears.com>
Date: Fri Nov 4 11:49:19 2011 -0700
Make tests compatible with older versions of LWP
* redefine LWP::UserAgent::simple_request if handlers are not available
* use ->request(GET $url) instead of the shortcut ->get($url)
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index 40e1ff9..17812ce 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -11,12 +11,21 @@ my $browser = LWP::UserAgent::Determined->new;
use HTTP::Headers;
use HTTP::Request;
+use HTTP::Request::Common qw( GET );
sub set_response {
my ($code) = @_;
- $browser->set_my_handler(request_send => @_ ? sub {
+ 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 {
@@ -55,7 +64,7 @@ $browser->after_determined_callback( sub {
++$after_count;
});
-my $resp = $browser->get( $url );
+my $resp = $browser->request( GET $url );
ok 1;
print "# That gave: ", $resp->status_line, "\n";
@@ -74,7 +83,7 @@ $before_count = 0;
print "# Trying unknown host/port, $url\n";
-$resp = $browser->get( $url );
+$resp = $browser->request( GET $url );
ok 1;
$browser->timing('1,2,3');
@@ -97,7 +106,7 @@ $before_count = 0;
print "# Trying a nonexistent address, $url\n";
-$resp = $browser->get( $url );
+$resp = $browser->request( GET $url );
ok 1;
$browser->timing('1,2,3');
commit 789db00547cb3190e7a2ee936a9f9778a25c517f
Merge: c9f5b7a 8e43bcc
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sun May 20 17:17:43 2012 -0700
Merge pull request #4 from rwstauner/mock-tests
Mock http responses to avoid unnecessary network requests
commit e46986de8d347ba98220993088a891d5529a19fa
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sun May 20 19:36:06 2012 -0400
make it less likely that people will bother TorgoX
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index dc91a3d..03330d0 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -215,7 +215,7 @@ L<LWP>, L<LWP::UserAgent>
=head1 COPYRIGHT AND DISCLAIMER
-Copyright 2004, Sean M. Burke C<sburke at cpan.org>, all rights
+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.
@@ -226,7 +226,9 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Sean M. Burke, C<sburke at cpan.org>
+Originally created by Sean M. Burke, C<sburke at cpan.org>
+
+Currently maintained by Jesse Vincent C<jesse at fsck.com>
=cut
commit 547fad1448ad3a201d3bcddf1f268827f8c780ee
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sun May 20 20:38:35 2012 -0400
remove a link to interglacial which no longer exists
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index 03330d0..ae79321 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -32,8 +32,6 @@ sub simple_request {
$self, \@timing_tries, $pause_if_unsuccessful, $determination, \@args, $resp);
my $code = $resp->code;
- my $message = $resp->message;
- $message =~ s/\s+$//s;
unless( $determination->{$code} ) { # normal case: all is well (or 404, etc)
return $resp;
}
diff --git a/t/10_determined_test.t b/t/10_determined_test.t
index 17812ce..296d59e 100644
--- a/t/10_determined_test.t
+++ b/t/10_determined_test.t
@@ -100,7 +100,7 @@ ok $after_count, 4;
set_response(404);
-$url = "http://www.interglacial.com/always404alicious/";
+$url = "http://www.google.com/should-always-return-a-404";
$before_count = 0;
$after_count = 0;
commit 24198ca1a9dc0d95e4a492bdfe7b7b506619eb21
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sun May 20 20:41:50 2012 -0400
changelog for 1.06
diff --git a/ChangeLog b/ChangeLog
index 058b9e8..4a20433 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
Revision history for Perl extension LWP::Determined::UserAgent
+2012.05-20 Jesse Vincent <jesse at cpan.org>
+ * Release 1.06
+ * Mock http responses to avoid unnecessary network requests -- Randy Stauner
+
2011-01-03 Jesse Vincent <jesse at cpan.org>
* Release 1.05
* Fix for RT#55591: Incorrect default value for 'codes_to_determinate'
commit de4b3cfb664c93a54056b3c004dc81bedf9ef4d0
Author: Jesse Vincent <jesse at bestpractical.com>
Date: Sun May 20 20:42:54 2012 -0400
1.06
diff --git a/lib/LWP/UserAgent/Determined.pm b/lib/LWP/UserAgent/Determined.pm
index ae79321..1bee07d 100644
--- a/lib/LWP/UserAgent/Determined.pm
+++ b/lib/LWP/UserAgent/Determined.pm
@@ -1,7 +1,7 @@
package LWP::UserAgent::Determined;
-$VERSION = '1.05';
+$VERSION = '1.06';
use LWP::UserAgent ();
@ISA = ('LWP::UserAgent');
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list