Hello community,
here is the log from the commit of package perl-libwww-perl for openSUSE:Factory
checked in at Mon Jul 19 21:06:37 CEST 2010.
--------
--- perl-libwww-perl/perl-libwww-perl.changes 2010-05-20 16:13:44.000000000 +0200
+++ /mounts/work_src_done/STABLE/perl-libwww-perl/perl-libwww-perl.changes 2010-07-08 20:00:20.000000000 +0200
@@ -1,0 +2,47 @@
+Thu Jul 8 17:58:17 UTC 2010 - chris@computersalat.de
+
+- fix deps
+ o added missing IO::{Unc,C}ompress::* stuff
+
+-------------------------------------------------------------------
+Wed Jul 7 12:47:35 UTC 2010 - chris@computersalat.de
+
+- update to 5.836
+Gisle Aas (1):
+ * Fix problem where $resp->base would downcase its return value
+- 2010-05-05 Release 5.835
+ * simple string can be simplified
+ * Make $mess->decoded_content remove XML encoding declarations [RT#52572]
+ * Don't allow saving to filenames starting with '.' suggested by server
+ * Avoid race between testing for existence of output file and opening the file
+ * Minor doc fixup -- wrongly ucfirsted word
+ * Use decoded_content in HTTP:Response synopsis [RT#54139]
+ * sun.com is no more. rip!
+ * Trivial layout tweak to reduce variable scope.
+ * Add 'make test_hudson' target
+ * Implement alt_charset parameter for decoded_content()
+ * Test decoding with different charset parameters
+ * lwp-download now needs the -s option to honor the Content-Disposition header
+ * Make LWP::MediaTypes::media_suffix case insensitive.
+ * Skip XML decoding tests if XML::Simple is not available.
+ * Documentation fixes.
+ * Fix m_media_type => "xhtml" matching.
+ * Make parse_head() apply to data: requests.
+ * Documentation spelling fixes.
+ * Documentation grammar fixes.
+ * Use $uri->secure in m_secure if available.
+ * Fix handling of multiple (same) base headers, and parameters in them.
+ * Strip out empty lines separated by CRLF
+ * Best Practice: avoid indirect object notation
+ * Speed up as_string by 4% by having _sorted_field_names return a reference
+ * Speed up scan() a bit. as_string() from this branch is now 6% faster
+ * Port over as_string() optimizations from HTTP::Headers::Fast
+ * Link to referenced documentation.
+ * Update repository location.
+ * Remove needless (and actually harmful) local $_
+ * "Perl & LWP" is available online
+- recreated by cpanspec 1.78
+- noarch
+- removed obsolete patch (Content-Disposition)
+
+-------------------------------------------------------------------
calling whatdependson for head-i586
Old:
----
libwww-perl-5.834.tar.bz2
perl-libwww-perl-5.834-Content-Disposition.diff
New:
----
libwww-perl-5.836.tar.bz2
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-libwww-perl.spec ++++++
--- /var/tmp/diff_new_pack.gZuLIS/_old 2010-07-19 21:06:01.000000000 +0200
+++ /var/tmp/diff_new_pack.gZuLIS/_new 2010-07-19 21:06:01.000000000 +0200
@@ -1,5 +1,5 @@
#
-# spec file for package perl-libwww-perl (Version 5.834)
+# spec file for package perl-libwww-perl (Version 5.836)
#
# Copyright (c) 2010 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
@@ -19,59 +19,65 @@
Name: perl-libwww-perl
-%define cpan_name %( echo %{name} | %{__sed} -e 's,perl-,,' )
+%define cpan_name libwww-perl
Summary: The World-Wide Web library for Perl
-Version: 5.834
-Release: 2
-AutoReqProv: on
-License: Artistic License ..
+Version: 5.836
+Release: 1
+License: GPL+, Artistic License
Group: Development/Libraries/Perl
-Url: http://search.cpan.org/dist/LWP/
+Url: http://search.cpan.org/dist/libwww-perl/
+#Source: http://www.cpan.org/modules/by-module/libwww/libwww-perl-%{version}.tar.gz
Source: %{cpan_name}-%{version}.tar.bz2
-Patch: %{name}-%{version}-Content-Disposition.diff
+BuildArch: noarch
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
+%if 0%{?suse_version} < 1120
BuildRequires: perl-macros
-BuildRequires: perl(Net::FTP) >= 2.58
+%endif
+BuildRequires: perl(Crypt::SSLeay)
+BuildRequires: perl(Compress::Raw::Zlib)
BuildRequires: perl(Digest::MD5)
-# other not perl || perl-base
-BuildRequires: perl(URI) >= 1.10
-BuildRequires: perl(MIME::Base64) >= 2.1
-BuildRequires: perl(HTML::Tagset)
BuildRequires: perl(HTML::Parser) >= 3.33
-BuildRequires: perl(Compress::Zlib) >= 1.10
+BuildRequires: perl(HTML::Tagset)
+BuildRequires: perl(IO::Compress::Gzip)
+BuildRequires: perl(IO::Compress::Deflate)
+BuildRequires: perl(IO::Uncompress::Gunzip)
+BuildRequires: perl(IO::Uncompress::Inflate)
+BuildRequires: perl(IO::Uncompress::RawInflate)
+BuildRequires: perl(URI) >= 1.10
Requires: perl = %{perl_version}
-Requires: perl(Net::FTP) >= 2.58
+Requires: perl(Compress::Raw::Zlib)
+Requires: perl(Crypt::SSLeay)
Requires: perl(Digest::MD5)
-# other not perl || perl-base
-Requires: perl(URI) >= 1.10
-Requires: perl(HTML::Tagset)
Requires: perl(HTML::Parser) >= 3.33
-Requires: perl(Compress::Zlib) >= 1.10
-#Requires: perl(Compress::Bzip2)
-Recommends: perl(Crypt::SSLeay)
-Provides: libwww-perl
-Provides: perl_lw3
-Obsoletes: perl_lw3
+Requires: perl(HTML::Tagset)
+Requires: perl(IO::Compress::Gzip)
+Requires: perl(IO::Compress::Deflate)
+Requires: perl(IO::Uncompress::Gunzip)
+Requires: perl(IO::Uncompress::Inflate)
+Requires: perl(IO::Uncompress::RawInflate)
+Requires: perl(URI) >= 1.10
%description
The libwww-perl collection is a set of Perl modules which provides a
-simple and consistent application programming interface to the
-World-Wide Web. The main focus of the library is to provide classes
-and functions that allow you to write WWW clients. The library also
-contain modules that are of more general use and even classes that
-help you implement simple HTTP servers.
+simple and consistent application programming interface to the World-Wide
+Web. The main focus of the library is to provide classes and functions
+that allow you to write WWW clients. The library also contain modules that
+are of more general use and even classes that help you implement simple
+HTTP servers.
- Authors:
+
+Authors:
+--------
Gisle Aas
Martijn Koster
+
%prep
%setup -q -n %{cpan_name}-%{version}
-%patch -p1
%build
-CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL
-%{__make}
+%{__perl} Makefile.PL INSTALLDIRS=vendor
+%{__make} %{?_smp_mflags}
%check
#disable test that require network connection
@@ -82,14 +88,17 @@
%install
%perl_make_install
-%perl_process_packlist
+# remove .packlist file
+%{__rm} -rf $RPM_BUILD_ROOT%perl_vendorarch
+# remove perllocal.pod file
+%{__rm} -rf $RPM_BUILD_ROOT%perl_archlib
%perl_gen_filelist
%clean
%{__rm} -rf $RPM_BUILD_ROOT
%files -f %{name}.files
-%defattr(-,root,root)
-%doc Changes README README.SSL
+%defattr(-,root,root,-)
+%doc AUTHORS Changes README README.SSL talk-to-ourself
%changelog
++++++ libwww-perl-5.834.tar.bz2 -> libwww-perl-5.836.tar.bz2 ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/Changes new/libwww-perl-5.836/Changes
--- old/libwww-perl-5.834/Changes 2009-11-21 14:03:02.000000000 +0100
+++ new/libwww-perl-5.836/Changes 2010-05-13 09:22:54.000000000 +0200
@@ -1,4 +1,59 @@
_______________________________________________________________________________
+2010-05-13 Release 5.836
+
+Gisle Aas (1):
+ Fix problem where $resp->base would downcase its return value
+
+
+
+_______________________________________________________________________________
+2010-05-05 Release 5.835
+
+Gisle Aas (12):
+ simple string can be simplified
+ Make $mess->decoded_content remove XML encoding declarations [RT#52572]
+ Don't allow saving to filenames starting with '.' suggested by server
+ Avoid race between testing for existence of output file and opening the file
+ Minor doc fixup -- wrongly ucfirsted word
+ Use decoded_content in HTTP:Response synopsis [RT#54139]
+ sun.com is no more. rip!
+ Trivial layout tweak to reduce variable scope.
+ Add 'make test_hudson' target
+ Implement alt_charset parameter for decoded_content()
+ Test decoding with different charset parameters
+ lwp-download now needs the -s option to honor the Content-Disposition header
+
+Ville Skyttä (9):
+ Make LWP::MediaTypes::media_suffix case insensitive.
+ Skip XML decoding tests if XML::Simple is not available.
+ Documentation fixes.
+ Fix m_media_type => "xhtml" matching.
+ Make parse_head() apply to data: requests.
+ Documentation spelling fixes.
+ Documentation grammar fixes.
+ Use $uri->secure in m_secure if available.
+ Fix handling of multiple (same) base headers, and parameters in them.
+
+Mark Stosberg (5):
+ Strip out empty lines separated by CRLF
+ Best Practice: avoid indirect object notation
+ Speed up as_string by 4% by having _sorted_field_names return a reference
+ Speed up scan() a bit. as_string() from this branch is now 6% faster
+ Port over as_string() optimizations from HTTP::Headers::Fast
+
+Tom Hukins (2):
+ Link to referenced documentation.
+ Update repository location.
+
+Father Chrysostomos (1):
+ Remove needless (and actually harmful) local $_
+
+Sean M. Burke (1):
+ "Perl & LWP" is available online
+
+
+
+_______________________________________________________________________________
2009-11-21 Release 5.834
Gisle Aas (4):
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/META.yml new/libwww-perl-5.836/META.yml
--- old/libwww-perl-5.834/META.yml 2009-11-21 14:04:36.000000000 +0100
+++ new/libwww-perl-5.836/META.yml 2010-05-13 09:25:38.000000000 +0200
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 5.834
+version: 5.836
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas
@@ -8,6 +8,8 @@
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
requires:
Compress::Raw::Zlib: 0
Digest::MD5: 0
@@ -24,12 +26,12 @@
URI: 1.10
resources:
MailingList: mailto:libwww@perl.org
- repository: http://gitorious.org/projects/libwww-perl
+ repository: http://github.com/gisle/libwww-perl
no_index:
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.4801
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/Makefile.PL new/libwww-perl-5.836/Makefile.PL
--- old/libwww-perl-5.834/Makefile.PL 2009-11-15 08:37:14.000000000 +0100
+++ new/libwww-perl-5.836/Makefile.PL 2010-05-05 22:57:17.000000000 +0200
@@ -58,7 +58,7 @@
'Crypt::SSLeay' => 0,
},
resources => {
- repository => 'http://gitorious.org/projects/libwww-perl',
+ repository => 'http://github.com/gisle/libwww-perl',
MailingList => 'mailto:libwww@perl.org',
}
},
@@ -82,6 +82,9 @@
test : pure_all
$(FULLPERL) t/TEST $(TEST_VERBOSE)
+test_hudson : pure_all
+ $(FULLPERL) t/TEST $(TEST_VERBOSE) --formatter=TAP::Formatter::JUnit
+
);
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/README new/libwww-perl-5.836/README
--- old/libwww-perl-5.834/README 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/README 2010-05-05 22:57:17.000000000 +0200
@@ -75,11 +75,11 @@
If you want to hack on the source it might be a good idea to grab the
latest version with git using the command:
- git clone git://gitorious.org/libwww-perl/mainline.git lwp
+ git clone git://github.com/gisle/libwww-perl.git lwp
You can also browse the git repository at:
- http://gitorious.org/projects/libwww-perl
+ http://github.com/gisle/libwww-perl
COPYRIGHT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/bin/lwp-download new/libwww-perl-5.836/bin/lwp-download
--- old/libwww-perl-5.834/bin/lwp-download 2009-06-15 20:22:36.000000000 +0200
+++ new/libwww-perl-5.836/bin/lwp-download 2010-05-05 23:04:55.000000000 +0200
@@ -6,7 +6,7 @@
=head1 SYNOPSIS
-B<lwp-download> [B<-a>] []
+B<lwp-download> [B<-a>] [B<-s>] []
=head1 DESCRIPTION
@@ -16,15 +16,19 @@
If I<local path> is not specified, then the current directory is
assumed.
-If I<local path> is a directory, then the basename of the file to save
-is picked up from the Content-Disposition header or the URL of the
-response. If the file already exists, then B<lwp-download> will
-prompt before it overwrites and will fail if its standard input is not
-a terminal. This form of invocation will also fail is no acceptable
-filename can be derived from the sources mentioned above.
+If I<local path> is a directory, then the last segment of the path of the
+I<url> is appended to form a local filename. If the I<url> path ends with
+slash the name "index" is used. With the B<-s> option pick up the last segment
+of the filename from server provided sources like the Content-Disposition
+header or any redirect URLs. A file extension to match the server reported
+Content-Type might also be appended. If a file with the produced filename
+already exists, then B<lwp-download> will prompt before it overwrites and will
+fail if its standard input is not a terminal. This form of invocation will
+also fail is no acceptable filename can be derived from the sources mentioned
+above.
If I<local path> is not a directory, then it is simply used as the
-path to save into.
+path to save into. If the file already exists it's overwritten.
The I<lwp-download> program is implemented using the I<libwww-perl>
library. It is better suited to down load big files than the
@@ -66,14 +70,14 @@
#parse option
use Getopt::Std;
my %opt;
-unless (getopts('a', \%opt)) {
+unless (getopts('as', \%opt)) {
usage();
}
my $url = URI->new(shift || usage());
my $argfile = shift;
usage() if defined($argfile) && !length($argfile);
-my $VERSION = "5.827";
+my $VERSION = "5.835";
my $ua = LWP::UserAgent->new(
agent => "lwp-download/$VERSION ",
@@ -106,20 +110,17 @@
unless (defined $argfile) {
# find a suitable name to use
- $file = $res->filename;
+ $file = $opt{s} && $res->filename;
# if this fails we try to make something from the URL
unless ($file) {
- my $req = $res->request; # not always there
- my $rurl = $req ? $req->uri : $url;
-
- $file = ($rurl->path_segments)[-1];
+ $file = ($url->path_segments)[-1];
if (!defined($file) || !length($file)) {
$file = "index";
my $suffix = media_suffix($res->content_type);
$file .= ".$suffix" if $suffix;
}
- elsif ($rurl->scheme eq 'ftp' ||
+ elsif ($url->scheme eq 'ftp' ||
$file =~ /\.t[bg]z$/ ||
$file =~ /\.tar(\.(Z|gz|bz2?))?$/
) {
@@ -138,7 +139,9 @@
# validate that we don't have a harmful filename now. The server
# might try to trick us into doing something bad.
if (!length($file) ||
- $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge)
+ $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge ||
+ $file =~ /^\./
+ )
{
die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
}
@@ -174,12 +177,17 @@
}
else {
print "Saving to '$file'...\n";
+ use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
+ sysopen(FILE, $file, O_WRONLY|O_EXCL|O_CREAT) ||
+ die "Can't open $file: $!";
}
}
else {
$file = $argfile;
}
- open(FILE, ">$file") || die "Can't open $file: $!\n";
+ unless (fileno(FILE)) {
+ open(FILE, ">", $file) || die "Can't open $file: $!\n";
+ }
binmode FILE unless $opt{a};
$length = $res->content_length;
$flength = fbytes($length) if defined $length;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/Bundle/LWP.pm new/libwww-perl-5.836/lib/Bundle/LWP.pm
--- old/libwww-perl-5.834/lib/Bundle/LWP.pm 2008-04-11 20:59:19.000000000 +0200
+++ new/libwww-perl-5.836/lib/Bundle/LWP.pm 2010-05-05 23:05:14.000000000 +0200
@@ -1,6 +1,6 @@
package Bundle::LWP;
-$VERSION = "5.810";
+$VERSION = "5.835";
1;
@@ -26,7 +26,7 @@
HTML::Tagset - Needed by HTML::Parser
-HTML::Parser - Need by HTML::HeadParser
+HTML::Parser - Needed by HTML::HeadParser
HTML::HeadParser - To get the correct $res->base
@@ -34,9 +34,10 @@
=head1 DESCRIPTION
-This bundle defines all prereq modules for libwww-perl. Bundles have
-special meaning for the CPAN module. When you install the bundle
-module all modules mentioned in L</CONTENTS> will be installed instead.
+This bundle defines all prerequisite modules for libwww-perl. Bundles
+have special meaning for the CPAN module. When you install the bundle
+module all modules mentioned in L</CONTENTS> will be installed
+instead.
=head1 SEE ALSO
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/HTTP/Config.pm new/libwww-perl-5.836/lib/HTTP/Config.pm
--- old/libwww-perl-5.834/lib/HTTP/Config.pm 2008-10-20 12:20:08.000000000 +0200
+++ new/libwww-perl-5.836/lib/HTTP/Config.pm 2010-05-05 23:05:25.000000000 +0200
@@ -4,7 +4,7 @@
use URI;
use vars qw($VERSION);
-$VERSION = "5.815";
+$VERSION = "5.835";
sub new {
my $class = shift;
@@ -71,7 +71,7 @@
},
m_secure => sub {
my($v, $uri) = @_;
- my $secure = $uri->_scheme eq "https";
+ my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
return $secure == !!$v;
},
m_host_port => sub {
@@ -146,7 +146,7 @@
my $ct = $response->content_type;
return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
return 3, 1 if $v eq "html" && $response->content_is_html;
- return 4, 1 if $v eq "html" && $response->content_is_xhtml;
+ return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
return 10, 1 if $v eq $ct;
return 0;
},
@@ -404,7 +404,7 @@
=item m_uri__I<$method> => undef
-Matches if the URI object provide the method
+Matches if the URI object provides the method.
=item m_uri__I<$method> => $string
@@ -418,7 +418,7 @@
=item m_response_attr__I<$key> => $string
-Matches if the response object has a that key; or the entry has the given value.
+Matches if the response object has that key, or the entry has the given value.
=back
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/HTTP/Headers.pm new/libwww-perl-5.836/lib/HTTP/Headers.pm
--- old/libwww-perl-5.834/lib/HTTP/Headers.pm 2009-06-15 20:25:10.000000000 +0200
+++ new/libwww-perl-5.836/lib/HTTP/Headers.pm 2010-05-05 23:05:34.000000000 +0200
@@ -4,7 +4,7 @@
use Carp ();
use vars qw($VERSION $TRANSLATE_UNDERSCORE);
-$VERSION = "5.827";
+$VERSION = "5.835";
# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
# as a replacement for '-' in header field names.
@@ -199,16 +199,16 @@
sub _sorted_field_names
{
my $self = shift;
- return sort {
+ return [ sort {
($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
$a cmp $b
- } keys %$self
+ } keys %$self ];
}
sub header_field_names {
my $self = shift;
- return map $standard_case{$_} || $_, $self->_sorted_field_names
+ return map $standard_case{$_} || $_, @{ $self->_sorted_field_names },
if wantarray;
return keys %$self;
}
@@ -218,17 +218,17 @@
{
my($self, $sub) = @_;
my $key;
- foreach $key ($self->_sorted_field_names) {
- next if $key =~ /^_/;
+ for $key (@{ $self->_sorted_field_names }) {
+ next if substr($key, 0, 1) eq '_';
my $vals = $self->{$key};
if (ref($vals) eq 'ARRAY') {
my $val;
for $val (@$vals) {
- &$sub($standard_case{$key} || $key, $val);
+ $sub->($standard_case{$key} || $key, $val);
}
}
else {
- &$sub($standard_case{$key} || $key, $vals);
+ $sub->($standard_case{$key} || $key, $vals);
}
}
}
@@ -240,29 +240,51 @@
$endl = "\n" unless defined $endl;
my @result = ();
- $self->scan(sub {
- my($field, $val) = @_;
- $field =~ s/^://;
- if ($val =~ /\n/) {
- # must handle header values with embedded newlines with care
- $val =~ s/\s+$//; # trailing newlines and space must go
- $val =~ s/\n\n+/\n/g; # no empty lines
- $val =~ s/\n([^\040\t])/\n $1/g; # intial space for continuation
- $val =~ s/\n/$endl/g; # substitute with requested line ending
+ for my $key (@{ $self->_sorted_field_names }) {
+ next if index($key, '_') == 0;
+ my $vals = $self->{$key};
+ if ( ref($vals) eq 'ARRAY' ) {
+ for my $val (@$vals) {
+ my $field = $standard_case{$key} || $key;
+ $field =~ s/^://;
+ if ( index($val, "\n") >= 0 ) {
+ $val = _process_newline($val, $endl);
+ }
+ push @result, $field . ': ' . $val;
+ }
+ }
+ else {
+ my $field = $standard_case{$key} || $key;
+ $field =~ s/^://;
+ if ( index($vals, "\n") >= 0 ) {
+ $vals = _process_newline($vals, $endl);
+ }
+ push @result, $field . ': ' . $vals;
}
- push(@result, "$field: $val");
- });
+ }
join($endl, @result, '');
}
+sub _process_newline {
+ local $_ = shift;
+ my $endl = shift;
+ # must handle header values with embedded newlines with care
+ s/\s+$//; # trailing newlines and space must go
+ s/\n(\x0d?\n)+/\n/g; # no empty lines
+ s/\n([^\040\t])/\n $1/g; # intial space for continuation
+ s/\n/$endl/g; # substitute with requested line ending
+ $_;
+}
+
+
if (eval { require Storable; 1 }) {
*clone = \&Storable::dclone;
} else {
*clone = sub {
my $self = shift;
- my $clone = new HTTP::Headers;
+ my $clone = HTTP::Headers->new;
$self->scan(sub { $clone->push_header(@_);} );
$clone;
};
@@ -552,9 +574,9 @@
=item $h->remove_content_headers
This will remove all the header fields used to describe the content of
-a message. All header field names prefixed with C<Content-> falls
+a message. All header field names prefixed with C<Content-> fall
into this category, as well as C<Allow>, C<Expires> and
-C<Last-Modified>. RFC 2616 denote these fields as IHTTP::Headers object that contains the
@@ -604,7 +626,7 @@
=head1 CONVENIENCE METHODS
The most frequently used headers can also be accessed through the
-following convenience Methods. Most of these methods can both be used to read
+following convenience methods. Most of these methods can both be used to read
and to set the value of a header. The header value is set if you pass
an argument to the method. The old header value is always returned.
If the given header did not exist then C<undef> is returned.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/HTTP/Message.pm new/libwww-perl-5.836/lib/HTTP/Message.pm
--- old/libwww-perl-5.834/lib/HTTP/Message.pm 2009-11-21 13:57:55.000000000 +0100
+++ new/libwww-perl-5.836/lib/HTTP/Message.pm 2010-05-05 23:05:44.000000000 +0200
@@ -2,7 +2,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD);
-$VERSION = "5.834";
+$VERSION = "5.835";
require HTTP::Headers;
require Carp;
@@ -205,7 +205,6 @@
my $cref = $self->decoded_content(ref => 1, charset => "none");
# Unicode BOM
- local $_;
for ($$cref) {
return "UTF-8" if /^\xEF\xBB\xBF/;
return "UTF-32-LE" if /^\xFF\xFE\x00\x00/;
@@ -357,7 +356,7 @@
}
}
- if ($self->content_is_text || $self->content_is_xml) {
+ if ($self->content_is_text || (my $is_xml = $self->content_is_xml)) {
my $charset = lc(
$opt{charset} ||
$self->content_type_charset ||
@@ -375,9 +374,32 @@
$content_ref = \$copy;
$content_ref_iscopy++;
}
- $content_ref = \Encode::decode($charset, $$content_ref,
- ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
+ eval {
+ $content_ref = \Encode::decode($charset, $$content_ref,
+ ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
+ };
+ if ($@) {
+ my $retried;
+ if ($@ =~ /^Unknown encoding/) {
+ my $alt_charset = lc($opt{alt_charset} || "");
+ if ($alt_charset && $charset ne $alt_charset) {
+ # Retry decoding with the alternative charset
+ $content_ref = \Encode::decode($alt_charset, $$content_ref,
+ ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC())
+ unless $alt_charset =~ /^(?:none|us-ascii|iso-8859-1)\z/;
+ $retried++;
+ }
+ }
+ die unless $retried;
+ }
die "Encode::decode() returned undef improperly" unless defined $$content_ref;
+ if ($is_xml) {
+ # Get rid of the XML encoding declaration if present
+ $$content_ref =~ s/^\x{FEFF}//;
+ if ($$content_ref =~ /^(\s*<\?xml[^\x00]*?\?>)/) {
+ substr($$content_ref, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//;
+ }
+ }
}
}
};
@@ -866,6 +888,13 @@
This override the default charset guessed by content_charset() or
if that fails "ISO-8859-1".
+=item C
+
+If decoding fails because the charset specified in the Content-Type header
+isn't recognized by Perl's Encode module, then try decoding using this charset
+instead of failing. The C might be specified as C<none> to simply
+return the string without any decoding of charset as alternative.
+
=item C
Abort decoding if malformed characters is found in the content. By
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/HTTP/Negotiate.pm new/libwww-perl-5.836/lib/HTTP/Negotiate.pm
--- old/libwww-perl-5.834/lib/HTTP/Negotiate.pm 2008-09-24 11:41:59.000000000 +0200
+++ new/libwww-perl-5.836/lib/HTTP/Negotiate.pm 2010-05-05 23:05:55.000000000 +0200
@@ -1,6 +1,6 @@
package HTTP::Negotiate;
-$VERSION = "5.813";
+$VERSION = "5.835";
sub Version { $VERSION; }
require 5.002;
@@ -19,7 +19,7 @@
unless (defined $request) {
# Create a request object from the CGI environment variables
- $request = new HTTP::Headers;
+ $request = HTTP::Headers->new;
$request->header('Accept', $ENV{HTTP_ACCEPT})
if $ENV{HTTP_ACCEPT};
$request->header('Accept-Charset', $ENV{HTTP_ACCEPT_CHARSET})
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/HTTP/Response.pm new/libwww-perl-5.836/lib/HTTP/Response.pm
--- old/libwww-perl-5.834/lib/HTTP/Response.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/HTTP/Response.pm 2010-05-13 09:21:55.000000000 +0200
@@ -2,7 +2,7 @@
require HTTP::Message;
@ISA = qw(HTTP::Message);
-$VERSION = "5.824";
+$VERSION = "5.836";
use strict;
use HTTP::Status ();
@@ -76,9 +76,11 @@
sub base
{
my $self = shift;
- my $base = $self->header('Content-Base') || # used to be HTTP/1.1
- $self->header('Content-Location') || # HTTP/1.1
- $self->header('Base'); # HTTP/1.0
+ my $base = (
+ $self->header('Content-Base'), # used to be HTTP/1.1
+ $self->header('Content-Location'), # HTTP/1.1
+ $self->header('Base'), # HTTP/1.0
+ )[0];
if ($base && $base =~ /^$URI::scheme_re:/o) {
# already absolute
return $HTTP::URI_CLASS->new($base);
@@ -155,8 +157,8 @@
}
}
- my $uri;
unless (defined($file) && length($file)) {
+ my $uri;
if (my $cl = $self->header('Content-Location')) {
$uri = URI->new($cl);
}
@@ -349,7 +351,7 @@
# ...
$response = $ua->request($request)
if ($response->is_success) {
- print $response->content;
+ print $response->decoded_content;
}
else {
print STDERR $response->status_line, "\n";
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Authen/Ntlm.pm new/libwww-perl-5.836/lib/LWP/Authen/Ntlm.pm
--- old/libwww-perl-5.834/lib/LWP/Authen/Ntlm.pm 2009-06-15 20:26:32.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Authen/Ntlm.pm 2010-05-05 23:06:22.000000000 +0200
@@ -3,7 +3,7 @@
use strict;
use vars qw/$VERSION/;
-$VERSION = '5.827';
+$VERSION = '5.835';
use Authen::NTLM "1.02";
use MIME::Base64 "2.12";
@@ -103,7 +103,7 @@
my $url = 'http://www.company.com/protected_page.html';
# Set up the ntlm client and then the base64 encoded ntlm handshake message
- my $ua = new LWP::UserAgent(keep_alive=>1);
+ my $ua = LWP::UserAgent->new(keep_alive=>1);
$ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
$request = GET $url;
@@ -146,7 +146,7 @@
To do this, pass the "keep_alive=>1" option to the LWP::UserAgent when creating it, like this:
- my $ua = new LWP::UserAgent(keep_alive=>1);
+ my $ua = LWP::UserAgent->new(keep_alive=>1);
=item *
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/MediaTypes.pm new/libwww-perl-5.836/lib/LWP/MediaTypes.pm
--- old/libwww-perl-5.834/lib/LWP/MediaTypes.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/MediaTypes.pm 2010-05-05 23:06:30.000000000 +0200
@@ -4,7 +4,7 @@
@ISA = qw(Exporter);
@EXPORT = qw(guess_media_type media_suffix);
@EXPORT_OK = qw(add_type add_encoding read_media_types);
-$VERSION = "5.822";
+$VERSION = "5.835";
use strict;
@@ -110,19 +110,20 @@
sub media_suffix {
if (!wantarray && @_ == 1 && $_[0] !~ /\*/) {
- return $suffixExt{$_[0]};
+ return $suffixExt{lc $_[0]};
}
my(@type) = @_;
my(@suffix, $ext, $type);
foreach (@type) {
if (s/\*/.*/) {
while(($ext,$type) = each(%suffixType)) {
- push(@suffix, $ext) if $type =~ /^$_$/;
+ push(@suffix, $ext) if $type =~ /^$_$/i;
}
}
else {
+ my $ltype = lc $_;
while(($ext,$type) = each(%suffixType)) {
- push(@suffix, $ext) if $type eq $_;
+ push(@suffix, $ext) if lc $type eq $ltype;
}
}
}
@@ -146,7 +147,7 @@
$ext =~ s/^\.//;
$suffixType{$ext} = $type;
}
- $suffixExt{$type} = $exts[0] if @exts;
+ $suffixExt{lc $type} = $exts[0] if @exts;
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Protocol/data.pm new/libwww-perl-5.836/lib/LWP/Protocol/data.pm
--- old/libwww-perl-5.834/lib/LWP/Protocol/data.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Protocol/data.pm 2010-03-14 12:31:40.000000000 +0100
@@ -21,20 +21,20 @@
# check proxy
if (defined $proxy)
{
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with data';
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
+ 'You can not proxy with data');
}
# check method
my $method = $request->method;
unless ($method eq 'GET' || $method eq 'HEAD') {
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
- "$method for 'data:' URLs";
+ "$method for 'data:' URLs");
}
my $url = $request->uri;
- my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
+ my $response = HTTP::Response->new( &HTTP::Status::RC_OK, "Document follows");
my $media_type = $url->media_type;
@@ -44,9 +44,9 @@
'Date' => time2str(time),
'Server' => "libwww-perl-internal/$LWP::VERSION"
);
- $response->content($data) if $method ne "HEAD";
- return $response;
+ $data = "" if $method eq "HEAD";
+ return $self->collect_once($arg, $response, $data);
}
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Protocol/file.pm new/libwww-perl-5.836/lib/LWP/Protocol/file.pm
--- old/libwww-perl-5.834/lib/LWP/Protocol/file.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Protocol/file.pm 2010-01-22 22:44:52.000000000 +0100
@@ -21,16 +21,16 @@
# check proxy
if (defined $proxy)
{
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through the filesystem';
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
+ 'You can not proxy through the filesystem');
}
# check method
my $method = $request->method;
unless ($method eq 'GET' || $method eq 'HEAD') {
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
- "$method for 'file:' URLs";
+ "$method for 'file:' URLs");
}
# check url
@@ -38,8 +38,8 @@
my $scheme = $url->scheme;
if ($scheme ne 'file') {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::file::request called for '$scheme'";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "LWP::Protocol::file::request called for '$scheme'");
}
# URL OK, look at file
@@ -47,12 +47,12 @@
# test file exists and is readable
unless (-e $path) {
- return new HTTP::Response &HTTP::Status::RC_NOT_FOUND,
- "File `$path' does not exist";
+ return HTTP::Response->new( &HTTP::Status::RC_NOT_FOUND,
+ "File `$path' does not exist");
}
unless (-r _) {
- return new HTTP::Response &HTTP::Status::RC_FORBIDDEN,
- 'User does not have read permission';
+ return HTTP::Response->new( &HTTP::Status::RC_FORBIDDEN,
+ 'User does not have read permission');
}
# looks like file exists
@@ -67,13 +67,13 @@
if (defined $ims) {
my $time = HTTP::Date::str2time($ims);
if (defined $time and $time >= $mtime) {
- return new HTTP::Response &HTTP::Status::RC_NOT_MODIFIED,
- "$method $path";
+ return HTTP::Response->new( &HTTP::Status::RC_NOT_MODIFIED,
+ "$method $path");
}
}
# Ok, should be an OK response by now...
- my $response = new HTTP::Response &HTTP::Status::RC_OK;
+ my $response = HTTP::Response->new( &HTTP::Status::RC_OK );
# fill in response headers
$response->header('Last-Modified', HTTP::Date::time2str($mtime));
@@ -81,8 +81,8 @@
if (-d _) { # If the path is a directory, process it
# generate the HTML for directory
opendir(D, $path) or
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Cannot read directory '$path': $!";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "Cannot read directory '$path': $!");
my(@files) = sort readdir(D);
closedir(D);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Protocol/http.pm new/libwww-perl-5.836/lib/LWP/Protocol/http.pm
--- old/libwww-perl-5.834/lib/LWP/Protocol/http.pm 2009-10-12 20:33:43.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Protocol/http.pm 2010-01-22 22:44:52.000000000 +0100
@@ -127,9 +127,9 @@
# check method
my $method = $request->method;
unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
- "$method for 'http:' URLs";
+ "$method for 'http:' URLs");
}
my $url = $request->uri;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Protocol/http10.pm new/libwww-perl-5.836/lib/LWP/Protocol/http10.pm
--- old/libwww-perl-5.834/lib/LWP/Protocol/http10.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Protocol/http10.pm 2010-01-22 22:44:52.000000000 +0100
@@ -97,9 +97,9 @@
# check method
my $method = $request->method;
unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
- "$method for 'http:' URLs";
+ "$method for 'http:' URLs");
}
my $url = $request->uri;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Protocol/mailto.pm new/libwww-perl-5.836/lib/LWP/Protocol/mailto.pm
--- old/libwww-perl-5.834/lib/LWP/Protocol/mailto.pm 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Protocol/mailto.pm 2010-01-22 22:44:52.000000000 +0100
@@ -39,17 +39,17 @@
# check proxy
if (defined $proxy)
{
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with mail';
+ return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
+ 'You can not proxy with mail');
}
# check method
my $method = $request->method;
if ($method ne 'POST') {
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
- "$method for 'mailto:' URLs";
+ "$method for 'mailto:' URLs");
}
# check url
@@ -57,37 +57,37 @@
my $scheme = $url->scheme;
if ($scheme ne 'mailto') {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::mailto::request called for '$scheme'";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "LWP::Protocol::mailto::request called for '$scheme'");
}
if ($^O eq "MacOS") {
eval {
require Mail::Internet;
};
if($@) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have MailTools installed";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "You don't have MailTools installed");
}
unless ($ENV{SMTPHOSTS}) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have SMTPHOSTS defined";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "You don't have SMTPHOSTS defined");
}
}
else {
unless (-x $SENDMAIL) {
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have $SENDMAIL";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "You don't have $SENDMAIL");
}
}
if ($^O eq "MacOS") {
$mail = Mail::Internet->new or
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Can't get a Mail::Internet object";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "Can't get a Mail::Internet object");
}
else {
open(SENDMAIL, "| $SENDMAIL -oi -t") or
- return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Can't run $SENDMAIL: $!";
+ return HTTP::Response->new( &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "Can't run $SENDMAIL: $!");
}
if ($^O eq "MacOS") {
$addr = $url->encoded822addr;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/RobotUA.pm new/libwww-perl-5.836/lib/LWP/RobotUA.pm
--- old/libwww-perl-5.834/lib/LWP/RobotUA.pm 2009-06-15 20:26:46.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/RobotUA.pm 2010-05-05 23:06:54.000000000 +0200
@@ -2,7 +2,7 @@
require LWP::UserAgent;
@ISA = qw(LWP::UserAgent);
-$VERSION = "5.827";
+$VERSION = "5.835";
require WWW::RobotRules;
require HTTP::Request;
@@ -125,7 +125,7 @@
# make access to robot.txt legal since this will be a recursive call
$self->{'rules'}->parse($robot_url, "");
- my $robot_req = new HTTP::Request 'GET', $robot_url;
+ my $robot_req = HTTP::Request->new('GET', $robot_url);
my $robot_res = $self->request($robot_req);
my $fresh_until = $robot_res->fresh_until;
if ($robot_res->is_success) {
@@ -148,8 +148,8 @@
# Check rules
unless ($allowed) {
- my $res = new HTTP::Response
- &HTTP::Status::RC_FORBIDDEN, 'Forbidden by robots.txt';
+ my $res = HTTP::Response->new(
+ &HTTP::Status::RC_FORBIDDEN, 'Forbidden by robots.txt');
$res->request( $request ); # bind it to that request
return $res;
}
@@ -162,8 +162,8 @@
sleep($wait)
}
else {
- my $res = new HTTP::Response
- &HTTP::Status::RC_SERVICE_UNAVAILABLE, 'Please, slow down';
+ my $res = HTTP::Response->new(
+ &HTTP::Status::RC_SERVICE_UNAVAILABLE, 'Please, slow down');
$res->header('Retry-After', time2str(time + $wait));
$res->request( $request ); # bind it to that request
return $res;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/Simple.pm new/libwww-perl-5.836/lib/LWP/Simple.pm
--- old/libwww-perl-5.834/lib/LWP/Simple.pm 2009-06-15 20:27:03.000000000 +0200
+++ new/libwww-perl-5.836/lib/LWP/Simple.pm 2010-05-05 23:07:05.000000000 +0200
@@ -14,7 +14,7 @@
use HTTP::Status;
push(@EXPORT, @HTTP::Status::EXPORT);
-$VERSION = "5.827";
+$VERSION = "5.835";
sub import
{
@@ -26,7 +26,7 @@
use LWP::UserAgent ();
use HTTP::Status ();
use HTTP::Date ();
-$ua = new LWP::UserAgent; # we create a global UserAgent object
+$ua = LWP::UserAgent->new; # we create a global UserAgent object
$ua->agent("LWP::Simple/$VERSION ");
$ua->env_proxy;
@@ -133,7 +133,7 @@
The get() function will fetch the document identified by the given URL
and return it. It returns C<undef> if it fails. The $url argument can
-be either a simple string or a reference to a URI object.
+be either a string or a reference to a URI object.
You will not be able to examine the response code or response headers
(like 'Content-Type') when you are accessing the web using this
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP/UserAgent.pm new/libwww-perl-5.836/lib/LWP/UserAgent.pm
--- old/libwww-perl-5.834/lib/LWP/UserAgent.pm 2009-11-21 13:58:07.000000000 +0100
+++ new/libwww-perl-5.836/lib/LWP/UserAgent.pm 2010-05-05 23:07:13.000000000 +0200
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.834";
+$VERSION = "5.835";
use HTTP::Request ();
use HTTP::Response ();
@@ -1393,8 +1393,7 @@
The handler might set the $response->{default_add_content} value to
control if any received data should be added to the response object
directly. This will initially be false if the $ua->request() method
-was called with a ':content_filename' or ':content_callbak' argument;
-otherwise true.
+was called with a $content_file or $content_cb argument; otherwise true.
=item response_data => sub { my($response, $ua, $h, $data) = @_; ... }
@@ -1434,7 +1433,7 @@
=item $ua->set_my_handler( $phase, $cb, %matchspec )
Set handlers private to the executing subroutine. Works by defaulting
-an C<owner> field to the %matchhspec that holds the name of the called
+an C<owner> field to the %matchspec that holds the name of the called
subroutine. You might pass an explicit C<owner> to override this.
If $cb is passed as C<undef>, remove the handler.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/LWP.pm new/libwww-perl-5.836/lib/LWP.pm
--- old/libwww-perl-5.834/lib/LWP.pm 2009-11-21 13:56:32.000000000 +0100
+++ new/libwww-perl-5.836/lib/LWP.pm 2010-05-13 09:21:45.000000000 +0200
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "5.834";
+$VERSION = "5.836";
sub Version { $VERSION; }
require 5.005;
@@ -554,9 +554,9 @@
=head1 MORE DOCUMENTATION
All modules contain detailed information on the interfaces they
-provide. The I<lwpcook> manpage is the libwww-perl cookbook that contain
+provide. The L<lwpcook> manpage is the libwww-perl cookbook that contain
examples of typical usage of the library. You might want to take a
-look at how the scripts C<lwp-request>, C<lwp-rget> and C<lwp-mirror>
+look at how the scripts L<lwp-request>, L<lwp-rget> and L<lwp-mirror>
are implemented.
=head1 ENVIRONMENT
@@ -646,7 +646,7 @@
The latest version of this library is likely to be available from CPAN
as well as:
- http://gitorious.org/projects/libwww-perl
+ http://github.com/gisle/libwww-perl
The best place to discuss this code is on the
mailing list.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lib/WWW/RobotRules/AnyDBM_File.pm new/libwww-perl-5.836/lib/WWW/RobotRules/AnyDBM_File.pm
--- old/libwww-perl-5.834/lib/WWW/RobotRules/AnyDBM_File.pm 2008-04-11 20:59:19.000000000 +0200
+++ new/libwww-perl-5.836/lib/WWW/RobotRules/AnyDBM_File.pm 2010-05-05 23:07:23.000000000 +0200
@@ -2,7 +2,7 @@
require WWW::RobotRules;
@ISA = qw(WWW::RobotRules);
-$VERSION = "5.810";
+$VERSION = "5.835";
use Carp ();
use AnyDBM_File;
@@ -19,8 +19,8 @@
require LWP::RobotUA;
# Create a robot useragent that uses a diskcaching RobotRules
- my $rules = new WWW::RobotRules::AnyDBM_File 'my-robot/1.0', 'cachefile';
- my $ua = new WWW::RobotUA 'my-robot/1.0', 'me@foo.com', $rules;
+ my $rules = WWW::RobotRules::AnyDBM_File->new( 'my-robot/1.0', 'cachefile' );
+ my $ua = WWW::RobotUA->new( 'my-robot/1.0', 'me@foo.com', $rules );
# Then just use $ua as usual
$res = $ua->request($req);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/lwptut.pod new/libwww-perl-5.836/lwptut.pod
--- old/libwww-perl-5.834/lwptut.pod 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/lwptut.pod 2010-03-14 12:31:40.000000000 +0100
@@ -814,8 +814,10 @@
=item *
-The book I by Sean M. Burke. O'Reilly & Associates, 2002.
-ISBN: 0-596-00178-9. Chttp://www.oreilly.com/catalog/perllwp/
+The book I by Sean M. Burke. O'Reilly & Associates,
+2002. ISBN: 0-596-00178-9, Lhttp://www.oreilly.com/catalog/perllwp/. The
+whole book is also available free online:
+Lhttp://lwp.interglacial.com.
=back
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/TEST new/libwww-perl-5.836/t/TEST
--- old/libwww-perl-5.834/t/TEST 2008-10-20 11:26:36.000000000 +0200
+++ new/libwww-perl-5.836/t/TEST 2010-05-05 22:57:17.000000000 +0200
@@ -5,6 +5,12 @@
$Test::Harness::verbose = shift
if defined $ARGV[0] and $ARGV[0] =~ /^\d+$/ || $ARGV[0] eq "-v";
+my $formatter;
+if (@ARGV && $ARGV[0] =~ /^--formatter=/) {
+ (undef, $formatter) = split(/=/, shift, 2);
+ $formatter = "TAP::Formatter::$formatter" unless $formatter =~ /::/
+}
+
# make sure we are in the "t" directory
unless (-d "base") {
chdir "t" or die "Can't chdir: $!";
@@ -36,4 +42,18 @@
@tests = grep !/jigsaw/, @tests; # service is not reliable any more
}
-runtests @tests;
+if ($formatter) {
+ use File::Path; File::Path::rmtree("tap");
+ $ENV{PERL_TEST_HARNESS_DUMP_TAP} = "tap";
+ require TAP::Harness;
+ my $harness = TAP::Harness->new({
+ formatter_class => $formatter,
+ merge => 1,
+ #timer => 1,
+ lib => \@INC,
+ });
+ $harness->runtests(@tests);
+}
+else {
+ runtests @tests;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/headers.t new/libwww-perl-5.836/t/base/headers.t
--- old/libwww-perl-5.834/t/base/headers.t 2009-06-13 14:45:37.000000000 +0200
+++ new/libwww-perl-5.836/t/base/headers.t 2010-01-17 22:31:42.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use Test qw(plan ok);
-plan tests => 163;
+plan tests => 164;
my($h, $h2);
sub j { join("|", @_) }
@@ -362,6 +362,18 @@
baz<<
EOT
+# Check for attempt to send a body
+$h = HTTP::Headers->new(
+ a => "foo\r\n\r\nevil body" ,
+ b => "foo\015\012\015\012evil body" ,
+ c => "foo\x0d\x0a\x0d\x0aevil body" ,
+);
+ok (
+ $h->as_string(),
+ "A: foo\r\n evil body\n".
+ "B: foo\015\012 evil body\n" .
+ "C: foo\x0d\x0a evil body\n" ,
+ "embedded CRLF are stripped out");
# Check with FALSE $HTML::Headers::TRANSLATE_UNDERSCORE
{
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/http-config.t new/libwww-perl-5.836/t/base/http-config.t
--- old/libwww-perl-5.834/t/base/http-config.t 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/t/base/http-config.t 2010-03-14 12:31:40.000000000 +0100
@@ -60,11 +60,12 @@
$conf->add_item("text", m_media_type => "text/*");
$conf->add_item("html", m_media_type => "html");
$conf->add_item("HTML", m_media_type => "text/html");
+$conf->add_item("xhtml", m_media_type => "xhtml");
ok(j($conf->matching_items($response)), "text|any");
$response->content_type("application/xhtml+xml");
-ok(j($conf->matching_items($response)), "html|any");
+ok(j($conf->matching_items($response)), "xhtml|html|any");
$response->content_type("text/html");
ok(j($conf->matching_items($response)), "HTML|html|text|any");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/mediatypes.t new/libwww-perl-5.836/t/base/mediatypes.t
--- old/libwww-perl-5.834/t/base/mediatypes.t 2008-10-20 12:20:08.000000000 +0200
+++ new/libwww-perl-5.836/t/base/mediatypes.t 2009-12-18 19:35:25.000000000 +0100
@@ -46,7 +46,7 @@
["x.ppm.Z.UU" => "image/x-portable-pixmap","compress","x-uuencode",],
);
-plan tests => @tests * 3 + 4;
+plan tests => @tests * 3 + 6;
if ($ENV{HOME} and -f "$ENV{HOME}/.mime.types") {
warn "
@@ -69,6 +69,11 @@
print "# Image suffixes: @imgSuffix\n";
ok(grep $_ eq "gif", @imgSuffix);
+@audioSuffix = media_suffix('AUDIO/*');
+print "# Audio suffixes: @audioSuffix\n";
+ok(grep $_ eq 'oga', @audioSuffix);
+ok(media_suffix('audio/OGG'), 'oga');
+
require HTTP::Response;
$r = new HTTP::Response 200, "Document follows";
$r->title("file.tar.gz.uu");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/message-charset.t new/libwww-perl-5.836/t/base/message-charset.t
--- old/libwww-perl-5.834/t/base/message-charset.t 2009-06-25 21:38:55.000000000 +0200
+++ new/libwww-perl-5.836/t/base/message-charset.t 2010-05-05 22:57:17.000000000 +0200
@@ -15,7 +15,7 @@
}
use Test;
-plan tests => 21;
+plan tests => 36;
use HTTP::Response;
my $r = HTTP::Response->new(200, "OK");
@@ -91,3 +91,37 @@
encoding="US-ASCII" ?>
EOT
ok($r->content_charset, "US-ASCII");
+
+{
+ sub TIESCALAR{bless[]}
+ tie $_, "";
+ my $fail = 0;
+ sub STORE{ ++$fail }
+ sub FETCH{}
+ $r->content_charset;
+ ok($fail, 0, 'content_charset leaves $_ alone');
+}
+
+$r->remove_content_headers;
+$r->content_type("text/plain; charset=UTF-8");
+$r->content("abc");
+ok($r->decoded_content, "abc");
+
+$r->content("\xc3\xa5");
+ok($r->decoded_content, chr(0xE5));
+ok($r->decoded_content(charset => "none"), "\xC3\xA5");
+ok($r->decoded_content(alt_charset => "UTF-8"), chr(0xE5));
+ok($r->decoded_content(alt_charset => "none"), chr(0xE5));
+
+$r->content_type("text/plain; charset=UTF");
+ok($r->decoded_content, undef);
+ok($r->decoded_content(charset => "UTF-8"), chr(0xE5));
+ok($r->decoded_content(charset => "none"), "\xC3\xA5");
+ok($r->decoded_content(alt_charset => "UTF-8"), chr(0xE5));
+ok($r->decoded_content(alt_charset => "none"), "\xC3\xA5");
+
+$r->content_type("text/plain");
+ok($r->decoded_content, chr(0xE5));
+ok($r->decoded_content(charset => "none"), "\xC3\xA5");
+ok($r->decoded_content(default_charset => "ISO-8859-1"), "\xC3\xA5");
+ok($r->decoded_content(default_charset => "latin1"), "\xC3\xA5");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/message.t new/libwww-perl-5.836/t/base/message.t
--- old/libwww-perl-5.834/t/base/message.t 2009-11-15 08:37:14.000000000 +0100
+++ new/libwww-perl-5.836/t/base/message.t 2009-12-18 20:36:46.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use Test qw(plan ok skip);
-plan tests => 124;
+plan tests => 125;
require HTTP::Message;
use Config qw(%Config);
@@ -501,3 +501,12 @@
else {
skip("Need IO::Uncompress::Bunzip2", undef) for 1..9;
}
+
+# test decoding of XML content
+if ($] >= 5.008001) {
+ $m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0");
+ ok($m->decoded_content, "<?xml version=\"1.0\"?>\n<root>\xC9ric</root>\n");
+}
+else {
+ skip("Need perl-5.8", undef) for 1..1;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/response.t new/libwww-perl-5.836/t/base/response.t
--- old/libwww-perl-5.834/t/base/response.t 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/t/base/response.t 2010-05-13 08:10:42.000000000 +0200
@@ -5,7 +5,7 @@
use strict;
use Test;
-plan tests => 19;
+plan tests => 23;
use HTTP::Date;
use HTTP::Request;
@@ -92,3 +92,11 @@
for ($r->redirects) {
ok($_->is_success);
}
+
+ok($r->base, $r->request->uri);
+$r->push_header("Content-Location", "/1/A/a");
+ok($r->base, "http://www.sn.no/1/A/a");
+$r->push_header("Content-Base", "/2/;a=/foo/bar");
+ok($r->base, "http://www.sn.no/2/;a=/foo/bar");
+$r->push_header("Content-Base", "/3/");
+ok($r->base, "http://www.sn.no/2/;a=/foo/bar");
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/base/ua.t new/libwww-perl-5.836/t/base/ua.t
--- old/libwww-perl-5.834/t/base/ua.t 2009-06-15 15:20:06.000000000 +0200
+++ new/libwww-perl-5.836/t/base/ua.t 2010-03-14 12:31:40.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use Test;
-plan tests => 12;
+plan tests => 14;
use LWP::UserAgent;
@@ -43,3 +43,7 @@
ok($ua->proxy(http => undef), "loopback:");
ok($ua->proxy('http'), undef);
+
+my $res = $ua->get("data:text/html,%3Chtml%3E%3Chead%3E%3Cmeta%20http-equiv%3D%22Content-Script-Type%22%20content%3D%22text%2Fjavascript%22%3E%3Cmeta%20http-equiv%3D%22Content-Style-Type%22%20content%3D%22text%2Fcss%22%3E%3C%2Fhead%3E%3C%2Fhtml%3E");
+ok($res->header("Content-Style-Type", "text/css"));
+ok($res->header("Content-Script-Type", "text/javascript"));
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/libwww-perl-5.834/t/live/https.t new/libwww-perl-5.836/t/live/https.t
--- old/libwww-perl-5.834/t/live/https.t 2009-06-13 14:45:37.000000000 +0200
+++ new/libwww-perl-5.836/t/live/https.t 2010-02-03 21:21:36.000000000 +0100
@@ -6,7 +6,7 @@
use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
-my $res = $ua->simple_request(HTTP::Request->new(GET => "https://www.sun.com"));
+my $res = $ua->simple_request(HTTP::Request->new(GET => "https://www.apache.org"));
if ($res->code == 501 && $res->message =~ /Protocol scheme 'https' is not supported/) {
print "1..0 # Skipped: " . $res->message . "\n";
@@ -15,6 +15,6 @@
plan tests => 2;
ok($res->is_success);
-ok($res->content =~ /Sun Microsystems/);
+ok($res->content =~ /Apache Software Foundation/);
$res->dump(prefix => "# ");
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
--
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org