Mailinglist Archive: opensuse-commit (1116 mails)
| < Previous | Next > |
commit perl-libwww-perl for openSUSE:Factory
- From: root@xxxxxxxxxxxxxxx (h_root)
- Date: Mon, 23 Feb 2009 23:58:02 +0100
- Message-id: <20090223225802.B33D2678157@xxxxxxxxxxxxxxx>
Hello community,
here is the log from the commit of package perl-libwww-perl for openSUSE:Factory
checked in at Mon Feb 23 23:58:02 CET 2009.
--------
--- perl-libwww-perl/perl-libwww-perl.changes 2009-01-20 16:53:42.000000000
+0100
+++ perl-libwww-perl/perl-libwww-perl.changes 2009-02-23 16:19:58.000000000
+0100
@@ -1,0 +2,17 @@
+Mon Feb 23 16:18:38 CET 2009 - anicka@xxxxxxx
+
+- update to 5.825
+ * Fixup test failure with perl-5.8.8 and older; qr/$/m doesn't work
+ * Make format_request() ensure that it returns bytes [RT#42396]
+ * Force bytes in all the format_* methods.
+ * Ignore Sitemap: lines in robots.txt [RT#42420]
+ * Refactor; use variable to hold the test port
+ * Add redirects method to HTTP::Message
+ * Setting $ua->max_redirect(0) didn't work [RT#40260]
+ * Convert files to UTF-8
+ * HTTP::Cookies destructor should not clobber $! and other globals.
+ * Deal with the Encode module distributed with perl-5.8.0
+ * Avoid failure if 127.0.0.1:8333 is in use [RT#42866]
+ * Documentation improvements, spelling fixes.
+
+-------------------------------------------------------------------
calling whatdependson for head-i586
Old:
----
libwww-perl-5.823.tar.bz2
New:
----
libwww-perl-5.825.tar.bz2
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-libwww-perl.spec ++++++
--- /var/tmp/diff_new_pack.F31552/_old 2009-02-23 23:51:04.000000000 +0100
+++ /var/tmp/diff_new_pack.F31552/_new 2009-02-23 23:51:04.000000000 +0100
@@ -1,5 +1,5 @@
#
-# spec file for package perl-libwww-perl (Version 5.823)
+# spec file for package perl-libwww-perl (Version 5.825)
#
# Copyright (c) 2009 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
@@ -20,7 +20,7 @@
Name: perl-libwww-perl
BuildRequires: perl-Compress-Zlib perl-HTML-Parser perl-URI
-Version: 5.823
+Version: 5.825
Release: 1
Provides: libwww-perl
Provides: perl_lw3
@@ -63,7 +63,6 @@
make test
%install
-rm -rf $RPM_BUILD_ROOT
%perl_make_install
%perl_process_packlist
@@ -89,6 +88,20 @@
/var/adm/perl-modules/%{name}
%changelog
+* Mon Feb 23 2009 anicka@xxxxxxx
+- update to 5.825
+ * Fixup test failure with perl-5.8.8 and older; qr/$/m doesn't work
+ * Make format_request() ensure that it returns bytes [RT#42396]
+ * Force bytes in all the format_* methods.
+ * Ignore Sitemap: lines in robots.txt [RT#42420]
+ * Refactor; use variable to hold the test port
+ * Add redirects method to HTTP::Message
+ * Setting $ua->max_redirect(0) didn't work [RT#40260]
+ * Convert files to UTF-8
+ * HTTP::Cookies destructor should not clobber $! and other globals.
+ * Deal with the Encode module distributed with perl-5.8.0
+ * Avoid failure if 127.0.0.1:8333 is in use [RT#42866]
+ * Documentation improvements, spelling fixes.
* Tue Jan 20 2009 anicka@xxxxxxx
- update to 5.823
* Bring back the LWP::Debug code
++++++ libwww-perl-5.823.tar.bz2 -> libwww-perl-5.825.tar.bz2 ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/AUTHORS new/libwww-perl-5.825/AUTHORS
--- old/libwww-perl-5.823/AUTHORS 2008-04-04 10:43:22.000000000 +0200
+++ new/libwww-perl-5.825/AUTHORS 2009-02-11 23:36:42.000000000 +0100
@@ -2,8 +2,8 @@
Albert Dvornik <bert@xxxxxxxxxxx>
Alexandre Duret-Lutz <duret_g@xxxxxxxxxxxxx>
Andreas Gustafsson <gson@xxxxxxxxxx>
-Andreas K�nig <andreas.koenig@xxxxxxxx>
-Andreas K�nig <koenig@xxxxxxx>
+Andreas König <andreas.koenig@xxxxxxxx>
+Andreas König <koenig@xxxxxxx>
Andrew Pimlott <andrew@xxxxxxxxxxx>
Andy Lester <andy@xxxxxxxxxxxx>
Ben Coleman <bcoleman@xxxxxxxxxxxxxx>
@@ -73,7 +73,7 @@
Mark D. Anderson <mda@xxxxxxxxxxxxxx>
Marko Asplund <aspa@xxxxxx>
Mark Stosberg <markstos@xxxxxxxx>
-Markus B Kr�ger <markusk@xxxxxxx>
+Markus B Krüger <markusk@xxxxxxx>
Markus Laker <mlaker@xxxxxxxxxxxx>
Martijn Koster <m.koster@xxxxxxxxxxx>
Martin Thurn <mthurn@xxxxxxxxxxxxxxxxxxx>
@@ -113,7 +113,7 @@
Tim Bunce
Tom Hughes <thh@xxxxxxxxxxxxxxxx>
Tony Finch <fanf@xxxxxxxxx>
-Ville Skytt� <ville.skytta@xxxxxx>
+Ville Skyttä <ville.skytta@xxxxxx>
Ward Vandewege <ward@xxxxxxx>
William York <william@xxxxxxxxxxxxx>
Yale Huang <yale@xxxxxxxxxx>
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/bin/lwp-request
new/libwww-perl-5.825/bin/lwp-request
--- old/libwww-perl-5.823/bin/lwp-request 2008-12-05 20:08:38.000000000
+0100
+++ new/libwww-perl-5.825/bin/lwp-request 2009-02-13 14:56:52.000000000
+0100
@@ -180,7 +180,7 @@
$progname =~ s,.*[\\/],,; # use basename only
$progname =~ s/\.\w*$//; # strip extension, if any
-$VERSION = "5.822";
+$VERSION = "5.824";
require LWP;
@@ -421,7 +421,11 @@
}
if ($options{'S'}) {
- printResponseChain($response);
+ for my $r ($response->redirects, $response) {
+ my $method = $r->request->method;
+ my $url = $r->request->url->as_string;
+ print "$method $url --> ", $r->status_line, "\n";
+ }
}
elsif ($options{'s'}) {
print $response->status_line, "\n";
@@ -496,18 +500,6 @@
exit $errors;
-sub printResponseChain
-{
- my($response) = @_;
- return unless defined $response;
- printResponseChain($response->previous);
- my $method = $response->request->method;
- my $url = $response->request->url->as_string;
- my $code = $response->code;
- print "$method $url --> ", $response->status_line, "\n";
-}
-
-
sub usage
{
die <<"EOT";
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/Changes new/libwww-perl-5.825/Changes
--- old/libwww-perl-5.823/Changes 2009-01-12 17:41:08.000000000 +0100
+++ new/libwww-perl-5.825/Changes 2009-02-16 10:55:29.000000000 +0100
@@ -1,4 +1,36 @@
_______________________________________________________________________________
+2009-02-16 Release 5.825
+
+Zefram (1):
+ Fixup test failure with perl-5.8.8 and older; qr/$/m doesn't work
+
+
+
+_______________________________________________________________________________
+2009-02-13 Release 5.824
+
+Gisle Aas (7):
+ Make format_request() ensure that it returns bytes [RT#42396]
+ Force bytes in all the format_* methods.
+ Ignore Sitemap: lines in robots.txt [RT#42420]
+ Refactor; use variable to hold the test port
+ Add redirects method to HTTP::Message
+ Setting $ua->max_redirect(0) didn't work [RT#40260]
+ Convert files to UTF-8
+
+Zefram (2):
+ HTTP::Cookies destructor should not clobber $! and other globals.
+ Deal with the Encode module distributed with perl-5.8.0
+
+Ian Kilgore (1):
+ Avoid failure if 127.0.0.1:8333 is in use [RT#42866]
+
+Ville Skyttä (1):
+ Documentation improvements, spelling fixes.
+
+
+
+_______________________________________________________________________________
2008-12-05 Release 5.823
Gisle Aas (4):
@@ -451,7 +483,7 @@
HTTP::Header::Auth needs HTTP::Headers to be loaded before
it replace its functions.
- LWP::Protocol::nntp improvements by Ville Skytt� <ville.skytta@xxxxxx>:
+ LWP::Protocol::nntp improvements by Ville Skyttä <ville.skytta@xxxxxx>:
- Support the nntp: scheme.
- Support hostname in news: and nntp: URIs.
- Close connection and preserve headers also in non-OK responses.
@@ -574,7 +606,7 @@
patch by Bill Moseley.
WWW::RobotRules: Don't empty cache when agent() is called if the
- agent name does not change. Patch by Ville Skytt� <ville.skytta@xxxxxx>.
+ agent name does not change. Patch by Ville Skyttä <ville.skytta@xxxxxx>.
@@ -620,7 +652,7 @@
are automatically added to requests as they are sent. This
can for instance be used to initialize various Accept headers.
- Various typo fixes by Ville Skytt� <ville.skytta@xxxxxx>.
+ Various typo fixes by Ville Skyttä <ville.skytta@xxxxxx>.
Fixed test failure under perl-5.005.
@@ -643,12 +675,12 @@
RFC 2616 says that http: referer should not be sent with
https: requests. The lwp-rget program, the $req->referer method
and the redirect handling code now try to enforce this.
- Patch by Ville Skytt� <ville.skytta@xxxxxx>.
+ Patch by Ville Skyttä <ville.skytta@xxxxxx>.
WWW::RobotRules now look for the string found in
robots.txt as a case insensitive substring from its own
User-Agent string, not the other way around.
- Patch by Ville Skytt� <ville.skytta@xxxxxx>.
+ Patch by Ville Skyttä <ville.skytta@xxxxxx>.
HTTP::Headers: New method 'header_field_names' that
return a list of names as suggested by its name.
@@ -670,7 +702,7 @@
few bugs discovered during testing.
Typo fixes to the documentation all over the place
- by Ville Skytt� <ville.skytta@xxxxxx>.
+ by Ville Skyttä <ville.skytta@xxxxxx>.
Updated tests.
@@ -707,7 +739,7 @@
Patch by Ward Vandewege <ward@xxxxxxx>.
LWP::UserAgent passed the wrong request to redirect_ok().
- Patch by Ville Skytt� <ville.skytta@xxxxxx>.
+ Patch by Ville Skyttä <ville.skytta@xxxxxx>.
https://rt.cpan.org/Ticket/Display.html?id=5828
LWP did not handle URLs like http://www.example.com?foo=bar
@@ -918,10 +950,10 @@
File::Listing::apache by Slaven Rezic <slaven@xxxxxxxx>
HEAD requests now work properly for ftp: URLs.
- Patch by Ville Skytt� <ville.skytta@xxxxxx>.
+ Patch by Ville Skyttä <ville.skytta@xxxxxx>.
LWP::UserAgent: The protocols_allowed() and protocols_forbidden()
- methods are now case insensitive. Patch by Ville Skytt�
+ methods are now case insensitive. Patch by Ville Skyttä
<ville.skytta@xxxxxx>.
Avoid warning from HTTP::Date on certain invalid dates.
@@ -1588,7 +1620,7 @@
Added cookie example to lwpcook.pod
HTTP::Date::str2time returns undef on failure instead
- of an empty list as suggested by Markus B Kr�ger <markusk@xxxxxxx>
+ of an empty list as suggested by Markus B Krüger <markusk@xxxxxxx>
$request->uri($uri) will now always store a copy of the $uri.
@@ -2440,7 +2472,7 @@
o t/robot/rules-dbm.t clean up better and will use AnyDBM for dumping
- o File::CounterFile: $/ strikes again by Andreas K�nig
+ o File::CounterFile: $/ strikes again by Andreas König
o File::Listing updates from William York <william@xxxxxxxxxxxxx>. We
can now parse the MS-Windows ftp server listings.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/HTTP/Cookies.pm
new/libwww-perl-5.825/lib/HTTP/Cookies.pm
--- old/libwww-perl-5.823/lib/HTTP/Cookies.pm 2008-12-05 20:08:53.000000000
+0100
+++ new/libwww-perl-5.825/lib/HTTP/Cookies.pm 2009-02-13 14:56:48.000000000
+0100
@@ -5,7 +5,7 @@
use HTTP::Headers::Util qw(_split_header_words join_header_words);
use vars qw($VERSION $EPOCH_OFFSET);
-$VERSION = "5.822";
+$VERSION = "5.824";
# Legacy: because "use "HTTP::Cookies" used be the ONLY way
# to load the class HTTP::Cookies::Netscape.
@@ -491,6 +491,7 @@
sub DESTROY
{
my $self = shift;
+ local($., $@, $!, $^E, $?);
$self->save if $self->{'autosave'};
}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/HTTP/Message.pm
new/libwww-perl-5.825/lib/HTTP/Message.pm
--- old/libwww-perl-5.823/lib/HTTP/Message.pm 2008-11-25 21:07:09.000000000
+0100
+++ new/libwww-perl-5.825/lib/HTTP/Message.pm 2009-02-13 14:57:11.000000000
+0100
@@ -2,7 +2,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD);
-$VERSION = "5.821";
+$VERSION = "5.824";
require HTTP::Headers;
require Carp;
@@ -305,6 +305,7 @@
}
$content_ref = \Encode::decode($charset, $$content_ref,
($opt{charset_strict} ? Encode::FB_CROAK() : 0) |
Encode::LEAVE_SRC());
+ die "Encode::decode() returned undef improperly" unless defined
$$content_ref;
}
}
};
@@ -322,7 +323,7 @@
# should match the Content-Encoding values that decoded_content can deal
with
my $self = shift;
my @enc;
- # XXX preferably we should deterine if the modules are available without
loading
+ # XXX preferably we should determine if the modules are available without
loading
# them here
eval {
require Compress::Zlib;
@@ -332,7 +333,8 @@
require Compress::Bzip2;
push(@enc, "x-bzip2");
};
- # we don't care about announcing the 'base64' and 'quoted-printable' stuff
+ # we don't care about announcing the 'identity', 'base64' and
+ # 'quoted-printable' stuff
return wantarray ? @enc : join(", ", @enc);
}
@@ -362,7 +364,7 @@
my $content = $self->content;
for my $encoding (@enc) {
if ($encoding eq "identity") {
- # noting to do
+ # nothing to do
}
elsif ($encoding eq "base64") {
require MIME::Base64;
@@ -789,9 +791,9 @@
=back
-=item $mess->decodeable
+=item $mess->decodable
-=item HTTP::Message::decodeable()
+=item HTTP::Message::decodable()
This returns the encoding identifiers that decoded_content() can
process. In scalar context returns a comma separated string of
@@ -803,7 +805,7 @@
=item $mess->decode
This method tries to replace the content of the message with the
-decoded version and removes the C<Content-Encoding> header. Return
+decoded version and removes the C<Content-Encoding> header. Returns
TRUE if successful and FALSE if not.
If the message does not have a C<Content-Encoding> header this method
@@ -816,8 +818,9 @@
=item $mess->encode( $encoding, ... )
Apply the given encodings to the content of the message. Returns TRUE
-if successful. Currently supported encodings are "gzip", "deflate",
-"x-bzip2" and "base64".
+if successful. The "identity" (non-)encoding is always supported; other
+currently supported encodings, subject to availability of required
+additional modules, are "gzip", "deflate", "x-bzip2" and "base64".
A successful call to this function will set the C<Content-Encoding>
header.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/HTTP/Request/Common.pm
new/libwww-perl-5.825/lib/HTTP/Request/Common.pm
--- old/libwww-perl-5.823/lib/HTTP/Request/Common.pm 2008-12-05
20:12:05.000000000 +0100
+++ new/libwww-perl-5.825/lib/HTTP/Request/Common.pm 2009-02-13
14:57:52.000000000 +0100
@@ -13,7 +13,7 @@
require HTTP::Request;
use Carp();
-$VERSION = "5.822";
+$VERSION = "5.824";
my $CRLF = "\015\012"; # "\r\n" is not portable
@@ -367,7 +367,7 @@
=item DELETE $url, Header => Value,...
-Like GET() but the method in the request is "DELETE". This funciton
+Like GET() but the method in the request is "DELETE". This function
is not exported by default.
=item POST $url
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/HTTP/Response.pm
new/libwww-perl-5.825/lib/HTTP/Response.pm
--- old/libwww-perl-5.823/lib/HTTP/Response.pm 2008-11-25 21:07:09.000000000
+0100
+++ new/libwww-perl-5.825/lib/HTTP/Response.pm 2009-02-13 14:59:30.000000000
+0100
@@ -2,7 +2,7 @@
require HTTP::Message;
@ISA = qw(HTTP::Message);
-$VERSION = "5.820";
+$VERSION = "5.824";
use strict;
use HTTP::Status ();
@@ -96,6 +96,19 @@
}
+sub redirects {
+ my $self = shift;
+ my @r;
+ my $r = $self;
+ while (my $p = $r->previous) {
+ push(@r, $p);
+ $r = $p;
+ }
+ return @r unless wantarray;
+ return reverse @r;
+}
+
+
sub filename
{
my $self = shift;
@@ -432,6 +445,9 @@
chains of responses if the first response is redirect or unauthorized.
The value is C<undef> if this is the first response in a chain.
+Note that the method $r->redirects is provided as a more convenient
+way to access the response chain.
+
=item $r->status_line
Returns the string "E<lt>code> E<lt>message>". If the message attribute
@@ -534,6 +550,14 @@
error occurred. This method should only be called when $r->is_error
is TRUE.
+=item $r->redirects
+
+Returns the list of redirect responses that lead up to this response
+by following the $r->previous chain. The list order is oldest first.
+
+In scalar context return the number of redirect responses leading up
+to this one.
+
=item $r->current_age
Calculates the "current age" of the response as specified by RFC 2616
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/LWP/UserAgent.pm
new/libwww-perl-5.825/lib/LWP/UserAgent.pm
--- old/libwww-perl-5.823/lib/LWP/UserAgent.pm 2009-01-12 17:41:58.000000000
+0100
+++ new/libwww-perl-5.825/lib/LWP/UserAgent.pm 2009-02-13 15:06:39.000000000
+0100
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.823";
+$VERSION = "5.824";
use HTTP::Request ();
use HTTP::Response ();
@@ -261,21 +261,12 @@
my($self, $request, $arg, $size, $previous) = @_;
my $response = $self->simple_request($request, $arg, $size);
+ $response->previous($previous) if $previous;
- if ($previous) {
- $response->previous($previous);
-
- # Check for loop in the redirects, we only count
- my $count = 0;
- my $r = $response;
- while ($r) {
- if (++$count > $self->{max_redirect}) {
- $response->header("Client-Warning" =>
- "Redirect loop detected (max_redirect =
$self->{max_redirect})");
- return $response;
- }
- $r = $r->previous;
- }
+ if ($response->redirects >= $self->{max_redirect}) {
+ $response->header("Client-Warning" =>
+ "Redirect loop detected (max_redirect =
$self->{max_redirect})");
+ return $response;
}
if (my $req = $self->run_handlers("response_redirect", $response)) {
@@ -1664,7 +1655,7 @@
=head1 COPYRIGHT
-Copyright 1995-2008 Gisle Aas.
+Copyright 1995-2009 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/LWP.pm
new/libwww-perl-5.825/lib/LWP.pm
--- old/libwww-perl-5.823/lib/LWP.pm 2009-01-12 17:39:58.000000000 +0100
+++ new/libwww-perl-5.825/lib/LWP.pm 2009-02-16 10:53:11.000000000 +0100
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "5.823";
+$VERSION = "5.825";
sub Version { $VERSION; }
require 5.005;
@@ -599,7 +599,7 @@
=head1 AUTHORS
LWP was made possible by contributions from Adam Newby, Albert
-Dvornik, Alexandre Duret-Lutz, Andreas Gustafsson, Andreas K�nig,
+Dvornik, Alexandre Duret-Lutz, Andreas Gustafsson, Andreas König,
Andrew Pimlott, Andy Lester, Ben Coleman, Benjamin Low, Ben Low, Ben
Tilly, Blair Zajac, Bob Dalgleish, BooK, Brad Hughes, Brian
J. Murrell, Brian McCauley, Charles C. Fu, Charles Lane, Chris Nandor,
@@ -613,7 +613,7 @@
Chamas, Joshua Hoblitt, Kartik Subbarao, Keiichiro Nagano, Ken
Williams, KONISHI Katsuhiro, Lee T Lindley, Liam Quinn, Marc Hedlund,
Marc Langheinrich, Mark D. Anderson, Marko Asplund, Mark Stosberg,
-Markus B Kr�ger, Markus Laker, Martijn Koster, Martin Thurn, Matthew
+Markus B Krüger, Markus Laker, Martijn Koster, Martin Thurn, Matthew
Eldridge, Matthew.van.Eerde, Matt Sergeant, Michael A. Chase, Michael
Quaranta, Michael Thompson, Mike Schilli, Moshe Kaminsky, Nathan
Torkington, Nicolai Langfeldt, Norton Allen, Olly Betts, Paul
@@ -622,7 +622,7 @@
Robin Barker, Roy Fielding, Sander van Zoest, Sean M. Burke,
shildreth, Slaven Rezic, Steve A Fink, Steve Hay, Steven Butler,
Steve_Kilbane, Takanori Ugai, Thomas Lotterer, Tim Bunce, Tom Hughes,
-Tony Finch, Ville Skytt�, Ward Vandewege, William York, Yale Huang,
+Tony Finch, Ville Skyttä, Ward Vandewege, William York, Yale Huang,
and Yitzchak Scott-Thoennes.
LWP owes a lot in motivation, design, and code, to the libwww-perl
@@ -635,7 +635,7 @@
=head1 COPYRIGHT
- Copyright 1995-2008, Gisle Aas
+ Copyright 1995-2009, Gisle Aas
Copyright 1995, Martijn Koster
This library is free software; you can redistribute it and/or
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/Net/HTTP/Methods.pm
new/libwww-perl-5.825/lib/Net/HTTP/Methods.pm
--- old/libwww-perl-5.823/lib/Net/HTTP/Methods.pm 2008-10-20
12:20:08.000000000 +0200
+++ new/libwww-perl-5.825/lib/Net/HTTP/Methods.pm 2009-02-13
14:58:35.000000000 +0100
@@ -5,10 +5,24 @@
use strict;
use vars qw($VERSION);
-$VERSION = "5.815";
+$VERSION = "5.824";
my $CRLF = "\015\012"; # "\r\n" is not portable
+*_bytes = defined(&utf8::downgrade) ?
+ sub {
+ unless (utf8::downgrade($_[0], 1)) {
+ require Carp;
+ Carp::croak("Wide character in HTTP request (bytes required)");
+ }
+ return $_[0];
+ }
+ :
+ sub {
+ return $_[0];
+ };
+
+
sub new {
my $class = shift;
unshift(@_, "Host") if @_ == 1;
@@ -173,7 +187,7 @@
push(@h2, "Host: $h") if $h;
}
- return join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "", $content);
+ return _bytes(join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "",
$content));
}
@@ -185,13 +199,13 @@
sub format_chunk {
my $self = shift;
return $_[0] unless defined($_[0]) && length($_[0]);
- return sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF;
+ return _bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF);
}
sub write_chunk {
my $self = shift;
return 1 unless defined($_[0]) && length($_[0]);
- $self->print(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF);
+ $self->print(_bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF));
}
sub format_chunk_eof {
@@ -200,7 +214,7 @@
while (@_) {
push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2));
}
- return join("", "0$CRLF", @h, $CRLF);
+ return _bytes(join("", "0$CRLF", @h, $CRLF));
}
sub write_chunk_eof {
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lib/WWW/RobotRules.pm
new/libwww-perl-5.825/lib/WWW/RobotRules.pm
--- old/libwww-perl-5.823/lib/WWW/RobotRules.pm 2008-12-05 20:13:16.000000000
+0100
+++ new/libwww-perl-5.825/lib/WWW/RobotRules.pm 2009-02-13 14:58:55.000000000
+0100
@@ -1,6 +1,6 @@
package WWW::RobotRules;
-$VERSION = "5.822";
+$VERSION = "5.824";
sub Version { $VERSION; }
use strict;
@@ -105,6 +105,9 @@
push(@anon_disallowed, $disallow);
}
}
+ elsif (/^\s*Sitemap\s*:/i) {
+ # ignore
+ }
else {
warn "RobotRules <$robot_txt_uri>: Unexpected line: $_\n" if $^W;
}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lwpcook.pod
new/libwww-perl-5.825/lwpcook.pod
--- old/libwww-perl-5.823/lwpcook.pod 2008-04-04 10:43:22.000000000 +0200
+++ new/libwww-perl-5.825/lwpcook.pod 2009-01-19 09:43:05.000000000 +0100
@@ -244,7 +244,7 @@
perl -MLWP::Simple -e 'mirror("http://www.perl.com/";, "perl.html")';
-The document will not be transfered unless it has been updated.
+The document will not be transferred unless it has been updated.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/lwptut.pod
new/libwww-perl-5.825/lwptut.pod
--- old/libwww-perl-5.823/lwptut.pod 2008-04-04 10:43:22.000000000 +0200
+++ new/libwww-perl-5.825/lwptut.pod 2009-01-19 09:43:05.000000000 +0100
@@ -49,7 +49,7 @@
% perl -MLWP::Simple -e "getprint 'http://cpan.org/RECENT'"
-That is the URL of a plaintext file that lists new files in CPAN in
+That is the URL of a plain text file that lists new files in CPAN in
the past two weeks. You can easily make it part of a tidy little
shell command, like this one that mails you the list of new
C<Acme::> modules:
@@ -155,8 +155,8 @@
=item *
And dozens of other convenient and more specific methods that are
-documented in the docs for L<HTML::Response>, and its superclasses
-L<HTML::Message> and L<HTML::Headers>.
+documented in the docs for L<HTTP::Response>, and its superclasses
+L<HTTP::Message> and L<HTTP::Headers>.
=back
@@ -309,7 +309,7 @@
die "$url error: ", $response->status_line
unless $response->is_success;
die "Weird content type at $url -- ", $response->content_type
- unless $response->content_type eq 'text/html';
+ unless $response->content_is_html;
if( $response->decoded_content =~ m{AltaVista found ([0-9,]+) results} ) {
# The substring will be like "AltaVista found 2,345 results"
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/Makefile.PL
new/libwww-perl-5.825/Makefile.PL
--- old/libwww-perl-5.823/Makefile.PL 2008-11-25 21:07:09.000000000 +0100
+++ new/libwww-perl-5.825/Makefile.PL 2009-02-13 14:42:11.000000000 +0100
@@ -59,6 +59,14 @@
},
clean => { FILES => join(" ", map "bin/$_", grep /^[A-Z]+$/, @prog) },
);
+
+if($] >= 5.008 && !(eval { require Encode; defined(Encode::decode("UTF-8",
"\xff")) })) {
+ warn "\nYou lack a working Encode module, and so you will miss out on\n".
+ "lots of character set goodness from LWP. However, your perl is\n".
+ "sufficiently recent to support it. It is recommended that you\n".
+ "install the latest Encode from CPAN.\n\n";
+}
+
exit;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/MANIFEST
new/libwww-perl-5.825/MANIFEST
--- old/libwww-perl-5.823/MANIFEST 2009-01-12 17:45:18.000000000 +0100
+++ new/libwww-perl-5.825/MANIFEST 2009-02-16 10:56:22.000000000 +0100
@@ -106,7 +106,6 @@
t/local/autoload.t Test autoloading of LWP::Protocol modules
t/local/chunked.t
t/local/get.t Try to get a local file
-t/local/http-get.t
t/local/http.t Test http to local server
t/local/protosub.t Test with other protocol module
t/net/cgi-bin/moved
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/META.yml
new/libwww-perl-5.825/META.yml
--- old/libwww-perl-5.823/META.yml 2009-01-12 17:45:18.000000000 +0100
+++ new/libwww-perl-5.825/META.yml 2009-02-16 10:56:22.000000000 +0100
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 5.823
+version: 5.825
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas <gisle@xxxxxxxxxxxxxxx>
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/README new/libwww-perl-5.825/README
--- old/libwww-perl-5.823/README 2008-09-24 11:41:59.000000000 +0200
+++ new/libwww-perl-5.825/README 2009-02-13 15:05:31.000000000 +0100
@@ -84,8 +84,8 @@
COPYRIGHT
- � 1995-2008 Gisle Aas. All rights reserved.
- � 1995 Martijn Koster. All rights reserved.
+ © 1995-2009 Gisle Aas. All rights reserved.
+ © 1995 Martijn Koster. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/base/message.t
new/libwww-perl-5.825/t/base/message.t
--- old/libwww-perl-5.823/t/base/message.t 2008-11-25 21:07:09.000000000
+0100
+++ new/libwww-perl-5.825/t/base/message.t 2009-02-13 14:42:12.000000000
+0100
@@ -383,8 +383,10 @@
$m->remove_header("Content-Encoding");
$m->content("a\xFF");
-skip($NO_ENCODE, sub { $m->decoded_content }, "a\x{FFFD}");
-skip($NO_ENCODE, sub { $m->decoded_content(charset_strict => 1) }, undef);
+my $BAD_ENCODE = $NO_ENCODE || !(eval { require Encode;
defined(Encode::decode("UTF-8", "\xff")) });
+
+skip($BAD_ENCODE, sub { $m->decoded_content }, "a\x{FFFD}");
+skip($BAD_ENCODE, sub { $m->decoded_content(charset_strict => 1) }, undef);
$m->header("Content-Encoding", "foobar");
ok($m->decoded_content, undef);
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/base/response.t
new/libwww-perl-5.825/t/base/response.t
--- old/libwww-perl-5.823/t/base/response.t 2008-11-25 21:07:09.000000000
+0100
+++ new/libwww-perl-5.825/t/base/response.t 2009-02-11 11:09:35.000000000
+0100
@@ -5,7 +5,7 @@
use strict;
use Test;
-plan tests => 13;
+plan tests => 19;
use HTTP::Date;
use HTTP::Request;
@@ -81,3 +81,14 @@
ok($r->fresh_until); # should still return something
ok($r->fresh_until(heuristic_expiry => 0), undef);
+
+ok($r->redirects, 0);
+$r->previous($r2);
+ok($r->previous, $r2);
+ok($r->redirects, 1);
+
+$r2->previous($r->clone);
+ok($r->redirects, 2);
+for ($r->redirects) {
+ ok($_->is_success);
+}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/local/autoload.t
new/libwww-perl-5.825/t/local/autoload.t
--- old/libwww-perl-5.823/t/local/autoload.t 2008-04-04 10:43:22.000000000
+0200
+++ new/libwww-perl-5.825/t/local/autoload.t 2009-02-11 10:29:22.000000000
+0100
@@ -2,7 +2,8 @@
# See if autoloading of protocol schemes work
#
-print "1..1\n";
+use Test;
+plan tests => 1;
require LWP::UserAgent;
# note no LWP::Protocol::file;
@@ -18,11 +19,4 @@
my $request = HTTP::Request->new(GET => $url);
my $response = $ua->request($request);
-if ($response->is_success) {
- print "ok 1\n";
- print $response->as_string;
-}
-else {
- print "not ok 1\n";
- print $response->error_as_HTML;
-}
+ok($response->is_success);
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/local/chunked.t
new/libwww-perl-5.825/t/local/chunked.t
--- old/libwww-perl-5.823/t/local/chunked.t 2008-11-25 21:07:09.000000000
+0100
+++ new/libwww-perl-5.825/t/local/chunked.t 2009-01-29 13:49:25.000000000
+0100
@@ -93,11 +93,20 @@
$Config{useithreads} and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
my $tests = @TESTS;
+my $tport = 8333;
+my $tsock = IO::Socket::INET->new(LocalAddr => '0.0.0.0',
+ LocalPort => $tport,
+ Listen => 1,
+ ReuseAddr => 1);
if (!$can_fork) {
plan skip_all => "This system cannot fork";
}
+elsif (!$tsock) {
+ plan skip_all => "Cannot listen on 0.0.0.0:$tport";
+}
else {
+ close $tsock;
plan tests => $tests;
}
@@ -120,13 +129,13 @@
my $raw = $test->{raw};
$raw =~ s/\r?\n/$CRLF/mg;
if (0) {
- open my $fh, "| socket localhost 8333" or die;
+ open my $fh, "| socket localhost $tport" or die;
print $fh $test;
}
use IO::Socket::INET;
my $sock = IO::Socket::INET->new(
PeerAddr => "127.0.0.1",
- PeerPort => 8333,
+ PeerPort => $tport,
) or die;
if (0) {
for my $pos (0..length($raw)-1) {
@@ -150,7 +159,7 @@
die "cannot fork: $!" unless defined $pid;
my $d = HTTP::Daemon->new(
LocalAddr => '0.0.0.0',
- LocalPort => 8333,
+ LocalPort => $tport,
ReuseAddr => 1,
) or die;
mywarn "Starting new daemon as '$$'";
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/local/http-get.t
new/libwww-perl-5.825/t/local/http-get.t
--- old/libwww-perl-5.823/t/local/http-get.t 2008-09-24 13:19:36.000000000
+0200
+++ new/libwww-perl-5.825/t/local/http-get.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,422 +0,0 @@
-if ($^O eq "MacOS") {
- print "1..0\n";
- exit(0);
-}
-
-unless (-f "CAN_TALK_TO_OURSELF") {
- print "1..0 # Skipped: Can't talk to ourself (misconfigured system)\n";
- exit;
-}
-
-# Hm, this should really use Test.pm, but not worth changing over, really.
-
-
-$| = 1; # autoflush
-
-require IO::Socket; # make sure this work before we try to make a HTTP::Daemon
-
-# First we make ourself a daemon in another process
-my $D = shift || '';
-if ($D eq 'daemon') {
-
- require HTTP::Daemon;
-
- my $d = HTTP::Daemon->new(Timeout => 10);
-
- print "Please to meet you at: <URL:", $d->url, ">\n";
- open(STDOUT, $^O eq 'VMS'? ">nl: " : ">/dev/null");
-
- while ($c = $d->accept) {
- $r = $c->get_request;
- if ($r) {
- my $p = ($r->url->path_segments)[1];
- my $func = lc("httpd_" . $r->method . "_$p");
- if (defined &$func) {
- &$func($c, $r);
- }
- else {
- $c->send_error(404);
- }
- }
- $c = undef; # close connection
- }
- print STDERR "HTTP Server terminated\n";
- exit;
-}
-else {
- use Config;
- my $perl = $Config{'perlpath'};
- $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i;
- open(DAEMON, "$perl local/http-get.t daemon |") or die "Can't exec daemon:
$!";
-}
-
-print "1..21\n";
-
-
-my $greeting = <DAEMON>;
-$greeting =~ /(<[^>]+>)/;
-
-require URI;
-my $base = URI->new($1);
-sub url {
- my $u = URI->new(@_);
- $u = $u->abs($_[1]) if @_ > 1;
- $u->as_string;
-}
-
-print "# Will access HTTP server at $base\n";
-
-require LWP::UserAgent;
-require HTTP::Request;
-$ua = new LWP::UserAgent;
-$ua->agent("Mozilla/0.01 " . $ua->agent);
-$ua->from('gisle@xxxxxx');
-$ua->cookie_jar({});
-
-#----------------------------------------------------------------
-print "#------------Testing: Bad request...\n";
-$res = $ua->get(
- url("/not_found", $base),
- 'X-Foo' => "Bar",
-);
-
-print "not " unless $res->is_error
- and $res->code == 404
- and $res->message =~ /not\s+found/i;
-print "ok 1\n";
-# we also expect a few headers
-print "not " if !$res->server and !$res->date;
-print "ok 2\n";
-
-#----------------------------------------------------------------
-print "#------------Testing: Simple echo...\n";
-sub httpd_get_echo
-{
- my($c, $req) = @_;
- $c->send_basic_header(200);
- print $c "Content-Type: text/plain\015\012";
- $c->send_crlf;
- print $c $req->as_string;
-}
-
-$res = $ua->get(
- url("/echo/path_info?query", $base),
- Accept => 'text/html',
- Accept => 'text/plain; q=0.9',
- Accept => 'image/*',
- Long_text => 'This is a very long header line
-which is broken between
-more than one line.',
- X_Foo => "Bar",
-
-);
-#print $res->as_string;
-
-print "not " unless $res->is_success
- and $res->code == 200 && $res->message eq "OK";
-print "ok 3\n";
-
-$_ = $res->content;
-@accept = /^Accept:\s*(.*)/mg;
-
-#print "$_\n";
-
-print "not " unless /^From:\s*gisle\@aas\.no$/m
- and /^Host:/m
- and @accept == 3
- and /^Accept:\s*text\/html/m
- and /^Accept:\s*text\/plain/m
- and /^Accept:\s*image\/\*/m
- and /^Long-Text:\s*This.*broken between/m
- and /^X-Foo:\s*Bar$/m
- and /^User-Agent:\s*Mozilla\/0.01/m;
-print "ok 4\n";
-
-#----------------------------------------------------------------
-print "#------------Testing: Send file...\n";
-
-my $file = "test-$$.html";
-sub _write_file {
- open(FILE, ">$file") or die "Can't create $file: $!";
- binmode FILE or die "Can't binmode $file: $!";
- print FILE <<EOT;
-<html><title>En pr�ve</title>
-<h1>Dette er en testfil</h1>
-Jeg vet ikke hvor stor fila beh�ver � v�re heller, men dette
-er sikkert nok i massevis.
-EOT
- close(FILE);
- print "# ", -s $file, " bytes written to $file\n";
- return;
-}
-
-sub httpd_get_file
-{
- my($c, $r) = @_;
- my %form = $r->url->query_form;
- my $file = $form{'name'};
- $c->send_file_response($file);
-}
-
-_write_file();
-
-$res = $ua->get( url("/file?name=$file", $base) );
-
-#print $res->as_string;
-
-print "not " unless $res->is_success
- and $res->content_type eq 'text/html'
- and $res->content_length == 147
- and $res->title eq 'En pr�ve'
- and $res->content =~ /� v�re/;
-print "ok 5\n";
-
-
-
-{
-
-my $content;
-
-$res = $ua->get( url("/file?name=$file", $base),
- ':content_cb' => sub { $content .= $_[0]; return; },
-);
-#print $res->as_string;
-
-print "not " unless $res->is_success
- and $res->content_type eq 'text/html'
- and $res->content_length == 147
- and defined $content
- and $res->title eq 'En pr�ve'
- and ! $res->content # No content, because callback
- and $content =~ /� v�re/;
-print "ok 6\n";
-
-}
-
-unlink($file);
-
-
-
-# Then try to list current directory
-$res = $ua->get( url("/file?name=.", $base) );
-#print $res->as_string;
-print "not " unless $res->code == 501; # NYI
-print "ok 7\n";
-
-
-#----------------------------------------------------------------
-print "#------------Testing: Check redirect...\n";
-sub httpd_get_redirect
-{
- my($c) = @_;
- $c->send_redirect("/echo/redirect");
-}
-
-$res = $ua->get( url("/redirect/foo", $base) );
-#print $res->as_string;
-
-print "not " unless $res->is_success
- and $res->content =~ m|/echo/redirect|;
-print "ok 8\n";
-print "not " unless $res->previous->is_redirect
- and $res->previous->code == 301;
-print "ok 9\n";
-
-# Let's test a redirect loop too
-sub httpd_get_redirect2 { shift->send_redirect("/redirect3/") }
-sub httpd_get_redirect3 { shift->send_redirect("/redirect2/") }
-
-$res = $ua->get(url("/redirect2", $base));
-#print $res->as_string;
-print "not " unless $res->is_redirect
- and $res->header("Client-Warning") =~ /loop detected/i;
-print "ok 10\n";
-$i = 0;
-while ($res->previous) {
- $i++;
- $res = $res->previous;
-}
-print "not " unless $i == 7;
-print "ok 11\n";
-
-sub httpd_get_redirect_file { shift->send_redirect("file:/etc/passwd") }
-$res = $ua->get(url("/redirect_file/", $base));
-#print $res->as_string;
-print "not " unless $res->is_redirect
- and $res->header("Client-Warning") =~ /can't redirect to a
file:/i;
-print "ok 12\n";
-
-
-#----------------------------------------------------------------
-print "#------------Testing: Check basic authorization...\n";
-sub httpd_get_basic
-{
- my($c, $r) = @_;
- #print STDERR $r->as_string;
- my($u,$p) = $r->authorization_basic;
- if (defined($u) && $u eq 'ok 13' && $p eq 'xyzzy') {
- $c->send_basic_header(200);
- print $c "Content-Type: text/plain";
- $c->send_crlf;
- $c->send_crlf;
- $c->print("$u\n");
- }
- else {
- $c->send_basic_header(401);
- $c->print("WWW-Authenticate: Basic realm=\"libwww-perl\"\015\012");
- $c->send_crlf;
- }
-}
-
-{
- package MyUA; @ISA=qw(LWP::UserAgent);
- sub get_basic_credentials {
- my($self, $realm, $uri, $proxy) = @_;
- if ($realm eq "libwww-perl" && $uri->rel($base) eq "basic") {
- return ("ok 13", "xyzzy");
- }
- else {
- return undef;
- }
- }
-}
-
-{
-my $that_url = url("/basic", $base);
-
-$res = MyUA->new->get( $that_url );
-#print $res->as_string;
-
-my $host_port = $res->request->uri->host_port;
-
-print "not " unless $res->is_success;
-print $res->content;
-
-# Let's try with a $ua that does not pass out credentials
-$res = $ua->get( $that_url );
-print "not " unless $res->code == 401;
-print "ok 14\n";
-
-
-print "# Host port: $host_port\n";
-
-# Let's try to set credentials for this realm
-$ua->credentials($host_port, "libwww-perl", "ok 13", "xyzzy");
-
-$res = $ua->get( $that_url );
-
-print "not " unless $res->is_success;
-print "ok 15\n";
-
-# Then illegal credentials
-$ua->credentials($host_port, "libwww-perl", "user", "passwd");
-$res = $ua->get( $that_url );
-print "not " unless $res->code == 401;
-print "ok 16\n";
-}
-
-#----------------------------------------------------------------
-print "#------------Testing: Check proxy...\n";
-sub httpd_get_proxy
-{
- my($c,$r) = @_;
- if ($r->method eq "GET" and
- $r->url->scheme eq "ftp") {
- $c->send_basic_header(200);
- $c->send_crlf;
- }
- else {
- $c->send_error;
- }
-}
-
-$ua->proxy(ftp => $base);
-
-$res = $ua->get( "ftp://ftp.perl.com/proxy"; );
-#print $res->as_string;
-print "not " unless $res->is_success;
-print "ok 17\n";
-
-#----------------------------------------------------------------
-print "#------------Testing: Check POSTing...\n";
-sub httpd_post_echo
-{
- my($c,$r) = @_;
- $c->send_basic_header;
- $c->print("Content-Type: text/plain");
- $c->send_crlf;
- $c->send_crlf;
- $c->print($r->as_string);
-}
-
-$res = $ua->post(
- url("/echo/foo", $base),
- ['foo' => 'bar', 'bar' => 'test'],
-);
-#print $res->as_string;
-
-$_ = $res->content;
-print "not " unless $res->is_success
- and /^Content-Length:\s*16$/mi
- and /^Content-Type:\s*application\/x-www-form-urlencoded$/mi
- and /^foo=bar&bar=test/m;
-print "ok 18\n";
-
-
-{
-
-my $content;
-
-$res = $ua->post(
- url("/echo/foo", $base),
- ['foo' => 'bar', 'bar' => 'test'],
- ':content_cb' => sub { $content .= $_[0]; return; },
-);
-
-$_ = $content;
-print "not " unless $res->is_success
- and /^Content-Length:\s*16$/mi
- and /^Content-Type:\s*application\/x-www-form-urlencoded$/mi
- and /^foo=bar&bar=test/m
- and ! $res->content
-;
-print "ok 19\n";
-
-}
-
-{
-
-my $content;
-
-$res = $ua->post(
- url("/echo/foo", $base),
- Content_Type => 'text/plain',
- Content => "Plain Text",
- ':content_cb' => sub { $content .= $_[0]; return; },
-);
-
-$_ = $content;
-print "not " unless $res->is_success
- and /^Content-Length:\s*10$/mi
- and /^Content-Type:\s*text\/plain$/mi
- and /^Plain Text$/m
- and ! $res->content
-;
-print "ok 20\n";
-
-}
-
-#----------------------------------------------------------------
-print "#------------Testing: Terminating server...\n";
-sub httpd_get_quit
-{
- my($c) = @_;
- $c->send_error(503, "Bye, bye");
- exit; # terminate HTTP server
-}
-
-$res = $ua->get( url("/quit", $base) );
-
-print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/;
-print "ok 21\n";
-
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/local/http.t
new/libwww-perl-5.825/t/local/http.t
--- old/libwww-perl-5.823/t/local/http.t 2008-04-04 10:43:22.000000000
+0200
+++ new/libwww-perl-5.825/t/local/http.t 2009-02-16 09:06:54.000000000
+0100
@@ -47,8 +47,8 @@
open(DAEMON, "$perl local/http.t daemon |") or die "Can't exec daemon: $!";
}
-print "1..18\n";
-
+use Test;
+plan tests => 49;
my $greeting = <DAEMON>;
$greeting =~ /(<[^>]+>)/;
@@ -75,13 +75,12 @@
$req->header(X_Foo => "Bar");
$res = $ua->request($req);
-print "not " unless $res->is_error
- and $res->code == 404
- and $res->message =~ /not\s+found/i;
-print "ok 1\n";
+ok($res->is_error);
+ok($res->code, 404);
+ok($res->message, qr/not\s+found/i);
# we also expect a few headers
-print "not " if !$res->server and !$res->date;
-print "ok 2\n";
+ok($res->server);
+ok($res->date);
#----------------------------------------------------------------
print "Simple echo...\n";
@@ -108,25 +107,35 @@
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_success
- and $res->code == 200 && $res->message eq "OK";
-print "ok 3\n";
+ok($res->is_success);
+ok($res->code, 200);
+ok($res->message, "OK");
$_ = $res->content;
@accept = /^Accept:\s*(.*)/mg;
-print "not " unless /^From:\s*gisle\@aas\.no$/m
- and /^Host:/m
- and @accept == 3
- and /^Accept:\s*text\/html/m
- and /^Accept:\s*text\/plain/m
- and /^Accept:\s*image\/\*/m
- and /^If-Modified-Since:\s*\w{3},\s+\d+/m
- and /^Long-Text:\s*This.*broken between/m
- and /^Foo-Bar:\s*1$/m
- and /^X-Foo:\s*Bar$/m
- and /^User-Agent:\s*Mozilla\/0.01/m;
-print "ok 4\n";
+ok($_, qr/^From:\s*gisle\@aas\.no\n/m);
+ok($_, qr/^Host:/m);
+ok(@accept, 3);
+ok($_, qr/^Accept:\s*text\/html/m);
+ok($_, qr/^Accept:\s*text\/plain/m);
+ok($_, qr/^Accept:\s*image\/\*/m);
+ok($_, qr/^If-Modified-Since:\s*\w{3},\s+\d+/m);
+ok($_, qr/^Long-Text:\s*This.*broken between/m);
+ok($_, qr/^Foo-Bar:\s*1\n/m);
+ok($_, qr/^X-Foo:\s*Bar\n/m);
+ok($_, qr/^User-Agent:\s*Mozilla\/0.01/m);
+
+# Try it with the higher level 'get' interface
+$res = $ua->get(url("/echo/path_info?query", $base),
+ Accept => 'text/html',
+ Accept => 'text/plain; q=0.9',
+ Accept => 'image/*',
+ X_Foo => "Bar",
+);
+#$res->dump;
+ok($res->code, 200);
+ok($res->content, qr/^From: gisle\@aas.no$/m);
#----------------------------------------------------------------
print "Send file...\n";
@@ -155,27 +164,23 @@
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_success
- and $res->content_type eq 'text/html'
- and $res->content_length == 147
- and $res->title eq 'En pr�ve'
- and $res->content =~ /� v�re/;
-print "ok 5\n";
-
+ok($res->is_success);
+ok($res->content_type, 'text/html');
+ok($res->content_length, 147);
+ok($res->title, 'En pr�ve');
+ok($res->content, qr/� v�re/);
# A second try on the same file, should fail because we unlink it
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_error
- and $res->code == 404; # not found
-print "ok 6\n";
+ok($res->is_error);
+ok($res->code, 404); # not found
# Then try to list current directory
$req = new HTTP::Request GET => url("/file?name=.", $base);
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->code == 501; # NYI
-print "ok 7\n";
+ok($res->code, 501); # NYI
#----------------------------------------------------------------
@@ -190,12 +195,10 @@
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_success
- and $res->content =~ m|/echo/redirect|;
-print "ok 8\n";
-print "not " unless $res->previous->is_redirect
- and $res->previous->code == 301;
-print "ok 9\n";
+ok($res->is_success);
+ok($res->content, qr|/echo/redirect|);
+ok($res->previous->is_redirect);
+ok($res->previous->code, 301);
# Let's test a redirect loop too
sub httpd_get_redirect2 { shift->send_redirect("/redirect3/") }
@@ -205,17 +208,15 @@
$ua->max_redirect(5);
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_redirect
- and $res->header("Client-Warning") =~ /loop detected/i;
-print "ok 10\n";
-$i = 0;
-while ($res->previous) {
- $i++;
- $res = $res->previous;
-}
+ok($res->is_redirect);
+ok($res->header("Client-Warning"), qr/loop detected/i);
+ok($res->redirects, 5);
-print "not " unless $i == 5;
-print "ok 11\n";
+$ua->max_redirect(0);
+$res = $ua->request($req);
+ok($res->previous, undef);
+ok($res->redirects, 0);
+$ua->max_redirect(5);
#----------------------------------------------------------------
print "Check basic authorization...\n";
@@ -254,25 +255,22 @@
$res = MyUA->new->request($req);
#print $res->as_string;
-print "not " unless $res->is_success;
-print $res->content;
+ok($res->is_success);
+#print $res->content;
# Let's try with a $ua that does not pass out credentials
$res = $ua->request($req);
-print "not " unless $res->code == 401;
-print "ok 13\n";
+ok($res->code, 401);
# Let's try to set credentials for this realm
$ua->credentials($req->url->host_port, "libwww-perl", "ok 12", "xyzzy");
$res = $ua->request($req);
-print "not " unless $res->is_success;
-print "ok 14\n";
+ok($res->is_success);
# Then illegal credentials
$ua->credentials($req->url->host_port, "libwww-perl", "user", "passwd");
$res = $ua->request($req);
-print "not " unless $res->code == 401;
-print "ok 15\n";
+ok($res->code, 401);
#----------------------------------------------------------------
@@ -294,8 +292,7 @@
$req = new HTTP::Request GET => "ftp://ftp.perl.com/proxy";;
$res = $ua->request($req);
#print $res->as_string;
-print "not " unless $res->is_success;
-print "ok 16\n";
+ok($res->is_success);
#----------------------------------------------------------------
print "Check POSTing...\n";
@@ -325,11 +322,10 @@
#print $res->as_string;
$_ = $res->content;
-print "not " unless $res->is_success
- and /^Content-Length:\s*16$/mi
- and /^Content-Type:\s*application\/x-www-form-urlencoded$/mi
- and /^foo=bar&bar=test$/m;
-print "ok 17\n";
+ok($res->is_success);
+ok($_, qr/^Content-Length:\s*16$/mi);
+ok($_, qr/^Content-Type:\s*application\/x-www-form-urlencoded$/mi);
+ok($_, qr/^foo=bar&bar=test$/m);
#----------------------------------------------------------------
print "Terminating server...\n";
@@ -343,6 +339,5 @@
$req = new HTTP::Request GET => url("/quit", $base);
$res = $ua->request($req);
-print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/;
-print "ok 18\n";
-
+ok($res->code, 503);
+ok($res->content, qr/Bye, bye/);
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/local/protosub.t
new/libwww-perl-5.825/t/local/protosub.t
--- old/libwww-perl-5.823/t/local/protosub.t 2008-04-04 10:43:22.000000000
+0200
+++ new/libwww-perl-5.825/t/local/protosub.t 2009-02-11 10:29:22.000000000
+0100
@@ -1,6 +1,8 @@
#!perl
-print "1..6\n";
+use strict;
+use Test;
+plan tests => 6;
# This test tries to make a custom protocol implementation by
# subclassing of LWP::Protocol.
@@ -11,27 +13,27 @@
LWP::Protocol::implementor(http => 'myhttp');
-$ua = LWP::UserAgent->new;
+my $ua = LWP::UserAgent->new;
$ua->proxy('ftp' => "http://www.sn.no/";);
-$req = HTTP::Request->new(GET => 'ftp://foo/');
+my $req = HTTP::Request->new(GET => 'ftp://foo/');
$req->header(Cookie => "perl=cool");
-$res = $ua->request($req);
+my $res = $ua->request($req);
-print $res->as_string;
-
-print "not " unless $res->code == 200;
-print "ok 5\n";
-print "not " unless $res->content eq "Howdy\n";
-print "ok 6\n";
+#print $res->as_string;
+ok($res->code, 200);
+ok($res->content, "Howdy\n");
exit;
#----------------------------------
package myhttp;
+use Test qw(ok);
+
BEGIN {
+ use vars qw(@ISA);
@ISA=qw(LWP::Protocol);
}
@@ -40,8 +42,7 @@
my $class = shift;
print "CTOR: $class->new(@_)\n";
my($prot) = @_;
- print "not " unless $prot eq "http";
- print "ok 1\n";
+ ok($prot, "http");
my $self = $class->SUPER::new(@_);
for (keys %$self) {
my $v = $self->{$_};
@@ -54,18 +55,12 @@
sub request
{
my $self = shift;
- print "REQUEST: $self->request(",
- join(",", (map defined($_)? $_ : "UNDEF", @_)), ")\n";
-
my($request, $proxy, $arg, $size, $timeout) = @_;
- print $request->as_string;
+ #print $request->as_string;
- print "not " unless $proxy eq "http://www.sn.no/";;
- print "ok 2\n";
- print "not " unless $request->url eq "ftp://foo/";;
- print "ok 3\n";
- print "not " unless $request->header("cookie") eq "perl=cool";
- print "ok 4\n";
+ ok($proxy, "http://www.sn.no/";);
+ ok($request->url, "ftp://foo/";);
+ ok($request->header("cookie"), "perl=cool");
my $res = HTTP::Response->new(200 => "OK");
$res->content_type("text/plain");
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn
--exclude=.svnignore old/libwww-perl-5.823/t/robot/rules.t
new/libwww-perl-5.825/t/robot/rules.t
--- old/libwww-perl-5.823/t/robot/rules.t 2008-04-04 10:43:22.000000000
+0200
+++ new/libwww-perl-5.825/t/robot/rules.t 2009-01-14 22:49:18.000000000
+0100
@@ -62,6 +62,8 @@
Disallow: ftp://foo
Disallow: http://foo:8080/
Disallow: http://bar/
+
+Sitemap: http://www.adobe.com/sitemap.xml
EOM
my $content5 = <<EOM;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
--
To unsubscribe, e-mail: opensuse-commit+unsubscribe@xxxxxxxxxxxx
For additional commands, e-mail: opensuse-commit+help@xxxxxxxxxxxx
| < Previous | Next > |