r59214 - in /branches/upstream/libtest-www-mechanize-perl/current: Changes MANIFEST META.yml Makefile.PL Mechanize.pm t/autolint.t t/html/bad.html t/text_contains.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Jun 12 05:07:37 UTC 2010
Author: ansgar-guest
Date: Sat Jun 12 05:05:40 2010
New Revision: 59214
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=59214
Log:
[svn-upgrade] new version libtest-www-mechanize-perl (1.30)
Added:
branches/upstream/libtest-www-mechanize-perl/current/t/text_contains.t
Modified:
branches/upstream/libtest-www-mechanize-perl/current/Changes
branches/upstream/libtest-www-mechanize-perl/current/MANIFEST
branches/upstream/libtest-www-mechanize-perl/current/META.yml
branches/upstream/libtest-www-mechanize-perl/current/Makefile.PL
branches/upstream/libtest-www-mechanize-perl/current/Mechanize.pm
branches/upstream/libtest-www-mechanize-perl/current/t/autolint.t
branches/upstream/libtest-www-mechanize-perl/current/t/html/bad.html
Modified: branches/upstream/libtest-www-mechanize-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/Changes?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/Changes (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/Changes Sat Jun 12 05:05:40 2010
@@ -3,6 +3,17 @@
WWW::Mechanize and Test::WWW::Mechanize do not use rt.cpan.org for
bug tracking. They are now being tracked via Google Code at
http://code.google.com/p/www-mechanize/issues/list
+
+
+1.30 Wed Jun 9 12:23:48 CDT 2010
+------------------------------------
+[ENHANCEMENTS]
+autolint used to only work on get_ok() calls. Now it works with
+post_ok(), submit_form_ok(), follow_link_ok() and click_ok().
+
+Added $mech->text_contains(), $mech->text_like() and $mech->text_unlike()
+methods. These check the text of an HTML page separate from the
+HTML markup. Thanks to Ashley Pond V.
1.28 Tue Apr 13 00:44:27 CDT 2010
Modified: branches/upstream/libtest-www-mechanize-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/MANIFEST?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/MANIFEST Sat Jun 12 05:05:40 2010
@@ -30,6 +30,7 @@
t/stuff_inputs.html
t/stuff_inputs.t
t/submit_form_ok.t
+t/text_contains.t
t/TestServer.pm
t/html/bad.html
Modified: branches/upstream/libtest-www-mechanize-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/META.yml?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/META.yml (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/META.yml Sat Jun 12 05:05:40 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Test-WWW-Mechanize
-version: 1.28
+version: 1.30
abstract: Testing-specific WWW::Mechanize subclass
author:
- Andy Lester <andy at petdance.com>
@@ -12,6 +12,7 @@
ExtUtils::MakeMaker: 0
requires:
Carp::Assert::More: 0
+ HTML::TreeBuilder: 0
HTTP::Server::Simple: 0.42
HTTP::Server::Simple::CGI: 0
perl: 5.008
Modified: branches/upstream/libtest-www-mechanize-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/Makefile.PL?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/Makefile.PL (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/Makefile.PL Sat Jun 12 05:05:40 2010
@@ -10,6 +10,7 @@
PL_FILES => {},
PREREQ_PM => {
'Carp::Assert::More' => 0,
+ 'HTML::TreeBuilder' => 0,
'HTTP::Server::Simple' => '0.42',
'HTTP::Server::Simple::CGI' => 0,
'Test::Builder::Tester' => '1.09',
@@ -22,7 +23,7 @@
clean => { FILES => 'Test-WWW-Mechanize-*' },
};
-if ( $ExtUtils::MakeMaker::VERSION ge '6.45_01' ) {
+if ( $ExtUtils::MakeMaker::VERSION ge '6.46' ) {
$parms->{META_MERGE} = {
resources => {
license => 'http://dev.perl.org/licenses/',
@@ -34,7 +35,7 @@
};
$parms->{LICENSE} = 'perl';
}
-if ( $ExtUtils::MakeMaker::VERSION ge '6.47_02' ) {
+if ( $ExtUtils::MakeMaker::VERSION ge '6.48' ) {
$parms->{MIN_PERL_VERSION} = 5.008;
}
Modified: branches/upstream/libtest-www-mechanize-perl/current/Mechanize.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/Mechanize.pm?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/Mechanize.pm (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/Mechanize.pm Sat Jun 12 05:05:40 2010
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.28
-
-=cut
-
-our $VERSION = '1.28';
+Version 1.30
+
+=cut
+
+our $VERSION = '1.30';
=head1 SYNOPSIS
@@ -26,8 +26,8 @@
my $mech = Test::WWW::Mechanize->new;
$mech->get_ok( $page );
$mech->base_is( 'http://petdance.com/', 'Proper <BASE HREF>' );
- $mech->title_is( "Invoice Status", "Make sure we're on the invoice page" );
- $mech->content_contains( "Andy Lester", "My name somewhere" );
+ $mech->title_is( 'Invoice Status', "Make sure we're on the invoice page" );
+ $mech->text_contains( 'Andy Lester', 'My name somewhere' );
$mech->content_like( qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
This is equivalent to:
@@ -40,7 +40,7 @@
ok( $mech->success );
is( $mech->base, 'http://petdance.com', 'Proper <BASE HREF>' );
is( $mech->title, "Invoice Status", "Make sure we're on the invoice page" );
- ok( index( $mech->content, "Andy Lester" ) >= 0, "My name somewhere" );
+ ok( index( $mech->content( format => 'text' ), 'Andy Lester' ) >= 0, 'My name somewhere' );
like( $mech->content, qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
but has nicer diagnostics if they fail.
@@ -59,7 +59,7 @@
ok - Got 'http://petdance.com/' ok
ok - Base is 'http://petdance.com/'
ok - Title is 'Invoice Status'
- ok - Content contains 'Andy Lester'
+ ok - Text contains 'Andy Lester'
ok - Content is like '(?-xism:(cpan|perl)\.org)'
=cut
@@ -90,15 +90,7 @@
=item * get_ok()
-=back
-
-and will eventually do the same after any of the following:
-
-=over
-
=item * post_ok()
-
-=item * back_ok()
=item * submit_form_ok()
@@ -237,6 +229,30 @@
my ($url,$desc,%opts) = $self->_unpack_args( 'POST', @_ );
$self->post( $url, \%opts );
+ my $ok = $self->success;
+ $ok = $self->_maybe_lint( $ok, $desc );
+
+ return $ok;
+}
+
+=head2 $mech->put_ok( $url, [ \%LWP_options ,] $desc )
+
+A wrapper around WWW::Mechanize's put(), with similar options, except
+the second argument needs to be a hash reference, not a hash. Like
+well-behaved C<*_ok()> functions, it returns true if the test passed,
+or false if not.
+
+A default description of "PUT to $url" is used if none if provided.
+
+=cut
+
+sub put_ok {
+ my $self = shift;
+
+ my ($url,$desc,%opts) = $self->_unpack_args( 'PUT', @_ );
+ $opts{content} = '' if !exists $opts{content};
+ $self->put( $url, %opts );
+
my $ok = $self->success;
$Test->ok( $ok, $desc );
if ( !$ok ) {
@@ -247,34 +263,6 @@
return $ok;
}
-=head2 $mech->put_ok( $url, [ \%LWP_options ,] $desc )
-
-A wrapper around WWW::Mechanize's put(), with similar options, except
-the second argument needs to be a hash reference, not a hash. Like
-well-behaved C<*_ok()> functions, it returns true if the test passed,
-or false if not.
-
-A default description of "PUT to $url" is used if none if provided.
-
-=cut
-
-sub put_ok {
- my $self = shift;
-
- my ($url,$desc,%opts) = $self->_unpack_args( 'PUT', @_ );
- $opts{content} = '' if !exists $opts{content};
- $self->put( $url, %opts );
-
- my $ok = $self->success;
- $Test->ok( $ok, $desc );
- if ( !$ok ) {
- $Test->diag( $self->status );
- $Test->diag( $self->response->message ) if $self->response;
- }
-
- return $ok;
-}
-
=head2 $mech->submit_form_ok( \%parms [, $desc] )
Makes a C<submit_form()> call and executes tests on the results.
@@ -322,8 +310,7 @@
}
}
- $Test->ok( $ok, $desc );
- $Test->diag( $error ) if $error;
+ $ok = $self->_maybe_lint( $ok, $desc );
return $ok;
}
@@ -381,8 +368,7 @@
}
}
- $Test->ok( $ok, $desc );
- $Test->diag( $error ) if $error;
+ $ok = $self->_maybe_lint( $ok, $desc );
return $ok;
}
@@ -405,12 +391,12 @@
return $Test->ok( 0, $desc );
}
- if ( !$response->is_success ) {
- $Test->diag( "Failed test $desc:" );
- $Test->diag( $response->as_string );
- return $Test->ok( 0, $desc );
- }
- return $Test->ok( 1, $desc );
+
+ my $ok = $response->is_success;
+
+ $ok = $self->_maybe_lint( $ok, $desc );
+
+ return $ok;
}
@@ -702,13 +688,78 @@
=cut
sub content_unlike {
- my $self = shift;
+ my $self = shift;
my $regex = shift;
- my $desc = shift;
- $desc = qq{Content is unlike "$regex"} if !defined($desc);
+ my $desc = shift || qq{Content is unlike "$regex"};
local $Test::Builder::Level = $Test::Builder::Level + 1;
return unlike_string( $self->content, $regex, $desc );
+}
+
+=head2 $mech->text_contains( $str [, $desc ] )
+
+Tells if the text form of the page's content contains I<$str>.
+
+When your page contains HTML which is difficult, unimportant, or
+unlikely to match over time as designers alter markup, use
+C<text_contains> instead of L</content_contains>.
+
+ # <b>Hi, <i><a href="some/path">User</a></i>!</b>
+ $mech->content_contains('Hi, User'); # Fails.
+ $mech->text_contains('Hi, User'); # Passes.
+
+Text is determined by calling C<< $mech->content(format => 'text') >>.
+See L<WWW::Mechanize/content>.
+
+=cut
+
+sub text_contains {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift || qq{Text contains "$str"};
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ if ( ref($str) eq 'REGEX' ) {
+ diag( 'text_contains takes a string, not a regex' );
+ }
+
+ return contains_string( $self->content(format => "text"), $str, $desc );
+}
+
+=head2 $mech->text_like( $regex [, $desc ] )
+
+Tells if the text form of the page's content matches I<$regex>.
+
+=cut
+
+sub text_like {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift || qq{Text is like "$regex"};
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return like_string( $self->_text, $regex, $desc );
+}
+
+=head2 $mech->text_unlike( $regex [, $desc ] )
+
+Tells if the text format of the page's content does NOT match I<$regex>.
+
+=cut
+
+sub text_unlike {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift || qq{Text is unlike "$regex"};
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return unlike_string( $self->_text, $regex, $desc );
+}
+
+sub _text {
+ my $self = shift;
+
+ return $self->content( format => 'text' );
}
=head2 $mech->has_tag( $tag, $text [, $desc ] )
@@ -721,8 +772,7 @@
my $self = shift;
my $tag = shift;
my $text = shift;
- my $desc = shift;
- $desc = qq{Page has $tag tag with "$text"} if !defined($desc);
+ my $desc = shift || qq{Page has $tag tag with "$text"};
my $found = $self->_tag_walk( $tag, sub { $text eq $_[0] } );
@@ -1319,6 +1369,7 @@
=head1 ACKNOWLEDGEMENTS
Thanks to
+Philip G. Potter,
Niko Tyni,
Greg Sheard,
Michael Schwern,
Modified: branches/upstream/libtest-www-mechanize-perl/current/t/autolint.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/t/autolint.t?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/t/autolint.t (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/t/autolint.t Sat Jun 12 05:05:40 2010
@@ -8,7 +8,7 @@
BEGIN {
eval 'use HTML::Lint';
plan skip_all => 'HTML::Lint is not installed, cannot test autolint' if $@;
- plan tests => 7;
+ plan tests => 8;
}
BEGIN {
@@ -39,6 +39,7 @@
my $uri = "$server_root/bad.html";
+ # Test via get_ok
test_out( 'not ok 1 - GET bad.html' );
test_fail( +6 );
test_err( "# HTML::Lint errors for $uri" );
@@ -47,7 +48,18 @@
test_err( '# (9:5) <a> at (8:9) is never closed' );
test_err( '# 3 errors on the page' );
$mech->get_ok( $uri, 'GET bad.html' );
- test_test( 'Good GET, bad HTML' );
+ test_test( 'get_ok complains about bad HTML' );
+
+ # Test via follow_link_ok
+ test_out( 'not ok 1 - Following link back to bad.html' );
+ test_fail( +6 );
+ test_err( "# HTML::Lint errors for $uri" );
+ test_err( '# (7:9) Unknown attribute "hrex" for tag <a>' );
+ test_err( '# (8:33) </b> with no opening <b>' );
+ test_err( '# (9:5) <a> at (8:9) is never closed' );
+ test_err( '# 3 errors on the page' );
+ $mech->follow_link_ok( { text => 'Back to bad' }, 'Following link back to bad.html' );
+ test_test( 'follow_link_ok complains about bad HTML' );
}
BAD_GET: {
Modified: branches/upstream/libtest-www-mechanize-perl/current/t/html/bad.html
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/t/html/bad.html?rev=59214&op=diff
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/t/html/bad.html (original)
+++ branches/upstream/libtest-www-mechanize-perl/current/t/html/bad.html Sat Jun 12 05:05:40 2010
@@ -3,7 +3,7 @@
<title>Test Page</title>
</head>
<body>
- Test Page
+ Test Page <a href="bad.html">Back to bad</a>
<a hrex="goodlinks.html">good</a>
<a href="bad2.html">Test</b>
</body>
Added: branches/upstream/libtest-www-mechanize-perl/current/t/text_contains.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-www-mechanize-perl/current/t/text_contains.t?rev=59214&op=file
==============================================================================
--- branches/upstream/libtest-www-mechanize-perl/current/t/text_contains.t (added)
+++ branches/upstream/libtest-www-mechanize-perl/current/t/text_contains.t Sat Jun 12 05:05:40 2010
@@ -1,0 +1,45 @@
+#!perl -w
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::Builder::Tester;
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+use lib 't';
+use TestServer;
+
+my $server = TestServer->new;
+my $pid = $server->background;
+my $server_root = $server->root;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get( "$server_root/goodlinks.html" );
+
+# test regex
+test_out( 'ok 1 - Does it say test page?' );
+$mech->text_contains( 'Test Page', 'Does it say test page?' );
+test_test( 'Finds the contains' );
+
+# default desc
+test_out( 'ok 1 - Text contains "Test Page"' );
+$mech->text_contains( 'Test Page');
+test_test( 'Finds the contains - default desc' );
+
+# Handles not finding something. Also, what we are searching for IS
+# found in content_contains() but NOT in text_contains().
+test_out( 'not ok 1 - Trying to find goodlinks' );
+test_fail(+5);
+test_diag(q( searched: "Test PageTest PageTest 1 Test 2 Test 3") );
+test_diag(q( can't find: "goodlinks.html") );
+test_diag(q( LCSS: "s"));
+test_diag(q(LCSS context: "Test PageTest PageTest 1 Test 2 Test 3"));
+$mech->text_contains( 'goodlinks.html', 'Trying to find goodlinks' );
+test_test( 'Handles not finding it' );
+
+$server->stop;
More information about the Pkg-perl-cvs-commits
mailing list