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