r59994 - in /branches/upstream/libwww-mechanize-perl/current: Changes META.yml bin/mech-dump lib/WWW/Mechanize.pm lib/WWW/Mechanize/Cookbook.pod lib/WWW/Mechanize/Examples.pod lib/WWW/Mechanize/Image.pm lib/WWW/Mechanize/Link.pm
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Jul 3 03:12:49 UTC 2010
Author: ansgar-guest
Date: Sat Jul 3 03:12:11 2010
New Revision: 59994
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=59994
Log:
[svn-upgrade] new version libwww-mechanize-perl (1.64)
Modified:
branches/upstream/libwww-mechanize-perl/current/Changes
branches/upstream/libwww-mechanize-perl/current/META.yml
branches/upstream/libwww-mechanize-perl/current/bin/mech-dump
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Cookbook.pod
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Examples.pod
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Link.pm
Modified: branches/upstream/libwww-mechanize-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/Changes?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/Changes (original)
+++ branches/upstream/libwww-mechanize-perl/current/Changes Sat Jul 3 03:12:11 2010
@@ -8,7 +8,32 @@
Mech now has its own mailing list at Google Groups:
http://groups.google.com/group/www-mechanize-users
-NEXT Sat Apr 10 23:10:07 CDT 2010
+
+1.64 Thu Jul 1 10:41:00 CDT 2010
+========================================
+[THINGS THAT MAY BREAK YOUR CODE]
+If you've been accessing $mech->{forms} or $mech->{form} values
+directly, instead of going through the $mech->forms or $mech->current_form
+accessors, respectively, then this version of Mech will break your
+code.
+
+[ENHANCEMENTS]
+Parsing of forms has been delayed until they're actually needed.
+If don't use forms on a page, you'll no longer waste time and memory
+parsing them.
+
+$mech->title now caches the title of the page after parsing the
+page to find it.
+
+mech-dump now takes a --cookie-file parameter for keeping cookies
+between calls.
+
+
+[DOCUMENTATION]
+Typo fixes.
+
+
+1.62 Sat Apr 10 23:10:07 CDT 2010
========================================
[FIXED]
Fixed a declaration in the Movable Type example in
Modified: branches/upstream/libwww-mechanize-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/META.yml?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/META.yml (original)
+++ branches/upstream/libwww-mechanize-perl/current/META.yml Sat Jul 3 03:12:11 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: WWW-Mechanize
-version: 1.62
+version: 1.64
abstract: Handy web browsing in a Perl object
author:
- Andy Lester <andy at petdance.com>
Modified: branches/upstream/libwww-mechanize-perl/current/bin/mech-dump
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/bin/mech-dump?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/bin/mech-dump (original)
+++ branches/upstream/libwww-mechanize-perl/current/bin/mech-dump Sat Jul 3 03:12:11 2010
@@ -8,10 +8,11 @@
use warnings;
use strict;
-use WWW::Mechanize;
+use WWW::Mechanize ();
use Getopt::Long;
use Pod::Usage;
+use HTTP::Cookies;
my @actions;
my $absolute;
@@ -19,6 +20,7 @@
my $pass;
my $agent;
my $agent_alias;
+my $cookie_filename;
GetOptions(
'user=s' => \$user,
@@ -31,6 +33,7 @@
absolute => \$absolute,
'agent=s' => \$agent,
'agent-alias=s' => \$agent_alias,
+ 'cookie-file=s' => \$cookie_filename,
help => sub { pod2usage(1); },
) or pod2usage(2);
@@ -40,28 +43,29 @@
Options:
- --headers Dump HTTP response headers
- --forms Dump table of forms (default action)
- --links Dump table of links
- --images Dump table of images
- --all Dump all four of the above, in that order
+ --headers Dump HTTP response headers
+ --forms Dump table of forms (default action)
+ --links Dump table of links
+ --images Dump table of images
+ --all Dump all four of the above, in that order
- --user=user Set the username
- --password=pass Set the password
+ --user=user Set the username
+ --password=pass Set the password
+ --cookie-file=filename Set the filename to use for persistent cookies
- --agent=agent Specify the UserAgent to pass
+ --agent=agent Specify the UserAgent to pass
--agent-alias=alias
- Specify the alias for the UserAgent to pass.
- Pick one of:
- * Windows IE 6
- * Windows Mozilla
- * Mac Safari
- * Mac Mozilla
- * Linux Mozilla
- * Linux Konqueror
+ Specify the alias for the UserAgent to pass.
+ Pick one of:
+ * Windows IE 6
+ * Windows Mozilla
+ * Mac Safari
+ * Mac Mozilla
+ * Linux Mozilla
+ * Linux Konqueror
- --absolute Show URLs as absolute, even if relative in the page
- --help Show this message
+ --absolute Show URLs as absolute, even if relative in the page
+ --help Show this message
The order of the options specified is relevant. Repeated options
get repeated dumps.
@@ -76,13 +80,22 @@
@actions = (\&dump_forms) unless @actions;
-my $mech = WWW::Mechanize->new( cookie_jar => undef );
+my $mech = WWW::Mechanize->new();
if ( defined $agent ) {
$mech->agent( $agent );
}
elsif ( defined $agent_alias ) {
$mech->agent_alias( $agent_alias );
}
+if ( defined $cookie_filename ) {
+ my $cookies = HTTP::Cookies->new( file => $cookie_filename, autosave => 1, ignore_discard => 1 );
+ $cookies->load() ;
+ $mech->cookie_jar($cookies);
+}
+else {
+ $mech->cookie_jar(undef) ;
+}
+
$mech->env_proxy();
my $response = $mech->get( $uri );
if (!$response->is_success and defined ($response->www_authenticate)) {
@@ -124,3 +137,7 @@
$mech->dump_images( undef, $absolute );
return;
}
+
+=head1 SEE ALSO
+
+L<WWW::Mechanize>
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm Sat Jul 3 03:12:11 2010
@@ -6,11 +6,11 @@
=head1 VERSION
-Version 1.62
-
-=cut
-
-our $VERSION = '1.62';
+Version 1.64
+
+=cut
+
+our $VERSION = '1.64';
=head1 SYNOPSIS
@@ -280,7 +280,7 @@
$self->{proxy} = {} unless defined $self->{proxy};
push( @{$self->requests_redirectable}, 'POST' );
- $self->_reset_page;
+ $self->_reset_page();
return $self;
}
@@ -559,7 +559,6 @@
sub ct { my $self = shift; return $self->{ct}; }
sub content_type { my $self = shift; return $self->{ct}; }
sub base { my $self = shift; return $self->{base}; }
-sub current_form { my $self = shift; return $self->{form}; }
sub is_html { my $self = shift; return defined $self->ct && ($self->ct eq 'text/html'); }
=head2 $mech->title()
@@ -571,12 +570,16 @@
sub title {
my $self = shift;
+
return unless $self->is_html;
- require HTML::HeadParser;
- my $p = HTML::HeadParser->new;
- $p->parse($self->content);
- return $p->header('Title');
+ if ( not defined $self->{title} ) {
+ require HTML::HeadParser;
+ my $p = HTML::HeadParser->new;
+ $p->parse($self->content);
+ $self->{title} = $p->header('Title');
+ }
+ return $self->{title};
}
=head1 CONTENT-HANDLING METHODS
@@ -686,7 +689,7 @@
sub links {
my $self = shift;
- $self->_extract_links() unless $self->{_extracted_links};
+ $self->_extract_links() unless $self->{links};
return @{$self->{links}} if wantarray;
return $self->{links};
@@ -1055,7 +1058,7 @@
sub images {
my $self = shift;
- $self->_extract_images() unless $self->{_extracted_images};
+ $self->_extract_images() unless $self->{images};
return @{$self->{images}} if wantarray;
return $self->{images};
@@ -1213,10 +1216,22 @@
sub forms {
my $self = shift;
+
+ $self->_extract_forms() unless $self->{forms};
+
return @{$self->{forms}} if wantarray;
return $self->{forms};
}
+sub current_form {
+ my $self = shift;
+
+ if ( !$self->{current_form} ) {
+ $self->form_number(1);
+ }
+
+ return $self->{current_form};
+}
=head2 $mech->form_number($number)
@@ -1237,9 +1252,10 @@
my ($self, $form) = @_;
# XXX Should we die if no $form is defined? Same question for form_name()
- if ($self->{forms}->[$form-1]) {
- $self->{form} = $self->{forms}->[$form-1];
- return $self->{form};
+ my $forms = $self->forms;
+ if ( $forms->[$form-1] ) {
+ $self->{current_form} = $forms->[$form-1];
+ return $self->{current_form};
}
return;
@@ -1264,10 +1280,13 @@
my $temp;
my @matches = grep {defined($temp = $_->attr('name')) and ($temp eq $form) } $self->forms;
- if ( my $nmatches = @matches ) {
- $self->warn( "There are $nmatches forms named $form. The first one was used." )
- if $nmatches > 1;
- return $self->{form} = $matches[0];
+
+ my $nmatches = @matches;
+ if ( $nmatches > 0 ) {
+ if ( $nmatches > 1 ) {
+ $self->warn( "There are $nmatches forms named $form. The first one was used." )
+ }
+ return $self->{current_form} = $matches[0];
}
return;
@@ -1294,7 +1313,7 @@
if ( @matches ) {
$self->warn( 'There are ', scalar @matches, " forms with ID $formid. The first one was used." )
if @matches > 1;
- return $self->{form} = $matches[0];
+ return $self->{current_form} = $matches[0];
}
else {
$self->warn( qq{ There is no form with ID "$formid"} );
@@ -1331,10 +1350,12 @@
push @matches, $form;
}
- if ( my $nmatches = @matches ) {
- $self->warn( "There are $nmatches forms with the named fields. The first one was used." )
- if $nmatches > 1;
- return $self->{form} = $matches[0];
+ my $nmatches = @matches;
+ if ( $nmatches > 0 ) {
+ if ( $nmatches > 1 ) {
+ $self->warn( "There are $nmatches forms with the named fields. The first one was used." )
+ }
+ return $self->{current_form} = $matches[0];
}
else {
$self->warn( qq{There is no form with the requested fields} );
@@ -1364,7 +1385,7 @@
my ($self, $name, $value, $number) = @_;
$number ||= 1;
- my $form = $self->{form};
+ my $form = $self->current_form();
if ($number > 1) {
$form->find_input($name, undef, $number)->value($value);
}
@@ -1404,7 +1425,7 @@
sub select {
my ($self, $name, $value) = @_;
- my $form = $self->{form};
+ my $form = $self->current_form();
my $input = $form->find_input($name);
if (!$input) {
@@ -1647,7 +1668,7 @@
my $name = shift;
my $number = shift || 1;
- my $form = $self->{form};
+ my $form = $self->current_form;
if ( $number > 1 ) {
return $form->find_input( $name, undef, $number )->value();
}
@@ -1673,7 +1694,7 @@
sub click {
my ($self, $button, $x, $y) = @_;
for ($x, $y) { $_ = 1 unless defined; }
- my $request = $self->{form}->click($button, $x, $y);
+ my $request = $self->current_form->click($button, $x, $y);
return $self->request( $request );
}
@@ -1732,7 +1753,7 @@
$_ = 1 unless defined;
}
- my $form = $self->{form} or $self->die( 'click_button: No form has been selected' );
+ my $form = $self->current_form or $self->die( 'click_button: No form has been selected' );
my $request;
if ( $args{name} ) {
@@ -1774,7 +1795,7 @@
sub submit {
my $self = shift;
- my $request = $self->{form}->make_request;
+ my $request = $self->current_form->make_request;
return $self->request( $request );
}
@@ -2232,17 +2253,7 @@
$self->{ct} = 'text/html';
$self->{content} = $html;
- $self->{forms} = [ HTML::Form->parse($html, $self->base) ];
- for my $form (@{ $self->{forms} }) {
- for my $input ($form->inputs) {
- if ($input->type eq 'file') {
- $input->value( undef );
- }
- }
- }
- $self->{form} = $self->{forms}->[0];
- $self->{_extracted_links} = 0;
- $self->{_extracted_images} = 0;
+ $self->_reset_page();
return;
}
@@ -2456,13 +2467,11 @@
sub _reset_page {
my $self = shift;
- $self->{_extracted_links} = 0;
- $self->{_extracted_images} = 0;
- $self->{links} = [];
- $self->{images} = [];
- $self->{forms} = [];
-
- delete $self->{form};
+ $self->{links} = undef;
+ $self->{images} = undef;
+ $self->{forms} = undef;
+ $self->{current_form} = undef;
+ $self->{title} = undef;
return;
}
@@ -2496,8 +2505,6 @@
} # while
}
- $self->{_extracted_links} = 1;
-
return;
}
@@ -2519,8 +2526,6 @@
push( @{$self->{images}}, $image ) if $image;
} # while
}
-
- $self->{_extracted_images} = 1;
return;
}
@@ -2606,6 +2611,23 @@
});
} # _link_from_token
+
+sub _extract_forms {
+ my $self = shift;
+
+ my @forms = HTML::Form->parse( $self->content, $self->base );
+ $self->{forms} = \@forms;
+ for my $form ( @forms ) {
+ for my $input ($form->inputs) {
+ if ($input->type eq 'file') {
+ $input->value( undef );
+ }
+ }
+ }
+
+ return;
+}
+
=head2 $mech->_push_page_stack()
The agent keeps a stack of visited pages, which it can pop when it needs
@@ -2852,6 +2874,7 @@
Thanks to the numerous people who have helped out on WWW::Mechanize in
one way or another, including
Kirrily Robert for the original C<WWW::Automate>,
+Ansgar Burchardt,
Gisle Aas,
Jeremy Ary,
Hilary Holz,
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Cookbook.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Cookbook.pod?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Cookbook.pod (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Cookbook.pod Sat Jul 3 03:12:11 2010
@@ -72,10 +72,15 @@
Use Abe Timmerman's L<WWW::CheckSite>
L<http://search.cpan.org/dist/WWW-CheckSite/>
+=head1 SEE ALSO
+
+L<WWW::Mechanize>
+
=head1 AUTHORS
-Copyright 2005 Andy Lester C<< <andy at petdance.com> >>
+Copyright 2005-2010 Andy Lester C<< <andy at petdance.com> >>
-Later contributions by Peter Scott, Mark Stosberg and others.
+Later contributions by Peter Scott, Mark Stosberg and others. See
+Acknowledgements section in L<WWW::Mechanize> for more.
=cut
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Examples.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Examples.pod?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Examples.pod (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Examples.pod Sat Jul 3 03:12:11 2010
@@ -492,7 +492,7 @@
use strict;
use WWW::Mechanize;
- # a tool to automatically post entries to a moveable type weblog, and set arbitary creation dates
+ # a tool to automatically post entries to a moveable type weblog, and set arbitrary creation dates
my $mech = WWW::Mechanize->new();
my $entry;
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm Sat Jul 3 03:12:11 2010
@@ -116,11 +116,26 @@
return $self->URI->abs;
}
-=head1 COPYRIGHT
+=head1 SEE ALSO
-Copyright (c) 2004 Andy Lester. All rights reserved. This program is
-free software; you can redistribute it and/or modify it under the same
-terms as Perl itself.
+L<WWW::Mechanize> and L<WWW::Mechanize::Link>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2004-2010 Andy Lester.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of either:
+
+=over 4
+
+=item * the GNU General Public License as published by the Free
+Software Foundation; either version 1, or (at your option) any later
+version, or
+
+=item * the Artistic License version 2.0.
+
+=back
=cut
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Link.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Link.pm?rev=59994&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Link.pm (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Link.pm Sat Jul 3 03:12:11 2010
@@ -112,11 +112,26 @@
return $self->URI->abs;
}
-=head1 COPYRIGHT
+=head1 SEE ALSO
-Copyright (c) 2004-2008 Andy Lester. All rights reserved. This program is
-free software; you can redistribute it and/or modify it under the same
-terms as Perl itself.
+L<WWW::Mechanize> and L<WWW::Mechanize::Image>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2004-2010 Andy Lester.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of either:
+
+=over 4
+
+=item * the GNU General Public License as published by the Free
+Software Foundation; either version 1, or (at your option) any later
+version, or
+
+=item * the Artistic License version 2.0.
+
+=back
=cut
More information about the Pkg-perl-cvs-commits
mailing list