Hello community,
here is the log from the commit of package perl-libwww-perl for
openSUSE:Factory checked in at 2012-03-01 07:25:15
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-libwww-perl (Old)
and /work/SRC/openSUSE:Factory/.perl-libwww-perl.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-libwww-perl", Maintainer is "vci...@suse.com"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-libwww-perl/perl-libwww-perl.changes
2011-10-18 14:37:22.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.perl-libwww-perl.new/perl-libwww-perl.changes
2012-03-01 07:25:18.000000000 +0100
@@ -1,0 +2,17 @@
+Mon Feb 20 02:36:32 UTC 2012 - vci...@suse.com
+
+- update to 6.04
+Gisle Aas (4):
+ Typo fix; envirionment [RT#72386]
+ Implement $ua->is_online test
+ Add separate option to enable the live jigsaw tests
+ Merge pull request #10 from trcjr/master
+Theodore Robert Campbell Jr (3):
+ now with put and delete helpers
+ updated POD
+ unit tests for ua->put and ua->delete
+Peter Rabbitson (1):
+ These modules work with 5.8.1
+_______________________________________________________________________________
+
+-------------------------------------------------------------------
Old:
----
libwww-perl-6.03.tar.gz
New:
----
libwww-perl-6.04.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-libwww-perl.spec ++++++
--- /var/tmp/diff_new_pack.YpUEfW/_old 2012-03-01 07:25:20.000000000 +0100
+++ /var/tmp/diff_new_pack.YpUEfW/_new 2012-03-01 07:25:20.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-libwww-perl
#
-# Copyright (c) 2011 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -18,7 +18,7 @@
Name: perl-libwww-perl
-Version: 6.03
+Version: 6.04
Release: 1
License: GPL-1.0+ or Artistic-1.0
%define cpan_name libwww-perl
@@ -105,9 +105,6 @@
make %{?_smp_mflags}
%check
-mv t/live/jigsaw-chunk.t t/live/jigsaw-chunk.tt
-mv t/live/jigsaw-md5.t t/live/jigsaw-md5.tt
-mv t/live/jigsaw-md5-get.t t/live/jigsaw-md5-get.tt
make test
%install
++++++ libwww-perl-6.03.tar.gz -> libwww-perl-6.04.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/Changes new/libwww-perl-6.04/Changes
--- old/libwww-perl-6.03/Changes 2011-10-15 15:28:21.000000000 +0200
+++ new/libwww-perl-6.04/Changes 2012-02-18 18:21:48.000000000 +0100
@@ -1,4 +1,24 @@
_______________________________________________________________________________
+2012-02-18 Release 6.04
+
+Gisle Aas (4):
+ Typo fix; envirionment [RT#72386]
+ Implement $ua->is_online test
+ Add separate option to enable the live jigsaw tests
+ Merge pull request #10 from trcjr/master
+
+Theodore Robert Campbell Jr (3):
+ now with put and delete helpers
+ updated POD
+ unit tests for ua->put and ua->delete
+
+Peter Rabbitson (1):
+ These modules work with 5.8.1
+
+
+
+
+_______________________________________________________________________________
2011-10-15 Release 6.03
Ville Skyttä (7):
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/MANIFEST
new/libwww-perl-6.04/MANIFEST
--- old/libwww-perl-6.03/MANIFEST 2011-10-15 15:36:10.000000000 +0200
+++ new/libwww-perl-6.04/MANIFEST 2012-02-18 23:11:21.000000000 +0100
@@ -39,14 +39,15 @@
t/base/protocols.t Test protocol methods of LWP::UserAgent
t/base/ua.t Basic LWP::UserAgent tests
t/live/apache-http10.t
-t/live/jigsaw-auth-b.t
-t/live/jigsaw-auth-d.t
-t/live/jigsaw-chunk.t
-t/live/jigsaw-md5-get.t
-t/live/jigsaw-md5.t
-t/live/jigsaw-neg-get.t
-t/live/jigsaw-neg.t
-t/live/jigsaw-te.t
+t/live/online.t
+t/live/jigsaw/auth-b.t
+t/live/jigsaw/auth-d.t
+t/live/jigsaw/chunk.t
+t/live/jigsaw/md5-get.t
+t/live/jigsaw/md5.t
+t/live/jigsaw/neg-get.t
+t/live/jigsaw/neg.t
+t/live/jigsaw/te.t
t/local/autoload-get.t
t/local/autoload.t Test autoloading of LWP::Protocol modules
t/local/get.t Try to get a local file
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/META.yml
new/libwww-perl-6.04/META.yml
--- old/libwww-perl-6.03/META.yml 2011-10-15 15:36:10.000000000 +0200
+++ new/libwww-perl-6.04/META.yml 2012-02-18 23:11:21.000000000 +0100
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 6.03
+version: 6.04
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas <gi...@activestate.com>
@@ -31,7 +31,7 @@
MIME::Base64: 2.1
Net::FTP: 2.58
Net::HTTP: 6
- perl: 5.008008
+ perl: 5.008001
URI: 1.10
URI::Escape: 0
WWW::RobotRules: 6
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/Makefile.PL
new/libwww-perl-6.04/Makefile.PL
--- old/libwww-perl-6.03/Makefile.PL 2011-04-09 12:21:10.000000000 +0200
+++ new/libwww-perl-6.04/Makefile.PL 2012-02-18 16:04:35.000000000 +0100
@@ -1,6 +1,6 @@
#!perl -w
-require 5.008008;
+require 5.008001;
use strict;
use ExtUtils::MakeMaker;
use Getopt::Long qw(GetOptions);
@@ -9,8 +9,9 @@
'aliases',
'no-programs|n',
'live-tests',
+ 'jigsaw-tests',
) or do {
- die "Usage: $0 [--aliases] [--no-programs] [--live-tests]\n";
+ die "Usage: $0 [--aliases] [--no-programs] [--live-tests]
[--jigsaw-tests]\n";
};
my @prog;
@@ -29,6 +30,7 @@
system($^X, "talk-to-ourself");
flag_file("t/CAN_TALK_TO_OURSELF", $? == 0);
flag_file("t/live/ENABLED", $opt{'live-tests'});
+flag_file("t/live/jigsaw/ENABLED", $opt{'jigsaw-tests'});
WriteMakefile(
NAME => 'LWP',
@@ -38,7 +40,7 @@
AUTHOR => 'Gisle Aas <gi...@activestate.com>',
EXE_FILES => [ map "bin/$_", @prog ],
LICENSE => "perl",
- MIN_PERL_VERSION => 5.008008,
+ MIN_PERL_VERSION => 5.008001,
PREREQ_PM => {
'Digest::MD5' => 0,
'Encode' => "2.12",
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/lib/LWP/UserAgent.pm
new/libwww-perl-6.04/lib/LWP/UserAgent.pm
--- old/libwww-perl-6.03/lib/LWP/UserAgent.pm 2011-10-15 15:30:33.000000000
+0200
+++ new/libwww-perl-6.04/lib/LWP/UserAgent.pm 2012-02-18 18:18:12.000000000
+0100
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "6.03";
+$VERSION = "6.04";
use HTTP::Request ();
use HTTP::Response ();
@@ -427,6 +427,22 @@
}
+sub put {
+ require HTTP::Request::Common;
+ my($self, @parameters) = @_;
+ my @suff = $self->_process_colonic_headers(\@parameters,
(ref($parameters[1]) ? 2 : 1));
+ return $self->request( HTTP::Request::Common::PUT( @parameters ), @suff );
+}
+
+
+sub delete {
+ require HTTP::Request::Common;
+ my($self, @parameters) = @_;
+ my @suff = $self->_process_colonic_headers(\@parameters,1);
+ return $self->request( HTTP::Request::Common::DELETE( @parameters ), @suff
);
+}
+
+
sub _process_colonic_headers {
# Process :content_cb / :content_file / :read_size_hint headers.
my($self, $args, $start_index) = @_;
@@ -476,6 +492,15 @@
return $arg;
}
+
+sub is_online {
+ my $self = shift;
+ return 1 if $self->get("http://www.msftncsi.com/ncsi.txt";)->content eq
"Microsoft NCSI";
+ return 1 if $self->get("http://www.apple.com";)->content =~
m,<title>Apple</title>,;
+ return 0;
+}
+
+
my @ANI = qw(- \ | /);
sub progress {
@@ -1058,8 +1083,8 @@
request method the UserAgent, which dispatches it using the relevant
protocol, and returns a C<HTTP::Response> object. There are
convenience methods for sending the most common request types: get(),
-head() and post(). When using these methods then the creation of the
-request object is hidden as shown in the synopsis above.
+head(), post(), put() and delete(). When using these methods then the
+creation of the request object is hidden as shown in the synopsis above.
The basic approach of the library is to use HTTP style communication
for all protocol schemes. This means that you will construct
@@ -1100,7 +1125,7 @@
The following additional options are also accepted: If the C<env_proxy> option
is passed in with a TRUE value, then proxy settings are read from environment
variables (see env_proxy() method below). If C<env_proxy> isn't provided the
-C<PERL_LWP_ENV_PROXY> envirionment variable controls if env_proxy() is called
+C<PERL_LWP_ENV_PROXY> environment variable controls if env_proxy() is called
during initalization. If the C<keep_alive> option is passed in, then a
C<LWP::ConnCache> is set up (see conn_cache() method below). The C<keep_alive>
value is passed on as the C<total_capacity> for the connection cache.
@@ -1356,7 +1381,7 @@
The no checks behaviour was the default for libwww-perl-5.837 and earlier
releases.
This option is initialized from the L<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
-variable. If this envirionment variable isn't set; then C<verify_hostname>
+variable. If this environment variable isn't set; then C<verify_hostname>
defaults to 1.
=item C<SSL_ca_file> => $path
@@ -1641,6 +1666,38 @@
to build the request. See L<HTTP::Request::Common> for a details on
how to pass form content and other advanced features.
+=item $ua->put( $url, \%form )
+
+=item $ua->put( $url, \@form )
+
+=item $ua->put( $url, \%form, $field_name => $value, ... )
+
+=item $ua->put( $url, $field_name => $value,... Content => \%form )
+
+=item $ua->put( $url, $field_name => $value,... Content => \@form )
+
+=item $ua->put( $url, $field_name => $value,... Content => $content )
+
+This method will dispatch a C<PUT> request on the given $url, with
+%form or @form providing the key/value pairs for the fill-in form
+content. Additional headers and content options are the same as for
+the get() method.
+
+This method will use the PUT() function from C<HTTP::Request::Common>
+to build the request. See L<HTTP::Request::Common> for a details on
+how to pass form content and other advanced features.
+
+=item $ua->delete( $url )
+
+=item $ua->delete( $url, $field_name => $value, ... )
+
+This method will dispatch a C<DELETE> request on the given $url. Additional
+headers and content options are the same as for the get() method.
+
+This method will use the DELETE() function from C<HTTP::Request::Common>
+to build the request. See L<HTTP::Request::Common> for a details on
+how to pass form content and other advanced features.
+
=item $ua->mirror( $url, $filename )
This method will get the document identified by $url and store it in
@@ -1700,6 +1757,12 @@
handle redirects or authentication responses. The request() method
will in fact invoke this method for each simple request it sends.
+=item $ua->is_online
+
+Tries to determine if you have access to the Internet. Returns
+TRUE if the built-in heuristics determine that the user agent is
+able to access the Internet (over HTTP). See also L<LWP::Online>.
+
=item $ua->is_protocol_supported( $scheme )
You can use this method to test whether this user agent object supports the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/lib/LWP.pm
new/libwww-perl-6.04/lib/LWP.pm
--- old/libwww-perl-6.03/lib/LWP.pm 2011-10-15 15:29:01.000000000 +0200
+++ new/libwww-perl-6.04/lib/LWP.pm 2012-02-18 18:17:18.000000000 +0100
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "6.03";
+$VERSION = "6.04";
sub Version { $VERSION; }
require 5.008;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/TEST new/libwww-perl-6.04/t/TEST
--- old/libwww-perl-6.03/t/TEST 2011-04-09 12:21:10.000000000 +0200
+++ new/libwww-perl-6.04/t/TEST 2012-02-18 16:04:06.000000000 +0100
@@ -38,6 +38,7 @@
else {
@tests = (<base/*.t>, <html/*.t>, <robot/*.t>, <local/*.t>);
push(@tests, <live/*.t>) if -f "live/ENABLED";
+ push(@tests, <live/jigsaw/*.t>) if -f "live/jigsaw/ENABLED";
push(@tests, <net/*.t>) if -f "net/config.pl";
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/auth-b.t
new/libwww-perl-6.04/t/live/jigsaw/auth-b.t
--- old/libwww-perl-6.03/t/live/jigsaw/auth-b.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/auth-b.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,53 @@
+use strict;
+use Test;
+
+plan tests => 5;
+
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/";);
+
+my $res = $ua->request($req);
+
+#print $res->as_string;
+
+ok($res->code, 401);
+
+$req->authorization_basic('guest', 'guest');
+$res = $ua->simple_request($req);
+
+print $req->as_string, "\n";
+
+#print $res->as_string;
+ok($res->code, 200);
+ok($res->content =~ /Your browser made it!/);
+
+{
+ package MyUA;
+ use vars qw(@ISA);
+ @ISA = qw(LWP::UserAgent);
+
+ my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
+
+ sub get_basic_credentials {
+ my($self,$realm, $uri, $proxy) = @_;
+ #print "$realm/$uri/$proxy\n";
+ my $p = shift @try;
+ #print join("/", @$p), "\n";
+ return @$p;
+ }
+
+}
+
+$ua = MyUA->new(keep_alive => 1);
+
+$req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/";);
+$res = $ua->request($req);
+
+#print $res->as_string;
+
+ok($res->content =~ /Your browser made it!/);
+ok($res->header("Client-Response-Num"), 5);
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/auth-d.t
new/libwww-perl-6.04/t/live/jigsaw/auth-d.t
--- old/libwww-perl-6.03/t/live/jigsaw/auth-d.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/auth-d.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,33 @@
+use strict;
+use Test;
+
+plan tests => 2;
+
+use LWP::UserAgent;
+
+{
+ package MyUA;
+ use vars qw(@ISA);
+ @ISA = qw(LWP::UserAgent);
+
+ my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
+
+ sub get_basic_credentials {
+ my($self,$realm, $uri, $proxy) = @_;
+ print "$realm:$uri:$proxy => ";
+ my $p = shift @try;
+ print join("/", @$p), "\n";
+ return @$p;
+ }
+
+}
+
+my $ua = MyUA->new(keep_alive => 1);
+
+my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Digest/";);
+my $res = $ua->request($req);
+
+#print $res->as_string;
+
+ok($res->content =~ /Your browser made it!/);
+ok($res->header("Client-Response-Num"), 5);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/chunk.t
new/libwww-perl-6.04/t/live/jigsaw/chunk.t
--- old/libwww-perl-6.03/t/live/jigsaw/chunk.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/chunk.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,37 @@
+print "1..5\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/ChunkedScript";);
+my $res = $ua->request($req);
+
+print "not " unless $res->is_success && $res->content_type eq "text/plain";
+print "ok 1\n";
+
+print "not " unless $res->header("Client-Transfer-Encoding") eq "chunked";
+print "ok 2\n";
+
+for (${$res->content_ref}) {
+ s/\015?\012/\n/g;
+ /Below this line, is 1000 repeated lines of 0-9/ || die;
+ s/^.*?-----+\n//s;
+
+ my @lines = split(/^/);
+ print "not " if @lines != 1000;
+ print "ok 3\n";
+
+ # check that all lines are the same
+ my $first = shift(@lines);
+ my $no_they_are_not;
+ for (@lines) {
+ $no_they_are_not++ if $_ ne $first;
+ }
+ print "not " if $no_they_are_not;
+ print "ok 4\n";
+
+ print "not " unless $first =~ /^\d+$/;
+ print "ok 5\n";
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/md5-get.t
new/libwww-perl-6.04/t/live/jigsaw/md5-get.t
--- old/libwww-perl-6.03/t/live/jigsaw/md5-get.t 1970-01-01
01:00:00.000000000 +0100
+++ new/libwww-perl-6.04/t/live/jigsaw/md5-get.t 2012-01-14
01:25:46.000000000 +0100
@@ -0,0 +1,29 @@
+print "1..2\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $res = $ua->get(
+ "http://jigsaw.w3.org/HTTP/h-content-md5.html";,
+ "TE" => "deflate",
+);
+
+use Digest::MD5 qw(md5_base64);
+print "not " unless $res->header("Content-MD5") eq md5_base64($res->content) .
"==";
+print "ok 1\n";
+
+print $res->as_string;
+
+my $etag = $res->header("etag");
+
+$res = $ua->get(
+ "http://jigsaw.w3.org/HTTP/h-content-md5.html";,
+ "TE" => "deflate",
+ "If-None-Match" => $etag,
+);
+print $res->as_string;
+
+print "not " unless $res->code eq "304" && $res->header("Client-Response-Num")
== 2;
+print "ok 2\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/md5.t
new/libwww-perl-6.04/t/live/jigsaw/md5.t
--- old/libwww-perl-6.03/t/live/jigsaw/md5.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/md5.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,26 @@
+print "1..2\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $req = HTTP::Request->new(GET =>
"http://jigsaw.w3.org/HTTP/h-content-md5.html";);
+$req->header("TE", "deflate");
+
+my $res = $ua->request($req);
+
+use Digest::MD5 qw(md5_base64);
+print "not " unless $res->header("Content-MD5") eq md5_base64($res->content) .
"==";
+print "ok 1\n";
+
+print $res->as_string;
+
+my $etag = $res->header("etag");
+$req->header("If-None-Match" => $etag);
+
+$res = $ua->request($req);
+print $res->as_string;
+
+print "not " unless $res->code eq "304" && $res->header("Client-Response-Num")
== 2;
+print "ok 2\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/neg-get.t
new/libwww-perl-6.04/t/live/jigsaw/neg-get.t
--- old/libwww-perl-6.03/t/live/jigsaw/neg-get.t 1970-01-01
01:00:00.000000000 +0100
+++ new/libwww-perl-6.04/t/live/jigsaw/neg-get.t 2012-01-14
01:25:46.000000000 +0100
@@ -0,0 +1,16 @@
+print "1..1\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $res = $ua->get(
+ "http://jigsaw.w3.org/HTTP/neg";,
+ Connection => "close",
+);
+
+print $res->as_string, "\n";
+
+print "not " unless $res->code == 300;
+print "ok 1\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/neg.t
new/libwww-perl-6.04/t/live/jigsaw/neg.t
--- old/libwww-perl-6.03/t/live/jigsaw/neg.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/neg.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,15 @@
+print "1..1\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/neg";);
+$req->header(Connection => "close");
+my $res = $ua->request($req);
+
+print $res->as_string, "\n";
+
+print "not " unless $res->code == 300;
+print "ok 1\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw/te.t
new/libwww-perl-6.04/t/live/jigsaw/te.t
--- old/libwww-perl-6.03/t/live/jigsaw/te.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/jigsaw/te.t 2012-01-14 01:25:46.000000000
+0100
@@ -0,0 +1,33 @@
+#!perl -w
+
+print "1..4\n";
+
+use strict;
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new(keep_alive => 1);
+
+
+my $content;
+my $testno = 1;
+
+for my $te (undef, "", "deflate", "gzip", "trailers, deflate;q=0.4,
identity;q=0.1") {
+ my $req = HTTP::Request->new(GET =>
"http://jigsaw.w3.org/HTTP/TE/foo.txt";);
+ if (defined $te) {
+ $req->header(TE => $te);
+ $req->header(Connection => "TE");
+ }
+ print $req->as_string;
+
+ my $res = $ua->request($req);
+ if (defined $content) {
+ print "not " unless $content eq $res->content;
+ print "ok $testno\n\n";
+ $testno++;
+ }
+ else {
+ $content = $res->content;
+ }
+ $res->content("");
+ print $res->as_string;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-auth-b.t
new/libwww-perl-6.04/t/live/jigsaw-auth-b.t
--- old/libwww-perl-6.03/t/live/jigsaw-auth-b.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-auth-b.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,53 +0,0 @@
-use strict;
-use Test;
-
-plan tests => 5;
-
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/";);
-
-my $res = $ua->request($req);
-
-#print $res->as_string;
-
-ok($res->code, 401);
-
-$req->authorization_basic('guest', 'guest');
-$res = $ua->simple_request($req);
-
-print $req->as_string, "\n";
-
-#print $res->as_string;
-ok($res->code, 200);
-ok($res->content =~ /Your browser made it!/);
-
-{
- package MyUA;
- use vars qw(@ISA);
- @ISA = qw(LWP::UserAgent);
-
- my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
-
- sub get_basic_credentials {
- my($self,$realm, $uri, $proxy) = @_;
- #print "$realm/$uri/$proxy\n";
- my $p = shift @try;
- #print join("/", @$p), "\n";
- return @$p;
- }
-
-}
-
-$ua = MyUA->new(keep_alive => 1);
-
-$req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Basic/";);
-$res = $ua->request($req);
-
-#print $res->as_string;
-
-ok($res->content =~ /Your browser made it!/);
-ok($res->header("Client-Response-Num"), 5);
-
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-auth-d.t
new/libwww-perl-6.04/t/live/jigsaw-auth-d.t
--- old/libwww-perl-6.03/t/live/jigsaw-auth-d.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-auth-d.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,33 +0,0 @@
-use strict;
-use Test;
-
-plan tests => 2;
-
-use LWP::UserAgent;
-
-{
- package MyUA;
- use vars qw(@ISA);
- @ISA = qw(LWP::UserAgent);
-
- my @try = (['foo', 'bar'], ['', ''], ['guest', ''], ['guest', 'guest']);
-
- sub get_basic_credentials {
- my($self,$realm, $uri, $proxy) = @_;
- print "$realm:$uri:$proxy => ";
- my $p = shift @try;
- print join("/", @$p), "\n";
- return @$p;
- }
-
-}
-
-my $ua = MyUA->new(keep_alive => 1);
-
-my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/Digest/";);
-my $res = $ua->request($req);
-
-#print $res->as_string;
-
-ok($res->content =~ /Your browser made it!/);
-ok($res->header("Client-Response-Num"), 5);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-chunk.t
new/libwww-perl-6.04/t/live/jigsaw-chunk.t
--- old/libwww-perl-6.03/t/live/jigsaw-chunk.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-chunk.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,37 +0,0 @@
-print "1..5\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/ChunkedScript";);
-my $res = $ua->request($req);
-
-print "not " unless $res->is_success && $res->content_type eq "text/plain";
-print "ok 1\n";
-
-print "not " unless $res->header("Client-Transfer-Encoding") eq "chunked";
-print "ok 2\n";
-
-for (${$res->content_ref}) {
- s/\015?\012/\n/g;
- /Below this line, is 1000 repeated lines of 0-9/ || die;
- s/^.*?-----+\n//s;
-
- my @lines = split(/^/);
- print "not " if @lines != 1000;
- print "ok 3\n";
-
- # check that all lines are the same
- my $first = shift(@lines);
- my $no_they_are_not;
- for (@lines) {
- $no_they_are_not++ if $_ ne $first;
- }
- print "not " if $no_they_are_not;
- print "ok 4\n";
-
- print "not " unless $first =~ /^\d+$/;
- print "ok 5\n";
-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-md5-get.t
new/libwww-perl-6.04/t/live/jigsaw-md5-get.t
--- old/libwww-perl-6.03/t/live/jigsaw-md5-get.t 2011-04-09
12:21:10.000000000 +0200
+++ new/libwww-perl-6.04/t/live/jigsaw-md5-get.t 1970-01-01
01:00:00.000000000 +0100
@@ -1,29 +0,0 @@
-print "1..2\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $res = $ua->get(
- "http://jigsaw.w3.org/HTTP/h-content-md5.html";,
- "TE" => "deflate",
-);
-
-use Digest::MD5 qw(md5_base64);
-print "not " unless $res->header("Content-MD5") eq md5_base64($res->content) .
"==";
-print "ok 1\n";
-
-print $res->as_string;
-
-my $etag = $res->header("etag");
-
-$res = $ua->get(
- "http://jigsaw.w3.org/HTTP/h-content-md5.html";,
- "TE" => "deflate",
- "If-None-Match" => $etag,
-);
-print $res->as_string;
-
-print "not " unless $res->code eq "304" && $res->header("Client-Response-Num")
== 2;
-print "ok 2\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-md5.t
new/libwww-perl-6.04/t/live/jigsaw-md5.t
--- old/libwww-perl-6.03/t/live/jigsaw-md5.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-md5.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,26 +0,0 @@
-print "1..2\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $req = HTTP::Request->new(GET =>
"http://jigsaw.w3.org/HTTP/h-content-md5.html";);
-$req->header("TE", "deflate");
-
-my $res = $ua->request($req);
-
-use Digest::MD5 qw(md5_base64);
-print "not " unless $res->header("Content-MD5") eq md5_base64($res->content) .
"==";
-print "ok 1\n";
-
-print $res->as_string;
-
-my $etag = $res->header("etag");
-$req->header("If-None-Match" => $etag);
-
-$res = $ua->request($req);
-print $res->as_string;
-
-print "not " unless $res->code eq "304" && $res->header("Client-Response-Num")
== 2;
-print "ok 2\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-neg-get.t
new/libwww-perl-6.04/t/live/jigsaw-neg-get.t
--- old/libwww-perl-6.03/t/live/jigsaw-neg-get.t 2011-04-09
12:21:10.000000000 +0200
+++ new/libwww-perl-6.04/t/live/jigsaw-neg-get.t 1970-01-01
01:00:00.000000000 +0100
@@ -1,16 +0,0 @@
-print "1..1\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $res = $ua->get(
- "http://jigsaw.w3.org/HTTP/neg";,
- Connection => "close",
-);
-
-print $res->as_string, "\n";
-
-print "not " unless $res->code == 300;
-print "ok 1\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-neg.t
new/libwww-perl-6.04/t/live/jigsaw-neg.t
--- old/libwww-perl-6.03/t/live/jigsaw-neg.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-neg.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,15 +0,0 @@
-print "1..1\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-my $req = HTTP::Request->new(GET => "http://jigsaw.w3.org/HTTP/neg";);
-$req->header(Connection => "close");
-my $res = $ua->request($req);
-
-print $res->as_string, "\n";
-
-print "not " unless $res->code == 300;
-print "ok 1\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/jigsaw-te.t
new/libwww-perl-6.04/t/live/jigsaw-te.t
--- old/libwww-perl-6.03/t/live/jigsaw-te.t 2011-04-09 12:21:10.000000000
+0200
+++ new/libwww-perl-6.04/t/live/jigsaw-te.t 1970-01-01 01:00:00.000000000
+0100
@@ -1,33 +0,0 @@
-#!perl -w
-
-print "1..4\n";
-
-use strict;
-use LWP::UserAgent;
-
-my $ua = LWP::UserAgent->new(keep_alive => 1);
-
-
-my $content;
-my $testno = 1;
-
-for my $te (undef, "", "deflate", "gzip", "trailers, deflate;q=0.4,
identity;q=0.1") {
- my $req = HTTP::Request->new(GET =>
"http://jigsaw.w3.org/HTTP/TE/foo.txt";);
- if (defined $te) {
- $req->header(TE => $te);
- $req->header(Connection => "TE");
- }
- print $req->as_string;
-
- my $res = $ua->request($req);
- if (defined $content) {
- print "not " unless $content eq $res->content;
- print "ok $testno\n\n";
- $testno++;
- }
- else {
- $content = $res->content;
- }
- $res->content("");
- print $res->as_string;
-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/live/online.t
new/libwww-perl-6.04/t/live/online.t
--- old/libwww-perl-6.03/t/live/online.t 1970-01-01 01:00:00.000000000
+0100
+++ new/libwww-perl-6.04/t/live/online.t 2012-02-18 15:52:49.000000000
+0100
@@ -0,0 +1,13 @@
+#!perl -w
+
+use strict;
+use Test;
+plan tests => 2;
+
+use LWP::UserAgent;
+my $ua = LWP::UserAgent->new;
+
+ok $ua->is_online;
+
+$ua->protocols_allowed([]);
+ok !$ua->is_online;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/libwww-perl-6.03/t/local/http.t
new/libwww-perl-6.04/t/local/http.t
--- old/libwww-perl-6.03/t/local/http.t 2011-10-15 11:05:50.000000000 +0200
+++ new/libwww-perl-6.04/t/local/http.t 2012-02-18 16:35:09.000000000 +0100
@@ -49,8 +49,8 @@
open(DAEMON, "$perl local/http.t daemon |") or die "Can't exec daemon: $!";
}
-use Test;
-plan tests => 54;
+use Test::More;
+plan tests => 59;
my $greeting = <DAEMON>;
$greeting =~ /(<[^>]+>)/;
@@ -77,9 +77,9 @@
$req->header(X_Foo => "Bar");
$res = $ua->request($req);
-ok($res->is_error);
-ok($res->code, 404);
-ok($res->message, qr/not\s+found/i);
+ok($res->is_error, 'is_error');
+is($res->code, 404, 'response code 404');
+like($res->message, qr/not\s+found/i, '404 message');
# we also expect a few headers
ok($res->server);
ok($res->date);
@@ -110,23 +110,23 @@
#print $res->as_string;
ok($res->is_success);
-ok($res->code, 200);
-ok($res->message, "OK");
+is($res->code, 200, 'status code 200');
+is($res->message, "OK", 'message OK');
$_ = $res->content;
@accept = /^Accept:\s*(.*)/mg;
-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);
+like($_, qr/^From:\s*gisle\@aas\.no\n/m);
+like($_, qr/^Host:/m);
+is(@accept, 3, '3 items in accept');
+like($_, qr/^Accept:\s*text\/html/m);
+like($_, qr/^Accept:\s*text\/plain/m);
+like($_, qr/^Accept:\s*image\/\*/m);
+like($_, qr/^If-Modified-Since:\s*\w{3},\s+\d+/m);
+like($_, qr/^Long-Text:\s*This.*broken between/m);
+like($_, qr/^Foo-Bar:\s*1\n/m);
+like($_, qr/^X-Foo:\s*Bar\n/m);
+like($_, 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),
@@ -136,7 +136,50 @@
X_Foo => "Bar",
);
#$res->dump;
-ok($res->code, 200);
+is($res->code, 200, 'response code 200');
+
+#----------------------------------------------------------------
+print "UserAgent->put...\n";
+sub httpd_put_echo
+{
+ my($c, $req) = @_;
+ $c->send_basic_header(200);
+ print $c "Content-Type: message/http\015\012";
+ $c->send_crlf;
+ print $c $req->as_string;
+}
+ok($res->content, qr/^From: gisle\@aas.no$/m);
+# Try it with the higher level 'get' interface
+$res = $ua->put(url("/echo/path_info?query", $base),
+ Accept => 'text/html',
+ Accept => 'text/plain; q=0.9',
+ Accept => 'image/*',
+ X_Foo => "Bar",
+);
+#$res->dump;
+is($res->code, 200, 'response code 200');
+ok($res->content, qr/^From: gisle\@aas.no$/m);
+
+#----------------------------------------------------------------
+print "UserAgent->delete...\n";
+sub httpd_delete_echo
+{
+ my($c, $req) = @_;
+ $c->send_basic_header(200);
+ print $c "Content-Type: message/http\015\012";
+ $c->send_crlf;
+ print $c $req->as_string;
+}
+ok($res->content, qr/^From: gisle\@aas.no$/m);
+# Try it with the higher level 'get' interface
+$res = $ua->delete(url("/echo/path_info?query", $base),
+ Accept => 'text/html',
+ Accept => 'text/plain; q=0.9',
+ Accept => 'image/*',
+ X_Foo => "Bar",
+);
+#$res->dump;
+is($res->code, 200, 'response code 200');
ok($res->content, qr/^From: gisle\@aas.no$/m);
#----------------------------------------------------------------
@@ -168,7 +211,7 @@
ok($res->is_success);
ok($res->content_type, 'text/html');
-ok($res->content_length, 147);
+is($res->content_length, 147, '147 content length');
ok($res->title, 'En pr�ve');
ok($res->content, qr/� v�re/);
@@ -176,13 +219,13 @@
$res = $ua->request($req);
#print $res->as_string;
ok($res->is_error);
-ok($res->code, 404); # not found
-
+is($res->code, 404, 'response 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;
-ok($res->code, 501); # NYI
+is($res->code, 501, 'response code 501'); # NYI
#----------------------------------------------------------------
@@ -200,7 +243,7 @@
ok($res->is_success);
ok($res->content, qr|/echo/redirect|);
ok($res->previous->is_redirect);
-ok($res->previous->code, 301);
+is($res->previous->code, 301, 'response code 301');
# Let's test a redirect loop too
sub httpd_get_redirect2 { shift->send_redirect("/redirect3/") }
@@ -212,12 +255,12 @@
#print $res->as_string;
ok($res->is_redirect);
ok($res->header("Client-Warning"), qr/loop detected/i);
-ok($res->redirects, 5);
+is($res->redirects, 5, '5 max redirects');
$ua->max_redirect(0);
$res = $ua->request($req);
-ok($res->previous, undef);
-ok($res->redirects, 0);
+is($res->previous, undef, 'undefined previous');
+is($res->redirects, 0, 'zero redirects');
$ua->max_redirect(5);
#----------------------------------------------------------------
@@ -262,7 +305,7 @@
# Let's try with a $ua that does not pass out credentials
$res = $ua->request($req);
-ok($res->code, 401);
+is($res->code, 401, 'respone code 401');
# Let's try to set credentials for this realm
$ua->credentials($req->uri->host_port, "libwww-perl", "ok 12", "xyzzy");
@@ -272,7 +315,7 @@
# Then illegal credentials
$ua->credentials($req->uri->host_port, "libwww-perl", "user", "passwd");
$res = $ua->request($req);
-ok($res->code, 401);
+is($res->code, 401, 'response code 401');
#----------------------------------------------------------------
@@ -378,5 +421,5 @@
$req = new HTTP::Request GET => url("/quit", $base);
$res = $ua->request($req);
-ok($res->code, 503);
+is($res->code, 503, 'response code is 503');
ok($res->content, qr/Bye, bye/);
--
To unsubscribe, e-mail: opensuse-commit+unsubscr...@opensuse.org
For additional commands, e-mail: opensuse-commit+h...@opensuse.org
