r47577 - in /trunk/libwww-perl: ./ bin/ debian/ lib/ lib/HTTP/ lib/LWP/ lib/LWP/Protocol/ lib/Net/ lib/Net/HTTP/ t/base/ t/live/ t/local/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Nov 21 17:34:58 UTC 2009
Author: jawnsy-guest
Date: Sat Nov 21 17:34:53 2009
New Revision: 47577
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47577
Log:
New upstream release
Modified:
trunk/libwww-perl/Changes
trunk/libwww-perl/META.yml
trunk/libwww-perl/Makefile.PL
trunk/libwww-perl/bin/lwp-request
trunk/libwww-perl/debian/changelog
trunk/libwww-perl/lib/HTTP/Message.pm
trunk/libwww-perl/lib/LWP.pm
trunk/libwww-perl/lib/LWP/Protocol/ftp.pm
trunk/libwww-perl/lib/LWP/Protocol/gopher.pm
trunk/libwww-perl/lib/LWP/Protocol/http.pm
trunk/libwww-perl/lib/LWP/UserAgent.pm
trunk/libwww-perl/lib/Net/HTTP.pm
trunk/libwww-perl/lib/Net/HTTP/Methods.pm
trunk/libwww-perl/t/base/message.t
trunk/libwww-perl/t/base/request.t
trunk/libwww-perl/t/live/apache-listing.t
trunk/libwww-perl/t/local/http.t
Modified: trunk/libwww-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/Changes?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/Changes (original)
+++ trunk/libwww-perl/Changes Sat Nov 21 17:34:53 2009
@@ -1,3 +1,22 @@
+_______________________________________________________________________________
+2009-11-21 Release 5.834
+
+Gisle Aas (4):
+ Check for sane default_headers argument [RT#50393]
+ Add $ua->local_address attribute [RT#40912]
+ Test that generation of boundary works [RT#49396]
+ Page does not display the "standard" apache listing any more
+
+Ville Skyttä (2):
+ Remove unneeded executable permissions.
+ Switch compression/decompression to use the IO::Compress/IO::Uncompress and
+ Compress::Raw::Zlib family of modules.
+
+Slaven Rezic (1):
+ lwp-request should use stderr for auth [RT#21620]
+
+
+
_______________________________________________________________________________
2009-10-06 Release 5.833
Modified: trunk/libwww-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/META.yml?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/META.yml (original)
+++ trunk/libwww-perl/META.yml Sat Nov 21 17:34:53 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 5.833
+version: 5.834
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas <gisle at activestate.com>
@@ -8,17 +8,20 @@
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
-build_requires:
- ExtUtils::MakeMaker: 0
requires:
- Compress::Zlib: 1.10
- Digest::MD5: 0
- HTML::Parser: 3.33
- HTML::Tagset: 0
- MIME::Base64: 2.1
- Net::FTP: 2.58
- perl: 5.006
- URI: 1.10
+ Compress::Raw::Zlib: 0
+ Digest::MD5: 0
+ HTML::Parser: 3.33
+ HTML::Tagset: 0
+ IO::Compress::Deflate: 0
+ IO::Compress::Gzip: 0
+ IO::Uncompress::Gunzip: 0
+ IO::Uncompress::Inflate: 0
+ IO::Uncompress::RawInflate: 0
+ MIME::Base64: 2.1
+ Net::FTP: 2.58
+ perl: 5.006
+ URI: 1.10
resources:
MailingList: mailto:libwww at perl.org
repository: http://gitorious.org/projects/libwww-perl
@@ -26,7 +29,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
+generated_by: ExtUtils::MakeMaker version 6.4801
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libwww-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/Makefile.PL?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/Makefile.PL (original)
+++ trunk/libwww-perl/Makefile.PL Sat Nov 21 17:34:53 2009
@@ -46,7 +46,12 @@
'HTML::Tagset' => 0,
'HTML::Parser' => "3.33",
'Digest::MD5' => 0,
- 'Compress::Zlib' => "1.10",
+ 'Compress::Raw::Zlib' => 0,
+ 'IO::Compress::Gzip' => 0,
+ 'IO::Compress::Deflate' => 0,
+ 'IO::Uncompress::Gunzip' => 0,
+ 'IO::Uncompress::Inflate' => 0,
+ 'IO::Uncompress::RawInflate' => 0,
},
META_MERGE => {
recommends => {
Modified: trunk/libwww-perl/bin/lwp-request
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/bin/lwp-request?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/bin/lwp-request (original)
+++ trunk/libwww-perl/bin/lwp-request Sat Nov 21 17:34:53 2009
@@ -180,7 +180,7 @@
$progname =~ s,.*[\\/],,; # use basename only
$progname =~ s/\.\w*$//; # strip extension, if any
-$VERSION = "5.827";
+$VERSION = "5.834";
require LWP;
@@ -231,15 +231,15 @@
}
elsif (-t) {
my $netloc = $uri->host_port;
- print "Enter username for $realm at $netloc: ";
+ print STDERR "Enter username for $realm at $netloc: ";
my $user = <STDIN>;
chomp($user);
return (undef, undef) unless length $user;
- print "Password: ";
+ print STDERR "Password: ";
system("stty -echo");
my $password = <STDIN>;
system("stty echo");
- print "\n"; # because we disabled echo
+ print STDERR "\n"; # because we disabled echo
chomp($password);
return ($user, $password);
}
@@ -362,7 +362,7 @@
die "$progname: Illegal Content-type format\n"
unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s*;.*)?$,
}
- print "Please enter content ($options{'c'}) to be ${method}ed:\n"
+ print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n"
if -t;
binmode STDIN unless -t or $options{'a'};
$content = join("", <STDIN>);
Modified: trunk/libwww-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/debian/changelog?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/debian/changelog (original)
+++ trunk/libwww-perl/debian/changelog Sat Nov 21 17:34:53 2009
@@ -1,3 +1,9 @@
+libwww-perl (5.834-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 21 Nov 2009 08:06:50 -0500
+
libwww-perl (5.833-1) unstable; urgency=low
* New upstream release
Modified: trunk/libwww-perl/lib/HTTP/Message.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/HTTP/Message.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/HTTP/Message.pm (original)
+++ trunk/libwww-perl/lib/HTTP/Message.pm Sat Nov 21 17:34:53 2009
@@ -2,7 +2,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD);
-$VERSION = "5.832";
+$VERSION = "5.834";
require HTTP::Headers;
require Carp;
@@ -301,83 +301,41 @@
next unless $ce;
next if $ce eq "identity";
if ($ce eq "gzip" || $ce eq "x-gzip") {
- require Compress::Zlib;
- unless ($content_ref_iscopy) {
- # memGunzip is documented to destroy its buffer argument
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
- $content_ref = \Compress::Zlib::memGunzip($$content_ref);
- die "Can't gunzip content" unless defined $$content_ref;
+ require IO::Uncompress::Gunzip;
+ my $output;
+ IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0)
+ or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
+ $content_ref = \$output;
+ $content_ref_iscopy++;
}
elsif ($ce eq "x-bzip2") {
- require Compress::Bzip2;
- my $i = Compress::Bzip2::bzinflateInit() or
- die "Can't init bzip2 inflater: $Compress::Bzip2::bzerrno";
- unless ($content_ref_iscopy) {
- # the $i->bzinflate method is documented to destroy its
- # buffer argument
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
- # TODO: operate on the ref when rt#48124 is fixed
- my ($out, $status) = $i->bzinflate($$content_ref);
- my $bzerr = "";
- # TODO: drop $out definedness part when rt#48124 is fixed
- if (!defined($out) &&
- $status != Compress::Bzip2::BZ_STREAM_END()) {
- if ($status == Compress::Bzip2::BZ_OK()) {
- $self->push_header("Client-Warning" =>
- "Content might be truncated; incomplete bzip2 stream");
- }
- else {
- # something went bad, can't trust $out any more
- $out = undef;
- # $bzerrno has more info than $i->bzerror or $status
- $bzerr = ": $Compress::Bzip2::bzerrno";
- }
- }
- die "Can't bunzip content$bzerr" unless defined $out;
- $content_ref = \$out;
+ require IO::Uncompress::Bunzip2;
+ my $output;
+ IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0)
+ or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error";
+ $content_ref = \$output;
$content_ref_iscopy++;
}
elsif ($ce eq "deflate") {
- require Compress::Zlib;
- my $out = Compress::Zlib::uncompress($$content_ref);
- unless (defined $out) {
- # "Content-Encoding: deflate" is supposed to mean the "zlib"
- # format of RFC 1950, but Microsoft got that wrong, so some
- # servers sends the raw compressed "deflate" data. This
- # tries to inflate this format.
- unless ($content_ref_iscopy) {
- # the $i->inflate method is documented to destroy its
- # buffer argument
- my $copy = $$content_ref;
- $content_ref = \$copy;
- $content_ref_iscopy++;
- }
-
- my($i, $status) = Compress::Zlib::inflateInit(
- WindowBits => -Compress::Zlib::MAX_WBITS(),
- );
- my $OK = Compress::Zlib::Z_OK();
- die "Can't init inflate object" unless $i && $status == $OK;
- ($out, $status) = $i->inflate($content_ref);
- if ($status != Compress::Zlib::Z_STREAM_END()) {
- if ($status == $OK) {
- $self->push_header("Client-Warning" =>
- "Content might be truncated; incomplete deflate stream");
- }
- else {
- # something went bad, can't trust $out any more
- $out = undef;
- }
+ require IO::Uncompress::Inflate;
+ my $output;
+ my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0);
+ my $error = $IO::Uncompress::Inflate::InflateError;
+ unless ($status) {
+ # "Content-Encoding: deflate" is supposed to mean the
+ # "zlib" format of RFC 1950, but Microsoft got that
+ # wrong, so some servers sends the raw compressed
+ # "deflate" data. This tries to inflate this format.
+ $output = undef;
+ require IO::Uncompress::RawInflate;
+ unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) {
+ $self->push_header("Client-Warning" =>
+ "Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError");
+ $output = undef;
}
}
- die "Can't inflate content" unless defined $out;
- $content_ref = \$out;
+ die "Can't inflate content: $error" unless defined $output;
+ $content_ref = \$output;
$content_ref_iscopy++;
}
elsif ($ce eq "compress" || $ce eq "x-compress") {
@@ -440,11 +398,16 @@
# XXX preferably we should determine if the modules are available without loading
# them here
eval {
- require Compress::Zlib;
- push(@enc, "gzip", "x-gzip", "deflate");
+ require IO::Uncompress::Gunzip;
+ push(@enc, "gzip", "x-gzip");
};
eval {
- require Compress::Bzip2;
+ require IO::Uncompress::Inflate;
+ require IO::Uncompress::RawInflate;
+ push(@enc, "deflate");
+ };
+ eval {
+ require IO::Uncompress::Bunzip2;
push(@enc, "x-bzip2");
};
# we don't care about announcing the 'identity', 'base64' and
@@ -485,24 +448,25 @@
$content = MIME::Base64::encode($content);
}
elsif ($encoding eq "gzip" || $encoding eq "x-gzip") {
- require Compress::Zlib;
- $content = Compress::Zlib::memGzip($content);
+ require IO::Compress::Gzip;
+ my $output;
+ IO::Compress::Gzip::gzip(\$content, \$output, Minimal => 1)
+ or die "Can't gzip content: $IO::Compress::Gzip::GzipError";
+ $content = $output;
}
elsif ($encoding eq "deflate") {
- require Compress::Zlib;
- $content = Compress::Zlib::compress($content);
+ require IO::Compress::Deflate;
+ my $output;
+ IO::Compress::Deflate::deflate(\$content, \$output)
+ or die "Can't deflate content: $IO::Compress::Deflate::DeflateError";
+ $content = $output;
}
elsif ($encoding eq "x-bzip2") {
- require Compress::Bzip2;
- my $d = Compress::Bzip2::bzdeflateInit() or
- die "Can't init bzip2 deflater: $Compress::Bzip2::bzerrno";
- ($content, my $status) = $d->bzdeflate($content);
- die "Can't bzip content: $Compress::Bzip2::bzerrno"
- unless $status == Compress::Bzip2::BZ_OK();
- (my $rest, $status) = $d->bzclose;
- die "Can't bzip content: $Compress::Bzip2::bzerrno"
- unless $status == Compress::Bzip2::BZ_OK();
- $content .= $rest if defined $rest;
+ require IO::Compress::Bzip2;
+ my $output;
+ IO::Compress::Bzip2::bzip2(\$content, \$output)
+ or die "Can't bzip2 content: $IO::Compress::Bzip2::Bzip2Error";
+ $content = $output;
}
elsif ($encoding eq "rot13") { # for the fun of it
$content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
Modified: trunk/libwww-perl/lib/LWP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP.pm (original)
+++ trunk/libwww-perl/lib/LWP.pm Sat Nov 21 17:34:53 2009
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "5.833";
+$VERSION = "5.834";
sub Version { $VERSION; }
require 5.005;
Modified: trunk/libwww-perl/lib/LWP/Protocol/ftp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol/ftp.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol/ftp.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol/ftp.pm Sat Nov 21 17:34:53 2009
@@ -94,6 +94,7 @@
my $ftp = LWP::Protocol::MyFTP->new($host,
Port => $port,
Timeout => $timeout,
+ LocalAddr => $self->{ua}{local_address},
);
# XXX Should be some what to pass on 'Passive' (header??)
unless ($ftp) {
Modified: trunk/libwww-perl/lib/LWP/Protocol/gopher.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol/gopher.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol/gopher.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol/gopher.pm Sat Nov 21 17:34:53 2009
@@ -120,6 +120,7 @@
# Ok, lets make the request
my $socket = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port,
+ LocalAddr => $self->{ua}{local_address},
Proto => 'tcp',
Timeout => $timeout);
die "Can't connect to $host:$port" unless $socket;
Modified: trunk/libwww-perl/lib/LWP/Protocol/http.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol/http.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol/http.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol/http.pm Sat Nov 21 17:34:53 2009
@@ -30,6 +30,7 @@
local($^W) = 0; # IO::Socket::INET can be noisy
my $sock = $self->socket_class->new(PeerAddr => $host,
PeerPort => $port,
+ LocalAddr => $self->{ua}{local_address},
Proto => 'tcp',
Timeout => $timeout,
KeepAlive => !!$conn_cache,
Modified: trunk/libwww-perl/lib/LWP/UserAgent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/UserAgent.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/UserAgent.pm (original)
+++ trunk/libwww-perl/lib/LWP/UserAgent.pm Sat Nov 21 17:34:53 2009
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.833";
+$VERSION = "5.834";
use HTTP::Request ();
use HTTP::Response ();
@@ -40,6 +40,7 @@
my $def_headers = delete $cnf{default_headers};
my $timeout = delete $cnf{timeout};
$timeout = 3*60 unless defined $timeout;
+ my $local_address = delete $cnf{local_address};
my $use_eval = delete $cnf{use_eval};
$use_eval = 1 unless defined $use_eval;
my $parse_head = delete $cnf{parse_head};
@@ -81,6 +82,7 @@
my $self = bless {
def_headers => $def_headers,
timeout => $timeout,
+ local_address => $local_address,
use_eval => $use_eval,
show_progress=> $show_progress,
max_size => $max_size,
@@ -575,6 +577,7 @@
sub timeout { shift->_elem('timeout', @_); }
+sub local_address{ shift->_elem('local_address', at _); }
sub max_size { shift->_elem('max_size', @_); }
sub max_redirect { shift->_elem('max_redirect', @_); }
sub show_progress{ shift->_elem('show_progress', @_); }
@@ -639,6 +642,8 @@
my $self = shift;
my $old = $self->{def_headers} ||= HTTP::Headers->new;
if (@_) {
+ Carp::croak("default_headers not set to HTTP::Headers compatible object")
+ unless @_ == 1 && $_[0]->can("header_field_names");
$self->{def_headers} = shift;
}
return $old;
@@ -1034,6 +1039,7 @@
conn_cache undef
cookie_jar undef
default_headers HTTP::Headers->new
+ local_address undef
max_size undef
max_redirect 7
parse_head 1
@@ -1170,6 +1176,14 @@
password will only be passed to this server. Example:
$ua->credentials("www.example.com:80", "Some Realm", "foo", "secret");
+
+=item $ua->local_address
+
+=item $ua->local_address( $address )
+
+Get/set the local interface to bind to for network connections. The interface
+can be specified as a hostname or an IP address. This value is passed as the
+C<LocalAddr> argument to L<IO::Socket::INET>.
=item $ua->max_size
Modified: trunk/libwww-perl/lib/Net/HTTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/Net/HTTP.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/Net/HTTP.pm (original)
+++ trunk/libwww-perl/lib/Net/HTTP.pm Sat Nov 21 17:34:53 2009
@@ -3,7 +3,7 @@
use strict;
use vars qw($VERSION @ISA $SOCKET_CLASS);
-$VERSION = "5.833";
+$VERSION = "5.834";
unless ($SOCKET_CLASS) {
eval { require IO::Socket::INET } || require IO::Socket;
$SOCKET_CLASS = "IO::Socket::INET";
@@ -110,9 +110,9 @@
Get/set the a value indicating if the request will be sent with a "TE"
header to indicate the transfer encodings that the server can choose to
-use. If the C<Compress::Zlib> module is installed then this will
-announce that this client accepts both the I<deflate> and I<gzip>
-encodings.
+use. The list of encodings announced as accepted by this client depends
+on availability of the following modules: C<Compress::Raw::Zlib> for
+I<deflate>, and C<IO::Compress::Gunzip> for I<gzip>.
=item $s->http_version
Modified: trunk/libwww-perl/lib/Net/HTTP/Methods.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/Net/HTTP/Methods.pm?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/lib/Net/HTTP/Methods.pm (original)
+++ trunk/libwww-perl/lib/Net/HTTP/Methods.pm Sat Nov 21 17:34:53 2009
@@ -5,7 +5,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = "5.833";
+$VERSION = "5.834";
my $CRLF = "\015\012"; # "\r\n" is not portable
@@ -162,8 +162,8 @@
if ($given{te}) {
push(@connection, "TE") unless grep lc($_) eq "te", @connection;
}
- elsif ($self->send_te && zlib_ok()) {
- # gzip is less wanted since the Compress::Zlib interface for
+ elsif ($self->send_te && gunzip_ok()) {
+ # gzip is less wanted since the IO::Uncompress::Gunzip interface for
# it does not really allow chunked decoding to take place easily.
push(@h2, "TE: deflate,gzip;q=0.3");
push(@connection, "TE");
@@ -417,19 +417,23 @@
unless pop(@te) eq "chunked";
for (@te) {
- if ($_ eq "deflate" && zlib_ok()) {
- #require Compress::Zlib;
- my $i = Compress::Zlib::inflateInit();
- die "Can't make inflator" unless $i;
- $_ = sub { scalar($i->inflate($_[0])) }
+ if ($_ eq "deflate" && inflate_ok()) {
+ #require Compress::Raw::Zlib;
+ my ($i, $status) = Compress::Raw::Zlib::Inflate->new();
+ die "Can't make inflator: $status" unless $i;
+ $_ = sub { my $out; $i->inflate($_[0], \$out); $out }
}
- elsif ($_ eq "gzip" && zlib_ok()) {
- #require Compress::Zlib;
+ elsif ($_ eq "gzip" && gunzip_ok()) {
+ #require IO::Uncompress::Gunzip;
my @buf;
$_ = sub {
push(@buf, $_[0]);
- return Compress::Zlib::memGunzip(join("", @buf)) if $_[1];
- return "";
+ return "" unless $_[1];
+ my $input = join("", @buf);
+ my $output;
+ IO::Uncompress::Gunzip::gunzip(\$input, \$output, Transparent => 0)
+ or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
+ return \$output;
};
}
elsif ($_ eq "identity") {
@@ -549,23 +553,39 @@
}
BEGIN {
-my $zlib_ok;
-
-sub zlib_ok {
- return $zlib_ok if defined $zlib_ok;
-
- # Try to load Compress::Zlib.
+my $gunzip_ok;
+my $inflate_ok;
+
+sub gunzip_ok {
+ return $gunzip_ok if defined $gunzip_ok;
+
+ # Try to load IO::Uncompress::Gunzip.
local $@;
local $SIG{__DIE__};
- $zlib_ok = 0;
+ $gunzip_ok = 0;
eval {
- require Compress::Zlib;
- Compress::Zlib->VERSION(1.10);
- $zlib_ok++;
+ require IO::Uncompress::Gunzip;
+ $gunzip_ok++;
};
- return $zlib_ok;
+ return $gunzip_ok;
+}
+
+sub inflate_ok {
+ return $inflate_ok if defined $inflate_ok;
+
+ # Try to load Compress::Raw::Zlib.
+ local $@;
+ local $SIG{__DIE__};
+ $inflate_ok = 0;
+
+ eval {
+ require Compress::Raw::Zlib;
+ $inflate_ok++;
+ };
+
+ return $inflate_ok;
}
} # BEGIN
Modified: trunk/libwww-perl/t/base/message.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/base/message.t?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/t/base/message.t (original)
+++ trunk/libwww-perl/t/base/message.t Sat Nov 21 17:34:53 2009
@@ -469,19 +469,8 @@
ok($m->decoded_content, "Hello World!");
ok(!$m->header("Client-Warning"));
-if (eval "require Compress::Bzip2") {
- $m = HTTP::Message->new([
- "Content-Type" => "text/plain",
- ],
- "Hello world!"
- );
- ok($m->encode("x-bzip2"));
- ok($m->header("Content-Encoding"), "x-bzip2");
- ok($m->content =~ /^BZh.*\0/);
- ok($m->decoded_content, "Hello world!");
- ok($m->decode);
- ok($m->content, "Hello world!");
-
+
+if (eval "require IO::Uncompress::Bunzip2") {
$m = HTTP::Message->new([
"Content-Type" => "text/plain",
"Content-Encoding" => "x-bzip2, base64",
@@ -491,7 +480,24 @@
ok($m->decoded_content, "Hello world!\n");
ok($m->decode);
ok($m->content, "Hello world!\n");
+
+ if (eval "require IO::Compress::Bzip2") {
+ $m = HTTP::Message->new([
+ "Content-Type" => "text/plain",
+ ],
+ "Hello world!"
+ );
+ ok($m->encode("x-bzip2"));
+ ok($m->header("Content-Encoding"), "x-bzip2");
+ ok($m->content =~ /^BZh.*\0/);
+ ok($m->decoded_content, "Hello world!");
+ ok($m->decode);
+ ok($m->content, "Hello world!");
+ }
+ else {
+ skip("Need IO::Compress::Bzip2", undef) for 1..6;
+ }
}
else {
- skip("Need Compress::Bzip2", undef) for 1..9;
-}
+ skip("Need IO::Uncompress::Bunzip2", undef) for 1..9;
+}
Modified: trunk/libwww-perl/t/base/request.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/base/request.t?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/t/base/request.t (original)
+++ trunk/libwww-perl/t/base/request.t Sat Nov 21 17:34:53 2009
@@ -13,7 +13,7 @@
ok($req->method, "GET");
ok($req->uri, "http://www.example.com");
-ok($req->header("Accept-Encoding") =~ /\bgzip\b/); # assuming Compress::Zlib is there
+ok($req->header("Accept-Encoding") =~ /\bgzip\b/); # assuming IO::Uncompress::Gunzip is there
$req->dump(prefix => "# ");
Modified: trunk/libwww-perl/t/live/apache-listing.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/live/apache-listing.t?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/t/live/apache-listing.t (original)
+++ trunk/libwww-perl/t/live/apache-listing.t Sat Nov 21 17:34:53 2009
@@ -10,7 +10,6 @@
my @urls = (
"http://www.apache.org/dist/apr/?C=N&O=D",
"http://perl.apache.org/rpm/distrib/",
- "http://stein.cshl.org/WWW/software/",
"http://www.cpan.org/modules/by-module/",
);
plan tests => scalar(@urls);
Modified: trunk/libwww-perl/t/local/http.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/local/http.t?rev=47577&op=diff
==============================================================================
--- trunk/libwww-perl/t/local/http.t (original)
+++ trunk/libwww-perl/t/local/http.t Sat Nov 21 17:34:53 2009
@@ -48,7 +48,7 @@
}
use Test;
-plan tests => 52;
+plan tests => 54;
my $greeting = <DAEMON>;
$greeting =~ /(<[^>]+>)/;
@@ -327,6 +327,15 @@
ok($_, qr/^Content-Type:\s*application\/x-www-form-urlencoded$/mi);
ok($_, qr/^foo=bar&bar=test$/m);
+$req = HTTP::Request->new(POST => url("/echo/foo", $base));
+$req->content_type("multipart/form-data");
+$req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "Hi\n"));
+$req->add_part(HTTP::Message->new(["Content-Type" => "text/plain"], "there\n"));
+$res = $ua->request($req);
+#print $res->as_string;
+ok($res->is_success);
+ok($res->content =~ /^Content-Type: multipart\/form-data; boundary=/m);
+
#----------------------------------------------------------------
print "Check partial content response...\n";
sub httpd_get_partial
More information about the Pkg-perl-cvs-commits
mailing list