r10640 - in /branches/upstream/libwww-mechanize-perl/current: ./ bin/ lib/WWW/ lib/WWW/Mechanize/ t/ t/live/ t/local/
rmayorga-guest at users.alioth.debian.org
rmayorga-guest at users.alioth.debian.org
Sat Dec 1 22:07:16 UTC 2007
Author: rmayorga-guest
Date: Sat Dec 1 22:07:16 2007
New Revision: 10640
URL: http://svn.debian.org/wsvn/?sc=1&rev=10640
Log:
[svn-upgrade] Integrating new upstream version, libwww-mechanize-perl (1.32)
Added:
branches/upstream/libwww-mechanize-perl/current/t/find_link_id.html
branches/upstream/libwww-mechanize-perl/current/t/find_link_id.t
Modified:
branches/upstream/libwww-mechanize-perl/current/Changes
branches/upstream/libwww-mechanize-perl/current/MANIFEST
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/FAQ.pod
branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm
branches/upstream/libwww-mechanize-perl/current/t/autocheck.t
branches/upstream/libwww-mechanize-perl/current/t/find_link.t
branches/upstream/libwww-mechanize-perl/current/t/live/computers4sure.t
branches/upstream/libwww-mechanize-perl/current/t/live/wikipedia.t
branches/upstream/libwww-mechanize-perl/current/t/local/failure.t
branches/upstream/libwww-mechanize-perl/current/t/new.t
branches/upstream/libwww-mechanize-perl/current/t/taint.t
Modified: branches/upstream/libwww-mechanize-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/Changes?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/Changes (original)
+++ branches/upstream/libwww-mechanize-perl/current/Changes Sat Dec 1 22:07:16 2007
@@ -1,9 +1,48 @@
Revision history for WWW::Mechanize
+1.32 Tue Oct 30 12:02:17 CDT 2007
+========================================
+Please note that WWW::Mechanize and Test::WWW::Mechanize are no
+longer using rt.cpan.org for bug tracking. They are now being
+tracked via Google Code at
+http://code.google.com/p/www-mechanize/issues/list
+
+[ENHANCEMENTS]
+Added dump methods to mirror mech-dump:
+* $mech->dump_images()
+* $mech->dump_links()
+* $mech->dump_forms()
+$ $mech->dump_all()
+
+Sanity checks in the WWW::Mechanize::Image constructor. Every Image
+must have a "url" and "tag" field passed in to it.
+
+
+1.31_02 Thu Oct 25 11:48:29 CDT 2007
+========================================
+[ENHANCEMENTS]
+Added class, class_regex, id and id_regex limiters to find_link()
+and find_all_links(). Thanks to Adriano Ferreira.
+
+
+1.31_01 Mon Sep 17 23:38:03 CDT 2007
+========================================
+[FIXES]
+Mech tests now pass even if your DNS server gives A records for
+anything (like OpenDNS). Thanks, Miyagawa!
+
+Searching for the <base href> is now case-inensitive. A better
+solution would be to actually parse the HTML.
+
+[ENHANCEMENTS]
+mech-dump now handles --user and --password arguments for sites
+that require authentication.
+
+
1.30 Thu May 24 21:31:10 CDT 2007
========================================
[DOCUMENTATION]
-* Minor doc fixes. Thanks David Steinbrunner.
+Minor doc fixes. Thanks David Steinbrunner.
1.29_01 Tue May 22 14:02:55 CDT 2007
@@ -12,29 +51,31 @@
handle the warnings thrown by the tests, other than hiding them.
[FIXES]
-* Overhauled how tainting was done. Stole code directly from
- Test::Taint.
-* Have LWP only handle decoding of Content-Encoding, not charset.
+Overhauled how tainting was done. Stole code directly from
+Test::Taint.
+
+Have LWP only handle decoding of Content-Encoding, not charset.
[DOCUMENTATION]
-* Fixed the docs for $mech->submit_form()'s with_fields arg.
- Thanks, Peteris Krumins.
+Fixed the docs for $mech->submit_form()'s with_fields arg.
+Thanks, Peteris Krumins.
1.26 Wed May 16 14:21:29 CDT 2007
========================================
[FIXES]
-* Re-reversed the content decoding. This is critical for reading from
- sites with gzip on the fly, like Wikipedia.
-* Content is now properly tainted.
+Re-reversed the content decoding. This is critical for reading from
+sites with gzip on the fly, like Wikipedia.
+
+Content is now properly tainted.
[ENHANCEMENTS]
-* mech-dump can now pass --agent and --agent-alias flags so you can
- fetch from sites like Wikipedia that block LWP user agents.
+mech-dump can now pass --agent and --agent-alias flags so you can
+fetch from sites like Wikipedia that block LWP user agents.
[INSTALLATION]
-* The mech-dump program is now always installed. It no longer is
- presented as an option.
+The mech-dump program is now always installed. It no longer is
+presented as an option.
1.24 Fri May 11 15:57:56 CDT 2007
Modified: branches/upstream/libwww-mechanize-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/MANIFEST?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/MANIFEST (original)
+++ branches/upstream/libwww-mechanize-perl/current/MANIFEST Sat Dec 1 22:07:16 2007
@@ -24,12 +24,14 @@
t/die.t
t/field.html
t/field.t
+t/find_image.t
t/find_inputs.html
t/find_inputs.t
+t/find_link-warnings.t
t/find_link.html
t/find_link.t
-t/find_image.t
-t/find_link-warnings.t
+t/find_link_id.html
+t/find_link_id.t
t/form-parsing.t
t/frames.html
t/frames.t
@@ -52,8 +54,8 @@
t/tick.t
t/upload.html
t/upload.t
+t/warn.t
t/warnings.t
-t/warn.t
t/live/computers4sure.t
t/live/wikipedia.t
Modified: branches/upstream/libwww-mechanize-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/META.yml?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/META.yml (original)
+++ branches/upstream/libwww-mechanize-perl/current/META.yml Sat Dec 1 22:07:16 2007
@@ -1,10 +1,9 @@
--- #YAML:1.0
name: WWW-Mechanize
-version: 1.30
+version: 1.32
abstract: Handy web browsing in a Perl object
-license: unknown
-generated_by: ExtUtils::MakeMaker version 6.30_01
-author: Andy Lester <andy at petdance.com>
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.36
distribution_type: module
requires:
Carp: 0
@@ -26,5 +25,7 @@
URI::file: 0
URI::URL: 0
meta-spec:
- url: <http://module-build.sourceforge.net/META-spec-new.html>;
- version: 1.1
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Andy Lester <andy at petdance.com>
Modified: branches/upstream/libwww-mechanize-perl/current/bin/mech-dump
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/bin/mech-dump?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/bin/mech-dump (original)
+++ branches/upstream/libwww-mechanize-perl/current/bin/mech-dump Sat Dec 1 22:07:16 2007
@@ -15,10 +15,14 @@
my @actions;
my $absolute;
+my $user;
+my $pass;
my $agent;
my $agent_alias;
GetOptions(
+ 'user=s' => \$user,
+ 'password=s' => \$pass,
forms => sub { push( @actions, \&dump_forms ); },
links => sub { push( @actions, \&dump_links ); },
images => sub { push( @actions, \&dump_images ); },
@@ -39,6 +43,9 @@
--links Dump table of links
--images Dump table of images
--all Dump all three of the above, in that order
+
+ --user=user Set the username
+ --password=pass Set the password
--agent=agent Specify the UserAgent to pass
--agent-alias=alias
@@ -74,9 +81,16 @@
elsif ( defined $agent_alias ) {
$mech->agent_alias( $agent_alias );
}
-
+$mech->env_proxy();
my $response = $mech->get( $uri );
-$response->is_success or die "Can't fetch $uri\n", $response->status_line, "\n";
+if (!$response->is_success and defined ($response->www_authenticate)) {
+ if (!defined $user or !defined $pass) {
+ die("Page requires username and password, but none specified.\n");
+ }
+ $mech->credentials($user,$pass);
+ $response = $mech->get( $uri );
+ $response->is_success or die "Can't fetch $uri with username and password\n", $response->status_line, "\n";
+}
$mech->is_html or die qq{$uri returns type "}, $mech->ct, qq{", not "text/html"\n};
for my $action ( @actions ) {
@@ -85,39 +99,18 @@
sub dump_links {
my $mech = shift;
- for my $link ( $mech->links ) {
- my $url = $absolute ? $link->url_abs : $link->url;
- print "$url\n";
- }
+ $mech->dump_links( undef, $absolute );
return;
}
sub dump_images {
my $mech = shift;
-
- for my $image ( $mech->images ) {
- my $url = $absolute ? $image->url_abs : $image->url;
- print "$url\n";
- }
+ $mech->dump_images( undef, $absolute );
return;
}
sub dump_forms {
my $mech = shift;
-
- for my $form ( $mech->forms() ) {
- print $form->dump;
- print "\n";
- }
+ $mech->dump_forms( undef, $absolute );
return;
}
-
-=head1 TODO
-
-=over 4
-
-=item * Options for C<--user>, C<--pass> and C<--proxy>.
-
-=back
-
-=cut
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize.pm Sat Dec 1 22:07:16 2007
@@ -6,11 +6,11 @@
=head1 VERSION
-Version 1.30
-
-=cut
-
-our $VERSION = '1.30';
+Version 1.32
+
+=cut
+
+our $VERSION = '1.32';
=head1 SYNOPSIS
@@ -57,7 +57,7 @@
$mech->back();
-If you want finer control over over your page fetching, you can use
+If you want finer control over your page fetching, you can use
these methods. C<follow_link> and C<submit_form> are just high
level wrappers around them.
@@ -81,6 +81,12 @@
=over 4
+=item * L<http://code.google.com/p/www-mechanize/issues/list>
+
+The queue for bugs & enhancements in WWW::Mechanize and
+Test::WWW::Mechanize. Please note that the queue at L<http://rt.cpan.org>
+is no longer maintained.
+
=item * L<http://search.cpan.org/dist/WWW-Mechanize/>
The CPAN documentation page for Mechanize.
@@ -88,11 +94,6 @@
=item * L<http://search.cpan.org/dist/WWW-Mechanize/lib/WWW/Mechanize/FAQ.pod>
Frequently asked questions. Make sure you read here FIRST.
-
-=item * L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize>
-
-The RT queue for bugs & enhancements in Mechanize. Click the "Report bug"
-link if your bug isn't already reported.
=back
@@ -177,7 +178,7 @@
=item * C<< stack_depth => $value >>
-Sets the depth of the page stack that keeps tracks of all the downloaded
+Sets the depth of the page stack that keeps track of all the downloaded
pages. Default is 0 (infinite). If the stack is eating up your memory,
then set it to 1.
@@ -198,7 +199,7 @@
onwarn => \&WWW::Mechanize::_warn,
onerror => \&WWW::Mechanize::_die,
quiet => 0,
- stack_depth => 867_5309, # Arbitrarily humungous stack
+ stack_depth => 8675309, # Arbitrarily humongous stack
headers => {},
);
@@ -553,7 +554,7 @@
my %parms = @_;
if ( exists $parms{base_href} ) {
my $arg = (delete $parms{base_href}) || $self->base;
- $content=~s/<head>/<head>\n<base href="$arg">/;
+ $content=~s/<head>/<head>\n<base href="$arg">/i;
}
if ( my $arg = delete $parms{format} ) {
if ($arg eq 'text') {
@@ -694,6 +695,16 @@
Matches the name of the link against I<string> or I<regex>, as appropriate.
+=item * C<< id => string >> and C<< id_regex => regex >>
+
+Matches the attribute 'id' of the link against I<string> or
+I<regex>, as appropriate.
+
+=item * C<< class => string >> and C<< class_regex => regex >>
+
+Matches the attribute 'class' of the link against I<string> or
+I<regex>, as appropriate.
+
=item * C<< tag => string >> and C<< tag_regex => regex >>
Matches the tag that the link came from against I<string> or I<regex>,
@@ -744,7 +755,7 @@
my $wantall = ( $parms{n} eq 'all' );
- $self->_clean_keys( \%parms, qr/^(n|(text|url|url_abs|name|tag)(_regex)?)$/ );
+ $self->_clean_keys( \%parms, qr/^(n|(text|url|url_abs|name|tag|id|class)(_regex)?)$/ );
my @links = $self->links or return;
@@ -789,6 +800,11 @@
return if defined $p->{name_regex} && !(defined($link->name) && $link->name =~ $p->{name_regex} );
return if defined $p->{tag} && !($link->tag && $link->tag eq $p->{tag} );
return if defined $p->{tag_regex} && !($link->tag && $link->tag =~ $p->{tag_regex} );
+
+ return if defined $p->{id} && !($link->attrs->{id} && $link->attrs->{id} eq $p->{id} );
+ return if defined $p->{id_regex} && !($link->attrs->{id} && $link->attrs->{id} =~ $p->{id_regex} );
+ return if defined $p->{class} && !($link->attrs->{class} && $link->attrs->{class} eq $p->{class} );
+ return if defined $p->{class_regex} && !($link->attrs->{class} && $link->attrs->{class} =~ $p->{class_regex} );
# Success: everything that was defined passed.
return 1;
@@ -951,7 +967,7 @@
L<WWW::Mechanize::Image> object which describes the image. If it fails
to find an image it returns undef.
-You can select which link to find by passing in one or more of these
+You can select which image to find by passing in one or more of these
key/value pairs:
=over 4
@@ -1105,7 +1121,7 @@
selected.
If it is found, the form is returned as an L<HTML::Form> object and set internally
-for later used with Mech's form methods such as C<L<field()>> and C<L<click()>>.
+for later use with Mech's form methods such as C<L<field()>> and C<L<click()>>.
Emits a warning and returns undef if no form is found.
@@ -1134,7 +1150,7 @@
generated.
If it is found, the form is returned as an L<HTML::Form> object and set internally
-for later used with Mech's form methods such as C<L<field()>> and C<L<click()>>.
+for later use with Mech's form methods such as C<L<field()>> and C<L<click()>>.
Returns undef if no form is found.
@@ -1838,7 +1854,92 @@
open( my $fh, '>', $filename ) or $self->die( "Unable to create $filename: $!" );
print {$fh} $self->content or $self->die( "Unable to write to $filename: $!" );
close $fh or $self->die( "Unable to close $filename: $!" );
-}
+
+ return;
+}
+
+=head2 $mech->dump_links( [[$fh], $absolute] )
+
+Prints a dump of the links on the current page to I<$fh>. If I<$fh>
+is not specified or is undef, it dumps to STDOUT.
+
+If I<$absolute> is true, links displayed are absolute, not relative.
+
+=cut
+
+sub dump_links {
+ my $self = shift;
+ my $fh = shift || \*STDOUT;
+ my $absolute = shift;
+
+ for my $link ( $self->links ) {
+ my $url = $absolute ? $link->url_abs : $link->url;
+ $url = '' if not defined $url;
+ print {$fh} $url, "\n";
+ }
+ return;
+}
+
+=head2 $mech->dump_images( [[$fh], $absolute] )
+
+Prints a dump of the images on the current page to I<$fh>. If I<$fh>
+is not specified or is undef, it dumps to STDOUT.
+
+If I<$absolute> is true, links displayed are absolute, not relative.
+
+=cut
+
+sub dump_images {
+ my $self = shift;
+ my $fh = shift || \*STDOUT;
+ my $absolute = shift;
+
+ for my $image ( $self->images ) {
+ my $url = $absolute ? $image->url_abs : $image->url;
+ $url = '' if not defined $url;
+ print {$fh} $url, "\n";
+ }
+ return;
+}
+
+=head2 $mech->dump_forms( [$fh] )
+
+Prints a dump of the forms on the current page to I<$fh>. If I<$fh>
+is not specified or is undef, it dumps to STDOUT.
+
+=cut
+
+sub dump_forms {
+ my $self = shift;
+ my $fh = shift || \*STDOUT;
+
+ for my $form ( $self->forms ) {
+ print {$fh} $form->dump, "\n";
+ }
+ return;
+}
+
+=head2 $mech->dump_all( [[$fh], $absolute] )
+
+Prints a dump of all links, images and forms on the current page to
+I<$fh>. If I<$fh> is not specified or is undef, it dumps to STDOUT.
+
+If I<$absolute> is true, links displayed are absolute, not relative.
+
+=cut
+
+sub dump_all {
+ my $self = shift;
+ my $fh = shift || \*STDOUT;
+ my $absolute = shift;
+
+ $self->dump_links( $fh, $absolute );
+ $self->dump_images( $fh, $absolute );
+ $self->dump_forms( $fh, $absolute );
+
+ return;
+}
+
=head1 OVERRIDDEN LWP::UserAgent METHODS
@@ -1902,6 +2003,8 @@
}
$self->_update_page($request, $self->_make_request( $request, @_ ));
+
+ # XXX This should definitively return something.
}
=head2 $mech->update_html( $html )
@@ -2412,9 +2515,9 @@
=head1 WWW::MECHANIZE'S SUBVERSION REPOSITORY
-Mech is hosted by the kind generosity of Ask and Robert,
-maintainers of perl.org. The Subversion repository is at
-L<http://svn.perl.org/modules/www-mechanize>.
+Mech and Test::WWW::Mechanize are both hosted at Google Code:
+http://code.google.com/p/www-mechanize/. The Subversion repository
+is at http://www-mechanize.googlecode.com/svn/wm/.
=head1 OTHER DOCUMENTATION
@@ -2563,8 +2666,8 @@
Please report any requests, suggestions or (gasp!) bugs via the
excellent RT bug-tracking system at http://rt.cpan.org/, or email to
-bug-WWW-Mechanize at rt.cpan.org. This makes it much easier for me to
-track things.
+C<bug-WWW-Mechanize at rt.cpan.org>. This makes it much easier for
+me to track things.
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize> is the RT queue
for Mechanize. Please check to see if your bug has already been reported.
@@ -2576,7 +2679,9 @@
Thanks to the numerous people who have helped out on WWW::Mechanize in
one way or another, including
-Kirrily Robert for the orignal C<WWW::Automate>,
+Kirrily Robert for the original C<WWW::Automate>,
+Adriano Ferreira,
+Miyagawa,
Peteris Krumins,
Rafael Kitover,
David Steinbrunner,
@@ -2611,6 +2716,7 @@
Abe Timmerman,
Peter Stevens,
Pete Krawczyk,
+Tad McClellan,
and the late great Iain Truskett.
=head1 COPYRIGHT
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/FAQ.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/FAQ.pod?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/FAQ.pod (original)
+++ branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/FAQ.pod Sat Dec 1 22:07:16 2007
@@ -169,7 +169,14 @@
=head2 How can I get WWW::Mechanize to execute this JavaScript?
You can't. JavaScript is entirely client-based, and WWW::Mechanize
-is a client that doesn't understand JavaScript.
+is a client that doesn't understand JavaScript. See the top part
+of this FAQ.
+
+=head2 How do I check a checkbox that doesn't have a value defined?
+
+Set it to to the value of "on".
+
+ $mech->field( my_checkbox => 'on' );
=head2 How do I handle frames?
Modified: branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/lib/WWW/Mechanize/Image.pm?rev=10640&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 Dec 1 22:07:16 2007
@@ -34,13 +34,19 @@
my $class = shift;
my $parms = shift || {};
- my $self = {};
+ my $self = bless {}, $class;
for my $parm ( qw( url base tag height width alt name ) ) {
- $self->{$parm} = $parms->{$parm} if defined $parms->{$parm};
+ # Check for what we passed in, not whether it's defined
+ $self->{$parm} = $parms->{$parm} if exists $parms->{$parm};
}
- return bless $self, $class;
+ # url and tag are always required
+ for ( qw( url tag ) ) {
+ exists $self->{$_} or die "WWW::Mechanize::Image->new must have a $_ argument";
+ }
+
+ return $self;
}
=head1 Accessors
Modified: branches/upstream/libwww-mechanize-perl/current/t/autocheck.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/autocheck.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/autocheck.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/autocheck.t Sat Dec 1 22:07:16 2007
@@ -5,6 +5,12 @@
use Test::More;
use constant NONEXISTENT => 'http://blahblablah.xx-nonexistent.';
+
+BEGIN {
+ if (gethostbyname('blahblahblah.xx-nonexistent.')) {
+ plan skip_all => 'Found an A record for the non-existent domain';
+ }
+}
BEGIN {
eval 'use Test::Exception';
Modified: branches/upstream/libwww-mechanize-perl/current/t/find_link.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/find_link.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/find_link.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/find_link.t Sat Dec 1 22:07:16 2007
@@ -26,7 +26,7 @@
$x = $mech->find_link( url_regex => qr/upcase/i );
isa_ok( $x, 'WWW::Mechanize::Link' );
-like( $x->url, qr/upcase.com/i, 'found link in uppercase meta tag' );
+like( $x->url, qr/upcase.com/i, 'found link in uppercase meta tag' );
$x = $mech->find_link( text => 'CPAN A' );
isa_ok( $x, 'WWW::Mechanize::Link' );
@@ -71,10 +71,10 @@
is( $x->url, 'http://c.cpan.org/', 'Got c.cpan.org' );
my @wanted_links= (
- [ 'http://a.cpan.org/', 'CPAN A', undef, 'a' ],
- [ 'http://b.cpan.org/', 'CPAN B', undef, 'a' ],
- [ 'http://c.cpan.org/', 'CPAN C', 'bongo', 'a' ],
- [ 'http://d.cpan.org/', 'CPAN D', undef, 'a' ],
+ [ 'http://a.cpan.org/', 'CPAN A', undef, 'a' ],
+ [ 'http://b.cpan.org/', 'CPAN B', undef, 'a' ],
+ [ 'http://c.cpan.org/', 'CPAN C', 'bongo', 'a' ],
+ [ 'http://d.cpan.org/', 'CPAN D', undef, 'a' ],
);
my @links = $mech->find_all_links( text_regex => qr/CPAN/ );
@{$_} = @{$_}[0..3] for @links;
Added: branches/upstream/libwww-mechanize-perl/current/t/find_link_id.html
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/find_link_id.html?rev=10640&op=file
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/find_link_id.html (added)
+++ branches/upstream/libwww-mechanize-perl/current/t/find_link_id.html Sat Dec 1 22:07:16 2007
@@ -1,0 +1,32 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" id="facebook">
+
+<head>
+<title>Examples for find_link</title>
+<meta http-equiv="Content-type" content="text/html; charset=utf-8" />
+</head>
+
+<body class="barframe">
+<div id="ad">
+<iframe src='http://ads.whatever.com/'></iframe>
+</div>
+
+<div id="widebar" class="clearfix">
+<div id="app_content_23422222" class="app_content_23422222"><div>
+<iframe src="http://boo.xyz.com/boo_app" smartsize="true" frameborder="0" class="smart_iframe">
+</iframe>
+
+<script type="text/javascript">
+smartSizingFrameAdded();
+</script>
+
+</div>
+</div>
+
+<a href="signature2.html">Fake Signature</a>
+<a href="signature.html" id='signature'>Signature</a>
+<a href="signature3.html">Fake Signature</a>
+
+</body>
+</html>
Added: branches/upstream/libwww-mechanize-perl/current/t/find_link_id.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/find_link_id.t?rev=10640&op=file
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/find_link_id.t (added)
+++ branches/upstream/libwww-mechanize-perl/current/t/find_link_id.t Sat Dec 1 22:07:16 2007
@@ -1,0 +1,43 @@
+#!perl -Tw
+
+use warnings;
+use strict;
+use Test::More no_plan => 1;
+use URI::file;
+
+BEGIN {
+ delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Placates taint-unsafe Cwd.pm in 5.6.1
+ use_ok( 'WWW::Mechanize' );
+}
+
+my $mech = WWW::Mechanize->new( cookie_jar => undef );
+isa_ok( $mech, 'WWW::Mechanize' );
+
+my $uri = URI::file->new_abs( 't/find_link_id.html' )->as_string;
+
+$mech->get( $uri );
+ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+FIND_BY_ID: {
+ my $x = $mech->find_link( id => 'signature' );
+ isa_ok( $x, 'WWW::Mechanize::Link' );
+ is( $x->url, 'signature.html', 'found link with given ID' );
+}
+
+FIND_BY_CLASS: {
+ my $x = $mech->find_link( tag => 'iframe', class => 'smart_iframe' );
+ isa_ok( $x, 'WWW::Mechanize::Link' );
+ is( $x->url, 'http://boo.xyz.com/boo_app', 'found link within "iframe" with given class' );
+}
+
+FIND_ID_BY_REGEX: {
+ my $x = $mech->find_link( id_regex => qr/^sig/ );
+ isa_ok( $x, 'WWW::Mechanize::Link' );
+ is( $x->url, 'signature.html', 'found link with ID matching a regex' );
+}
+
+FIND_CLASS_BY_REGEX: {
+ my $x = $mech->find_link( tag => 'iframe', class_regex => qr/IFRAME$/i );
+ isa_ok( $x, 'WWW::Mechanize::Link' );
+ is( $x->url, 'http://boo.xyz.com/boo_app', 'found link with class matching a regex' );
+}
Modified: branches/upstream/libwww-mechanize-perl/current/t/live/computers4sure.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/live/computers4sure.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/live/computers4sure.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/live/computers4sure.t Sat Dec 1 22:07:16 2007
@@ -3,7 +3,7 @@
use warnings;
use strict;
-use Test::More skip_all => "Still need to get the error-handling on here working";
+use Test::More skip_all => 'Still need to get the error-handling on here working';
use Test::More tests => 9;
BEGIN {
@@ -36,9 +36,9 @@
#print $mech->content;
SKIP: {
- eval "use Test::Memory::Cycle";
- skip "Test::Memory::Cycle not installed", 1 if $@;
+ eval 'use Test::Memory::Cycle';
+ skip 'Test::Memory::Cycle not installed', 1 if $@;
- memory_cycle_ok( $mech, "No memory cycles found" );
+ memory_cycle_ok( $mech, 'No memory cycles found' );
}
Modified: branches/upstream/libwww-mechanize-perl/current/t/live/wikipedia.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/live/wikipedia.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/live/wikipedia.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/live/wikipedia.t Sat Dec 1 22:07:16 2007
@@ -25,9 +25,9 @@
}
SKIP: {
- eval "use Test::Memory::Cycle";
- skip "Test::Memory::Cycle not installed", 1 if $@;
+ eval 'use Test::Memory::Cycle';
+ skip 'Test::Memory::Cycle not installed', 1 if $@;
- memory_cycle_ok( $mech, "No memory cycles found" );
+ memory_cycle_ok( $mech, 'No memory cycles found' );
}
Modified: branches/upstream/libwww-mechanize-perl/current/t/local/failure.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/local/failure.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/local/failure.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/local/failure.t Sat Dec 1 22:07:16 2007
@@ -2,10 +2,17 @@
use warnings;
use strict;
-use Test::More tests => 16;
+use Test::More;
use lib 't/local';
use LocalServer;
+
+BEGIN {
+ if (gethostbyname('blahblahblah.xx-only-testing.')) {
+ plan skip_all => 'Found an A record for the non-existent domain';
+ }
+ plan tests => 16;
+}
BEGIN { delete @ENV{ qw( http_proxy HTTP_PROXY ) }; }
BEGIN {
Modified: branches/upstream/libwww-mechanize-perl/current/t/new.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/new.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/new.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/new.t Sat Dec 1 22:07:16 2007
@@ -38,7 +38,7 @@
is( $m->agent, $alias, q{Aliases don't get translated in the constructor} );
$m->agent_alias( $alias );
- like( $m->agent, qr/^Mozilla.+compatible.+Windows/, 'Alias sets the agent' );
+ like( $m->agent, qr/^Mozilla.+compatible.+Windows/, 'Alias sets the agent' );
$m->agent( 'ratso/bongo v.43' );
is( $m->agent, 'ratso/bongo v.43', 'Can still set the agent' );
Modified: branches/upstream/libwww-mechanize-perl/current/t/taint.t
URL: http://svn.debian.org/wsvn/branches/upstream/libwww-mechanize-perl/current/t/taint.t?rev=10640&op=diff
==============================================================================
--- branches/upstream/libwww-mechanize-perl/current/t/taint.t (original)
+++ branches/upstream/libwww-mechanize-perl/current/t/taint.t Sat Dec 1 22:07:16 2007
@@ -3,9 +3,12 @@
use warnings;
use strict;
use Test::More;
-eval 'use Test::Taint';
-plan skip_all => 'Test::Taint required for checking taintedness' if $@;
-plan tests=>5;
+
+BEGIN {
+ eval 'use Test::Taint';
+ plan skip_all => 'Test::Taint required for checking taintedness' if $@;
+ plan tests=>6;
+}
BEGIN { delete @ENV{ qw( http_proxy HTTP_PROXY ) }; }
BEGIN {
More information about the Pkg-perl-cvs-commits
mailing list