r39559 - in /trunk/libwww-perl: Changes MANIFEST META.yml debian/changelog lib/HTML/Form.pm lib/LWP.pm lib/LWP/Protocol.pm lib/LWP/UserAgent.pm t/html/form-selector.t t/html/form.t
nhandler-guest at users.alioth.debian.org
nhandler-guest at users.alioth.debian.org
Thu Jul 9 17:26:39 UTC 2009
Author: nhandler-guest
Date: Thu Jul 9 17:26:32 2009
New Revision: 39559
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39559
Log:
Update to 5.829
Added:
trunk/libwww-perl/t/html/form-selector.t
- copied unchanged from r39558, branches/upstream/libwww-perl/current/t/html/form-selector.t
Modified:
trunk/libwww-perl/Changes
trunk/libwww-perl/MANIFEST
trunk/libwww-perl/META.yml
trunk/libwww-perl/debian/changelog
trunk/libwww-perl/lib/HTML/Form.pm
trunk/libwww-perl/lib/LWP.pm
trunk/libwww-perl/lib/LWP/Protocol.pm
trunk/libwww-perl/lib/LWP/UserAgent.pm
trunk/libwww-perl/t/html/form.t
Modified: trunk/libwww-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/Changes?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/Changes (original)
+++ trunk/libwww-perl/Changes Thu Jul 9 17:26:32 2009
@@ -1,3 +1,32 @@
+_______________________________________________________________________________
+2009-07-07 Release 5.829
+
+This release removes callback handlers that were left over on the returned
+HTTP::Responses. This was problematic because it created reference loops
+preventing the Perl garbage collector from releasing their memory. Another
+problem was that Storable by default would not serialize these objects any
+more.
+
+This release also adds support for locating HTML::Form inputs by id or class
+attribute; for instance $form->value("#foo", 42) will set the value on the
+input with the ID of "foo".
+
+
+Gisle Aas (5):
+ Make the example code 'use strict' clean by adding a my
+ Avoid cycle in response
+ Clean up handlers has from response after data processing is done
+ Support finding inputs by id or class in HTML::Form
+ Test HTML::Form selectors
+
+Mark Stosberg (1):
+ Tidy and document the internals of mirror() better [RT#23450]
+
+phrstbrn (1):
+ Avoid warnings from HTML::Form [RT#42654]
+
+
+
_______________________________________________________________________________
2009-06-25 Release 5.828
Modified: trunk/libwww-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/MANIFEST?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/MANIFEST (original)
+++ trunk/libwww-perl/MANIFEST Thu Jul 9 17:26:32 2009
@@ -93,6 +93,7 @@
t/html/form-param.t More HTML::Form tests.
t/html/form-multi-select.t More HTML::Form tests
t/html/form-maxlength.t More HTML::Form tests
+t/html/form-selector.t More HTML::Form tests
t/live/apache.t
t/live/apache-listing.t Test File::Listing::apache package
t/live/https.t
Modified: trunk/libwww-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/META.yml?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/META.yml (original)
+++ trunk/libwww-perl/META.yml Thu Jul 9 17:26:32 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 5.828
+version: 5.829
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas <gisle at activestate.com>
Modified: trunk/libwww-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/debian/changelog?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/debian/changelog (original)
+++ trunk/libwww-perl/debian/changelog Thu Jul 9 17:26:32 2009
@@ -1,3 +1,9 @@
+libwww-perl (5.829-1) UNRELEASED; urgency=low
+
+ * (NOT RELEASED YET) New upstream release
+
+ -- Nathan Handler <nhandler at ubuntu.com> Thu, 09 Jul 2009 17:24:39 +0000
+
libwww-perl (5.828-1) unstable; urgency=low
* New upstream release
Modified: trunk/libwww-perl/lib/HTML/Form.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/HTML/Form.pm?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/lib/HTML/Form.pm (original)
+++ trunk/libwww-perl/lib/HTML/Form.pm Thu Jul 9 17:26:32 2009
@@ -5,7 +5,7 @@
use Carp ();
use vars qw($VERSION $Encode_available);
-$VERSION = "5.827";
+$VERSION = "5.829";
eval { require Encode };
$Encode_available = !$@;
@@ -242,7 +242,9 @@
if exists $attr->{$_};
}
# count this new select option separately
- $openselect{$attr->{name}}++;
+ my $name = $attr->{name};
+ $name = "" unless defined $name;
+ $openselect{$name}++;
while ($t = $p->get_tag) {
my $tag = shift @$t;
@@ -262,7 +264,7 @@
$a{value_name} = $p->get_trimmed_text;
$a{value} = delete $a{value_name}
unless defined $a{value};
- $a{idx} = $openselect{$attr->{name}};
+ $a{idx} = $openselect{$name};
$f->push_input("option", \%a, $verbose);
}
else {
@@ -452,17 +454,20 @@
}
-=item $input = $form->find_input( $name )
-
-=item $input = $form->find_input( $name, $type )
-
-=item $input = $form->find_input( $name, $type, $index )
+=item $input = $form->find_input( $selector )
+
+=item $input = $form->find_input( $selector, $type )
+
+=item $input = $form->find_input( $selector, $type, $index )
This method is used to locate specific inputs within the form. All
inputs that match the arguments given are returned. In scalar context
only the first is returned, or C<undef> if none match.
-If $name is specified, then the input must have the indicated name.
+If $selector is specified, then the input's name, id, class attribute must
+match. A selector prefixed with '#' must match the id attribute of the input.
+A selector prefixed with '.' matches the class attribute. A selector prefixed
+with '^' or with no prefix matches the name attribute.
If $type is specified, then the input must have the specified type.
The following type names are used: "text", "password", "hidden",
@@ -481,10 +486,7 @@
my @res;
my $c;
for (@{$self->{'inputs'}}) {
- if (defined $name) {
- next unless exists $_->{name};
- next if $name ne $_->{name};
- }
+ next if defined($name) && !$_->selected($name);
next if $type && $type ne $_->{type};
$c++;
next if $no && $no != $c;
@@ -496,10 +498,7 @@
else {
$no ||= 1;
for (@{$self->{'inputs'}}) {
- if (defined $name) {
- next unless exists $_->{name};
- next if $name ne $_->{name};
- }
+ next if defined($name) && !$_->selected($name);
next if $type && $type ne $_->{type};
next if --$no;
return $_;
@@ -517,9 +516,9 @@
}
-=item $value = $form->value( $name )
-
-=item $form->value( $name, $new_value )
+=item $value = $form->value( $selector )
+
+=item $form->value( $selector, $new_value )
The value() method can be used to get/set the value of some input. If
strict is enabled and no input has the indicated name, then this method will croak.
@@ -720,23 +719,24 @@
=item $request = $form->click
-=item $request = $form->click( $name )
+=item $request = $form->click( $selector )
=item $request = $form->click( $x, $y )
-=item $request = $form->click( $name, $x, $y )
+=item $request = $form->click( $selector, $x, $y )
Will "click" on the first clickable input (which will be of type
C<submit> or C<image>). The result of clicking is an C<HTTP::Request>
object that can then be passed to C<LWP::UserAgent> if you want to
obtain the server response.
-If a $name is specified, we will click on the first clickable input
-with the given name, and the method will croak if no clickable input
-with the given name is found. If $name is I<not> specified, then it
+If a $selector is specified, we will click on the first clickable input
+matching the selector, and the method will croak if no matching clickable
+input is found. If $selector is I<not> specified, then it
is ok if the form contains no clickable inputs. In this case the
click() method returns the same request as the make_request() method
-would do.
+would do. See description of the find_input() method above for how
+the $selector is specified.
If there are multiple clickable inputs with the same name, then there
is no way to get the click() method of the C<HTML::Form> to click on
@@ -761,7 +761,7 @@
# try to find first submit button to activate
for (@{$self->{'inputs'}}) {
next unless $_->can("click");
- next if $name && $_->name ne $name;
+ next if $name && !$_->selected($name);
next if $_->disabled;
return $_->click($self, @_);
}
@@ -896,6 +896,17 @@
This method can be used to get/set the current name of the input.
+=item $input->id
+
+=item $input->class
+
+These methods can be used to get/set the current id or class attribute for the input.
+
+=item $input->selected( $selector )
+
+Returns TRUE if the given selector matched the input. See the description of
+the find_input() method above for a description of the selector syntax.
+
=item $value = $input->value
=item $input->value( $new_value )
@@ -918,6 +929,34 @@
my $old = $self->{name};
$self->{name} = shift if @_;
$old;
+}
+
+sub id
+{
+ my $self = shift;
+ my $old = $self->{id};
+ $self->{id} = shift if @_;
+ $old;
+}
+
+sub class
+{
+ my $self = shift;
+ my $old = $self->{class};
+ $self->{class} = shift if @_;
+ $old;
+}
+
+sub selected {
+ my($self, $sel) = @_;
+ return undef unless defined $sel;
+ my $attr =
+ $sel =~ s/^\^// ? "name" :
+ $sel =~ s/^#// ? "id" :
+ $sel =~ s/^\.// ? "class" :
+ "name";
+ return 0 unless defined $self->{$attr};
+ return $self->{$attr} eq $sel;
}
sub value
Modified: trunk/libwww-perl/lib/LWP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP.pm?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP.pm (original)
+++ trunk/libwww-perl/lib/LWP.pm Thu Jul 9 17:26:32 2009
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "5.828";
+$VERSION = "5.829";
sub Version { $VERSION; }
require 5.005;
@@ -295,7 +295,7 @@
# Create a user agent object
use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
+ my $ua = LWP::UserAgent->new;
$ua->agent("MyApp/0.1 ");
# Create a request
Modified: trunk/libwww-perl/lib/LWP/Protocol.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/Protocol.pm?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/Protocol.pm (original)
+++ trunk/libwww-perl/lib/LWP/Protocol.pm Thu Jul 9 17:26:32 2009
@@ -2,7 +2,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.826";
+$VERSION = "5.829";
use strict;
use Carp ();
@@ -161,9 +161,12 @@
}
}
};
- if ($@) {
- chomp($@);
- $response->push_header('X-Died' => $@);
+ my $err = $@;
+ delete $response->{handlers}{response_data};
+ delete $response->{handlers} unless %{$response->{handlers}};
+ if ($err) {
+ chomp($err);
+ $response->push_header('X-Died' => $err);
$response->push_header("Client-Aborted", "die");
return $response;
}
Modified: trunk/libwww-perl/lib/LWP/UserAgent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/lib/LWP/UserAgent.pm?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/lib/LWP/UserAgent.pm (original)
+++ trunk/libwww-perl/lib/LWP/UserAgent.pm Thu Jul 9 17:26:32 2009
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "5.827";
+$VERSION = "5.829";
use HTTP::Request ();
use HTTP::Response ();
@@ -595,8 +595,9 @@
return unless $parser;
unless ($parser->parse($_[3])) {
my $h = $parser->header;
+ my $r = $_[0];
for my $f ($h->header_field_names) {
- $response->init_header($f, [$h->header($f)]);
+ $r->init_header($f, [$h->header($f)]);
}
undef($parser);
}
@@ -823,47 +824,50 @@
my $request = HTTP::Request->new('GET', $url);
- if (-e $file) {
- my($mtime) = (stat($file))[9];
- if($mtime) {
- $request->header('If-Modified-Since' =>
- HTTP::Date::time2str($mtime));
- }
+ # If the file exists, add a cache-related header
+ if ( -e $file ) {
+ my ($mtime) = ( stat($file) )[9];
+ if ($mtime) {
+ $request->header( 'If-Modified-Since' => HTTP::Date::time2str($mtime) );
+ }
}
my $tmpfile = "$file-$$";
my $response = $self->request($request, $tmpfile);
- if ($response->is_success) {
-
- my $file_length = (stat($tmpfile))[7];
- my($content_length) = $response->header('Content-length');
-
- if (defined $content_length and $file_length < $content_length) {
- unlink($tmpfile);
- die "Transfer truncated: " .
- "only $file_length out of $content_length bytes received\n";
- }
- elsif (defined $content_length and $file_length > $content_length) {
- unlink($tmpfile);
- die "Content-length mismatch: " .
- "expected $content_length bytes, got $file_length\n";
- }
- else {
- # OK
- if (-e $file) {
- # Some dosish systems fail to rename if the target exists
- chmod 0777, $file;
- unlink $file;
- }
- rename($tmpfile, $file) or
- die "Cannot rename '$tmpfile' to '$file': $!\n";
-
- if (my $lm = $response->last_modified) {
- # make sure the file has the same last modification time
- utime $lm, $lm, $file;
- }
- }
- }
+
+ # Only fetching a fresh copy of the would be considered success.
+ # If the file was not modified, "304" would returned, which
+ # is considered by HTTP::Status to be a "redirect", /not/ "success"
+ if ( $response->is_success ) {
+ my $file_length = ( stat($tmpfile) )[7];
+ my ($content_length) = $response->header('Content-length');
+
+ if ( defined $content_length and $file_length < $content_length ) {
+ unlink($tmpfile);
+ die "Transfer truncated: " . "only $file_length out of $content_length bytes received\n";
+ }
+ elsif ( defined $content_length and $file_length > $content_length ) {
+ unlink($tmpfile);
+ die "Content-length mismatch: " . "expected $content_length bytes, got $file_length\n";
+ }
+ # The file was the expected length.
+ else {
+ # Replace the stale file with a fresh copy
+ if ( -e $file ) {
+ # Some dosish systems fail to rename if the target exists
+ chmod 0777, $file;
+ unlink $file;
+ }
+ rename( $tmpfile, $file )
+ or die "Cannot rename '$tmpfile' to '$file': $!\n";
+
+ # make sure the file has the same last modification time
+ if ( my $lm = $response->last_modified ) {
+ utime $lm, $lm, $file;
+ }
+ }
+ }
+ # The local copy is fresh enough, so just delete the temp file
else {
unlink($tmpfile);
}
Modified: trunk/libwww-perl/t/html/form.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwww-perl/t/html/form.t?rev=39559&op=diff
==============================================================================
--- trunk/libwww-perl/t/html/form.t (original)
+++ trunk/libwww-perl/t/html/form.t Thu Jul 9 17:26:32 2009
@@ -3,7 +3,7 @@
use strict;
use Test qw(plan ok);
-plan tests => 126;
+plan tests => 127;
use HTML::Form;
@@ -581,3 +581,15 @@
EOT
ok(join(":", $f->find_input("test")->possible_values), "1:2");
ok(join(":", $f->find_input("test")->other_possible_values), "2");
+
+ at warn = ();
+$f = HTML::Form->parse(<<EOT, "http://www.example.com");
+<form>
+<select id="myselect">
+<option>one</option>
+<option>two</option>
+<option>three</option>
+</select>
+</form>
+EOT
+ok(@warn, 0);
More information about the Pkg-perl-cvs-commits
mailing list