Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added tags support

  • Loading branch information...
commit 38dd07e9f6f8c80d7549f11fdf96816ae445da32 0 parents
petdance authored
120 Changes
@@ -0,0 +1,120 @@
+Revision history for Test-WWW-Mechanize
+
+1.14 Fri May 11 16:22:02 CDT 2007
+
+ [FIXES]
+ * Fixes test failures. Thanks to Mark Blackman for RT #26602:
+
+ The module tests currently spawn a server (based on
+ HTTP::Server::Simple::CGI) which is killed when a __DIE__
+ signal is received, normally only when the invoking
+ perl dies. However, as perlvar makes clear, the __DIE__
+ signal is received when eval blocks die as well. The
+ new version (1.22) of WWW::Mechanize now calles
+ HTTP::Message::decoded_content which calls Encode.pm
+ which has a eval block that require's Encode::ConfigLocal
+ which is usually not present, so the eval dies and the
+ HTTP server is killed as soon as the $mech object tries
+ to do a 'get'. It's simple to use a system variable,
+ $^S to find out if the __DIE__ signal is being called
+ for an eval so we ignore that case with the patch
+ attached.
+
+ * The stuff_inputs() function now actually works.
+
+ [DOCUMENTATION]
+ * Made the synopsis show that T:W:M doesn't take the tests=>$x
+ like other Test::* modules. It'd be nice if it did, though.
+
+
+1.12 Thu Jul 6 23:47:59 CDT 2006
+ [ENHANCEMENTS]
+ * Added followable_links() method to return only those links
+ that your mech can actually follow.
+
+
+1.10 Sun Jun 18 22:58:41 CDT 2006
+ [FIXES]
+ * RT #19147: Tests turn off the http_proxy environment variable
+ before starting. Thanks to Matt Trout.
+ * RT #18779: makes stuff_inputs() conform to the documentation,
+ changing the implementation to expect an arrayref for
+ $options->{ ignore }, as opposed to a hashref. Thanks to
+ Mike O'Regan.
+
+ [ENHANCEMENTS]
+ * Added base_is, base_like and base_unlike. Thanks to MATSUNO
+ Tokuhiro.
+
+
+1.08 Mon Nov 21 10:35:23 CST 2005
+ [FIXES]
+ * has_tag_like()'s regex was reversed, so would match when
+ it shouldn't. Thanks to Chris Dolan.
+
+ [DOCUMENTATION]
+ * Added links to support sites.
+
+1.06 Jun 29 2005
+ [INTERNALS]
+ * Updated test suite to use HTTP::Server::Simple.
+ Thanks to Shawn Sorichetti for it.
+
+1.05_02 Sun Apr 3 12:19:05 CDT 2005
+ [ENHANCEMENTS]
+ * Added has_tag() and has_tag_like(). Thanks RJBS.
+
+1.05_01 Tue Mar 8 16:24:36 CST 2005
+ [ENHANCEMENTS]
+ * get_ok() now shows the status line for the mech if the test
+ fails.
+ * get_ok() now returns true/false, not an HTTP::Response.
+
+1.04 Fri Mar 4 00:08:42 CST 2005
+ [ENHANCEMENTS]
+ * Added follow_link_ok(). Thanks to Mike O'Regan.
+ * Added get_ok(). Thanks to Dan Friedman.
+
+1.02 Wed Dec 15 17:35:23 CST 2004
+ [ENHANCEMENTS]
+ * Added content_lacks()
+
+ [DOCUMENTATION]
+ * Fixed some documentation bugs. Thanks to Drew Taylor.
+
+1.00 Thu Dec 9 11:41:50 CST 2004
+ [ENHANCEMENTS]
+ * Added content_contains()
+ * Fixed diagnostic errors to work the same way regardless of
+ which version of Test::Builder you have.
+
+0.99 Sun Oct 24 11:17:59 CDT 2004
+ [ENHANCEMENTS]
+ * Added $mech->content_unlike and $mech->title_unlike
+ * Made the reporting of where the error happened reflect the
+ caller's code.
+
+0.06 Thu Sep 30 21:49:08 CDT 2004
+ [ENHANCEMENTS]
+ * New funcs
+ - page_links_content_like()
+ - page_links_content_unlike()
+ - link_content_like()
+ - link_content_unlike()
+ - link_status_isnt()
+
+0.04 Mon Jul 12 22:16:10 CDT 2004
+ [THINGS THAT MAY BREAK YOUR CODE]
+ * Renamed link_status() to link_status_is().
+
+ [FIXES]
+ * Fixed a bug in link_status_is().
+
+0.02 July 4 2004
+ [ENHANCEMENTS]
+ * Added links_ok() and page_links_ok() methods. Thanks to
+ Shawn Sorichetti.
+
+0.01 Mon Jun 28 16:38:45 CDT 2004
+ First version, released on an unsuspecting world.
+
29 MANIFEST
@@ -0,0 +1,29 @@
+Changes
+MANIFEST
+META.yml
+Makefile.PL
+Mechanize.pm
+README
+
+t/00load.t
+t/content_contains.t
+t/content_lacks.t
+t/follow_link_ok.t
+t/followable_links.t
+t/get_ok.t
+t/get_ok-parms.t
+t/has_tag.t
+t/link_content.t
+t/links_ok.t
+t/link_status.t
+t/new.t
+t/page_links_content.t
+t/page_links_ok.t
+t/pod-coverage.t
+t/pod.t
+t/stuff_inputs.t
+
+t/html/badlinks.html
+t/html/form.html
+t/html/goodlinks.html
+t/html/manylinks.html
16 META.yml
@@ -0,0 +1,16 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Test-WWW-Mechanize
+version: 1.06
+version_from: Mechanize.pm
+installdirs: site
+requires:
+ Carp::Assert::More: 0
+ HTTP::Server::Simple: 0.07
+ Test::LongString: 0.07
+ Test::More: 0
+ URI::file: 0
+ WWW::Mechanize: 1.00
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.25
38 Makefile.PL
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Test::WWW::Mechanize',
+ AUTHOR => 'Andy Lester <andy@petdance.com>',
+ VERSION_FROM => 'Mechanize.pm',
+ ABSTRACT_FROM => 'Mechanize.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Test::LongString' => '0.07',
+ 'URI::file' => 0,
+ 'WWW::Mechanize' => '1.24',
+ 'Carp::Assert::More' => 0,
+ 'HTTP::Server::Simple' => '0.07',
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Test-WWW-Mechanize-*' },
+);
+
+sub MY::postamble {
+ return <<'MAKE_FRAG';
+.PHONY: critic tags
+
+critic:
+ perlcritic -1 -q -profile perlcriticrc bin/ lib/ t/
+
+tags:
+ ctags -f tags --recurse --totals \
+ --exclude=blib \
+ --exclude=.svn \
+ --exclude='*~' \
+ --languages=Perl --langmap=Perl:+.t \
+
+MAKE_FRAG
+}
955 Mechanize.pm
@@ -0,0 +1,955 @@
+package Test::WWW::Mechanize;
+
+=head1 NAME
+
+Test::WWW::Mechanize - Testing-specific WWW::Mechanize subclass
+
+=head1 VERSION
+
+Version 1.14
+
+=cut
+
+our $VERSION = '1.14';
+
+=head1 SYNOPSIS
+
+Test::WWW::Mechanize is a subclass of L<WWW::Mechanize> that incorporates
+features for web application testing. For example:
+
+ use Test::More tests => 5;
+ use Test::WWW::Mechanize;
+
+ 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->content_like( qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
+
+This is equivalent to:
+
+ use Test::More tests => 5;
+ use WWW::Mechanize;
+
+ my $mech = WWW::Mechanize->new;
+ $mech->get( $page );
+ 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" );
+ like( $mech->content, qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
+
+but has nicer diagnostics if they fail.
+
+=cut
+
+use warnings;
+use strict;
+
+use WWW::Mechanize ();
+use Test::LongString;
+use Test::Builder ();
+use Carp::Assert::More;
+
+use base 'WWW::Mechanize';
+
+my $Test = Test::Builder->new();
+
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+Behaves like, and calls, L<WWW::Mechanize>'s C<new> method. Any parms
+passed in get passed to WWW::Mechanize's constructor.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my %mech_args = @_;
+
+ my $self = $class->SUPER::new( %mech_args );
+
+ return $self;
+}
+
+=head1 METHODS
+
+=head2 $mech->get_ok($url, [ \%LWP_options ,] $desc)
+
+A wrapper around WWW::Mechanize's get(), 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.
+
+=cut
+
+sub get_ok {
+ my $self = shift;
+ my $url = shift;
+
+ my $desc;
+ my %opts;
+
+ if ( @_ ) {
+ my $flex = shift; # The flexible argument
+
+ if ( !defined( $flex ) ) {
+ $desc = shift;
+ }
+ elsif ( ref $flex eq 'HASH' ) {
+ %opts = %$flex;
+ $desc = shift;
+ }
+ elsif ( ref $flex eq 'ARRAY' ) {
+ %opts = @$flex;
+ $desc = shift;
+ }
+ else {
+ $desc = $flex;
+ }
+ } # parms left
+
+ $self->get( $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->title_is( $str [, $desc ] )
+
+Tells if the title of the page is the given string.
+
+ $mech->title_is( "Invoice Summary" );
+
+=cut
+
+sub title_is {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return is_string( $self->title, $str, $desc );
+}
+
+=head2 $mech->title_like( $regex [, $desc ] )
+
+Tells if the title of the page matches the given regex.
+
+ $mech->title_like( qr/Invoices for (.+)/
+
+=cut
+
+sub title_like {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return like_string( $self->title, $regex, $desc );
+}
+
+=head2 $mech->title_unlike( $regex [, $desc ] )
+
+Tells if the title of the page matches the given regex.
+
+ $mech->title_unlike( qr/Invoices for (.+)/
+
+=cut
+
+sub title_unlike {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return unlike_string( $self->title, $regex, $desc );
+}
+
+=head2 $mech->base_is( $str [, $desc ] )
+
+Tells if the base of the page is the given string.
+
+ $mech->base_is( "http://example.com/" );
+
+=cut
+
+sub base_is {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return is_string( $self->base, $str, $desc );
+}
+
+=head2 $mech->base_like( $regex [, $desc ] )
+
+Tells if the base of the page matches the given regex.
+
+ $mech->base_like( qr{http://example.com/index.php?PHPSESSID=(.+)});
+
+=cut
+
+sub base_like {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return like_string( $self->base, $regex, $desc );
+}
+
+=head2 $mech->base_unlike( $regex [, $desc ] )
+
+Tells if the base of the page matches the given regex.
+
+ $mech->base_unlike( qr{http://example.com/index.php?PHPSESSID=(.+)});
+
+=cut
+
+sub base_unlike {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return unlike_string( $self->base, $regex, $desc );
+}
+
+=head2 $mech->content_is( $str [, $desc ] )
+
+Tells if the content of the page matches the given string
+
+=cut
+
+sub content_is {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return is_string( $self->content, $str, $desc );
+}
+
+=head2 $mech->content_contains( $str [, $desc ] )
+
+Tells if the content of the page contains I<$str>.
+
+=cut
+
+sub content_contains {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return contains_string( $self->content, $str, $desc );
+}
+
+=head2 $mech->content_lacks( $str [, $desc ] )
+
+Tells if the content of the page lacks I<$str>.
+
+=cut
+
+sub content_lacks {
+ my $self = shift;
+ my $str = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return lacks_string( $self->content, $str, $desc );
+}
+
+=head2 $mech->content_like( $regex [, $desc ] )
+
+Tells if the content of the page matches I<$regex>.
+
+=cut
+
+sub content_like {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return like_string( $self->content, $regex, $desc );
+}
+
+=head2 $mech->content_unlike( $regex [, $desc ] )
+
+Tells if the content of the page does NOT match I<$regex>.
+
+=cut
+
+sub content_unlike {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ return unlike_string( $self->content, $regex, $desc );
+}
+
+=head2 $mech->has_tag( $tag, $text [, $desc ] )
+
+Tells if the page has a C<$tag> tag with the given content in its text.
+
+=cut
+
+sub has_tag {
+ my $self = shift;
+ my $tag = shift;
+ my $text = shift;
+ my $desc = shift;
+
+ my $found = $self->_tag_walk( $tag, sub { $text eq $_[0] } );
+
+ return $Test->ok( $found, $desc );
+}
+
+
+=head2 $mech->has_tag_like( $tag, $regex [, $desc ] )
+
+Tells if the page has a C<$tag> tag with the given content in its text.
+
+=cut
+
+sub has_tag_like {
+ my $self = shift;
+ my $tag = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ my $found = $self->_tag_walk( $tag, sub { $_[0] =~ $regex } );
+
+ return $Test->ok( $found, $desc );
+}
+
+
+sub _tag_walk {
+ my $self = shift;
+ my $tag = shift;
+ my $match = shift;
+
+ my $p = HTML::TokeParser->new( \($self->content) );
+
+ while ( my $token = $p->get_tag( $tag ) ) {
+ my $tagtext = $p->get_trimmed_text( "/$tag" );
+ return 1 if $match->( $tagtext );
+ }
+ return;
+}
+
+=head2 $mech->followable_links()
+
+Returns a list of links that Mech can follow. This is only http and
+https links.
+
+=cut
+
+sub followable_links {
+ my $self = shift;
+
+ return $self->find_all_links( url_abs_regex => qr[^https?://] );
+}
+
+=head2 $mech->page_links_ok( [ $desc ] )
+
+Follow all links on the current page and test for HTTP status 200
+
+ $mech->page_links_ok('Check all links');
+
+=cut
+
+sub page_links_ok {
+ my $self = shift;
+ my $desc = shift;
+
+ my @links = $self->followable_links();
+ my @urls = _format_links(\@links);
+
+ my @failures = $self->_check_links_status( \@urls );
+ my $ok = (@failures==0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->page_links_content_like( $regex,[ $desc ] )
+
+Follow all links on the current page and test their contents for I<$regex>.
+
+ $mech->page_links_content_like( qr/foo/,
+ 'Check all links contain "foo"' );
+
+=cut
+
+sub page_links_content_like {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ my $usable_regex=$Test->maybe_regex( $regex );
+ unless(defined( $usable_regex )) {
+ my $ok = $Test->ok( 0, 'page_links_content_like' );
+ $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ my @links = $self->followable_links();
+ my @urls = _format_links(\@links);
+
+ my @failures = $self->_check_links_content( \@urls, $regex );
+ my $ok = (@failures==0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->page_links_content_unlike( $regex,[ $desc ] )
+
+Follow all links on the current page and test their contents do not
+contain the specified regex.
+
+ $mech->page_links_content_unlike(qr/Restricted/,
+ 'Check all links do not contain Restricted');
+
+=cut
+
+sub page_links_content_unlike {
+ my $self = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ my $usable_regex=$Test->maybe_regex( $regex );
+ unless(defined( $usable_regex )) {
+ my $ok = $Test->ok( 0, 'page_links_content_unlike' );
+ $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ my @links = $self->followable_links();
+ my @urls = _format_links(\@links);
+
+ my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
+ my $ok = (@failures==0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->links_ok( $links [, $desc ] )
+
+Follow specified links on the current page and test for HTTP status
+200. The links may be specified as a reference to an array containing
+L<WWW::Mechanize::Link> objects, an array of URLs, or a scalar URL
+name.
+
+ my @links = $mech->find_all_links( url_regex => qr/cnn\.com$/ );
+ $mech->links_ok( \@links, 'Check all links for cnn.com' );
+
+ my @links = qw( index.html search.html about.html );
+ $mech->links_ok( \@links, 'Check main links' );
+
+ $mech->links_ok( 'index.html', 'Check link to index' );
+
+=cut
+
+sub links_ok {
+ my $self = shift;
+ my $links = shift;
+ my $desc = shift;
+
+ my @urls = _format_links( $links );
+ my @failures = $self->_check_links_status( \@urls );
+ my $ok = (@failures == 0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->link_status_is( $links, $status [, $desc ] )
+
+Follow specified links on the current page and test for HTTP status
+passed. The links may be specified as a reference to an array
+containing L<WWW::Mechanize::Link> objects, an array of URLs, or a
+scalar URL name.
+
+ my @links = $mech->followable_links();
+ $mech->link_status_is( \@links, 403,
+ 'Check all links are restricted' );
+
+=cut
+
+sub link_status_is {
+ my $self = shift;
+ my $links = shift;
+ my $status = shift;
+ my $desc = shift;
+
+ my @urls = _format_links( $links );
+ my @failures = $self->_check_links_status( \@urls, $status );
+ my $ok = (@failures == 0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->link_status_isnt( $links, $status [, $desc ] )
+
+Follow specified links on the current page and test for HTTP status
+passed. The links may be specified as a reference to an array
+containing L<WWW::Mechanize::Link> objects, an array of URLs, or a
+scalar URL name.
+
+ my @links = $mech->followable_links();
+ $mech->link_status_isnt( \@links, 404,
+ 'Check all links are not 404' );
+
+=cut
+
+sub link_status_isnt {
+ my $self = shift;
+ my $links = shift;
+ my $status = shift;
+ my $desc = shift;
+
+ my @urls = _format_links( $links );
+ my @failures = $self->_check_links_status( \@urls, $status, 'isnt' );
+ my $ok = (@failures == 0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+
+=head2 $mech->link_content_like( $links, $regex [, $desc ] )
+
+Follow specified links on the current page and test the resulting
+content of each against I<$regex>. The links may be specified as a
+reference to an array containing L<WWW::Mechanize::Link> objects, an
+array of URLs, or a scalar URL name.
+
+ my @links = $mech->followable_links();
+ $mech->link_content_like( \@links, qr/Restricted/,
+ 'Check all links are restricted' );
+
+=cut
+
+sub link_content_like {
+ my $self = shift;
+ my $links = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ my $usable_regex=$Test->maybe_regex( $regex );
+ unless(defined( $usable_regex )) {
+ my $ok = $Test->ok( 0, 'link_content_like' );
+ $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ my @urls = _format_links( $links );
+ my @failures = $self->_check_links_content( \@urls, $regex );
+ my $ok = (@failures == 0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+=head2 $mech->link_content_unlike( $links, $regex [, $desc ] )
+
+Follow specified links on the current page and test that the resulting
+content of each does not match I<$regex>. The links may be specified as a
+reference to an array containing L<WWW::Mechanize::Link> objects, an array
+of URLs, or a scalar URL name.
+
+ my @links = $mech->followable_links();
+ $mech->link_content_unlike( \@links, qr/Restricted/,
+ 'No restricted links' );
+
+=cut
+
+sub link_content_unlike {
+ my $self = shift;
+ my $links = shift;
+ my $regex = shift;
+ my $desc = shift;
+
+ my $usable_regex=$Test->maybe_regex( $regex );
+ unless(defined( $usable_regex )) {
+ my $ok = $Test->ok( 0, 'link_content_unlike' );
+ $Test->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ my @urls = _format_links( $links );
+ my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
+ my $ok = (@failures == 0);
+
+ $Test->ok( $ok, $desc );
+ $Test->diag( $_ ) for @failures;
+
+ return $ok;
+}
+
+# This actually performs the status check of each url.
+sub _check_links_status {
+ my $self = shift;
+ my $urls = shift;
+ my $status = shift || 200;
+ my $test = shift || 'is';
+
+ # Create a clone of the $mech used during the test as to not disrupt
+ # the original.
+ my $mech = $self->clone();
+
+ my @failures;
+
+ for my $url ( @$urls ) {
+ if ( $mech->follow_link( url => $url ) ) {
+ if ( $test eq 'is' ) {
+ push( @failures, $url ) unless $mech->status() == $status;
+ }
+ else {
+ push( @failures, $url ) unless $mech->status() != $status;
+ }
+ $mech->back();
+ }
+ else {
+ push( @failures, $url );
+ }
+ } # for
+
+ return @failures;
+}
+
+# This actually performs the content check of each url.
+sub _check_links_content {
+ my $self = shift;
+ my $urls = shift;
+ my $regex = shift || qr/<html>/;
+ my $test = shift || 'like';
+
+ # Create a clone of the $mech used during the test as to not disrupt
+ # the original.
+ my $mech = $self->clone();
+
+ my @failures;
+ for my $url ( @$urls ) {
+ if ( $mech->follow_link( url => $url ) ) {
+ my $content=$mech->content();
+ if ( $test eq 'like' ) {
+ push( @failures, $url ) unless $content=~/$regex/;
+ }
+ else {
+ push( @failures, $url ) unless $content!~/$regex/;
+ }
+ $mech->back();
+ }
+ else {
+ push( @failures, $url );
+ }
+ } # for
+
+ return @failures;
+}
+
+# Create an array of urls to match for mech to follow.
+sub _format_links {
+ my $links = shift;
+
+ my @urls;
+ if(ref($links) eq 'ARRAY') {
+ if(defined($$links[0])) {
+ if(ref($$links[0]) eq 'WWW::Mechanize::Link') {
+ @urls=map { $_->url() } @$links;
+ }
+ else {
+ @urls=@$links;
+ }
+ }
+ }
+ else {
+ push(@urls,$links);
+ }
+ return @urls;
+}
+
+=head2 $mech->follow_link_ok( \%parms [, $comment] )
+
+Makes a C<follow_link()> call and executes tests on the results.
+The link must be found, and then followed successfully. Otherwise,
+this test fails.
+
+I<%parms> is a hashref containing the parms to pass to C<follow_link()>.
+Note that the parms to C<follow_link()> are a hash whereas the parms to
+this function are a hashref. You have to call this function like:
+
+ $mech->follow_link_ok( {n=>3}, "looking for 3rd link" );
+
+As with other test functions, C<$comment> is optional. If it is supplied
+then it will display when running the test harness in verbose mode.
+
+Returns true value if the specified link was found and followed
+successfully. The HTTP::Response object returned by follow_link()
+is not available.
+
+=cut
+
+sub follow_link_ok {
+ my $self = shift;
+ my $parms = shift || {};
+ my $comment = shift;
+
+ # return from follow_link() is an HTTP::Response or undef
+ my $response = $self->follow_link( %$parms );
+
+ my $ok;
+ my $error;
+ if ( !$response ) {
+ $error = "No matching link found";
+ }
+ else {
+ if ( !$response->is_success ) {
+ $error = $response->as_string;
+ }
+ else {
+ $ok = 1;
+ }
+ }
+
+ $Test->ok( $ok, $comment );
+ $Test->diag( $error ) if $error;
+
+ return $ok;
+}
+
+=head2 $mech->stuff_inputs( [\%options] )
+
+Finds all free-text input fields (text, textarea, and password) in the
+current form and fills them to their maximum length in hopes of finding
+application code that can't handle it. Fields with no maximum length
+and all textarea fields are set to 66000 bytes, which will often be
+enough to overflow the data's eventual recepticle.
+
+There is no return value.
+
+If there is no current form then nothing is done.
+
+The hashref $options can contain the following keys:
+
+=over
+
+=item * ignore
+
+hash value is arrayref of field names to not touch, e.g.:
+
+ $mech->stuff_inputs( {
+ ignore => [qw( specialfield1 specialfield2 )],
+ } );
+
+=item * fill
+
+hash value is default string to use when stuffing fields. Copies
+of the string are repeated up to the max length of each field. E.g.:
+
+ $mech->stuff_inputs( {
+ fill => '@' # stuff all fields with something easy to recognize
+ } );
+
+=item * specs
+
+hash value is arrayref of hashrefs with which you can pass detailed
+instructions about how to stuff a given field. E.g.:
+
+ $mech->stuff_inputs( {
+ specs=>{
+ # Some fields are datatype-constrained. It's most common to
+ # want the field stuffed with valid data.
+ widget_quantity => { fill=>'9' },
+ notes => { maxlength=>2000 },
+ }
+ } );
+
+The specs allowed are I<fill> (use this fill for the field rather than
+the default) and I<maxlength> (use this as the field's maxlength instead
+of any maxlength specified in the HTML).
+
+=back
+
+=cut
+
+sub stuff_inputs {
+ my $self = shift;
+
+ my $options = shift || {};
+ assert_isa( $options, 'HASH' );
+ assert_in( $_, ['ignore', 'fill', 'specs'] ) foreach ( keys %$options );
+
+ # set up the fill we'll use unless a field overrides it
+ my $default_fill = '@';
+ if ( exists $options->{fill} && defined $options->{fill} && length($options->{fill}) > 0 ) {
+ $default_fill = $options->{fill};
+ }
+
+ # fields in the form to not stuff
+ my $ignore = {};
+ if ( exists $options->{ignore} ) {
+ assert_isa( $options->{ignore}, 'ARRAY' );
+ $ignore = { map {($_, 1)} @{$options->{ignore}} };
+ }
+
+ my $specs = {};
+ if ( exists $options->{specs} ) {
+ assert_isa( $options->{specs}, 'HASH' );
+ $specs = $options->{specs};
+ foreach my $field_name ( keys %$specs ) {
+ assert_isa( $specs->{$field_name}, 'HASH' );
+ assert_in( $_, ['fill', 'maxlength'] ) foreach ( keys %{$specs->{$field_name}} );
+ }
+ }
+
+ my @inputs = $self->find_all_inputs( type => qr/^(text|textarea|password)$/ );
+
+ foreach my $field ( @inputs ) {
+ next if $field->readonly();
+ next if $field->disabled(); # TODO: HTML::Form::TextInput allows setting disabled--allow it here?
+
+ my $name = $field->name();
+
+ # skip if it's one of the fields to ignore
+ next if exists $ignore->{ $name };
+
+ # fields with no maxlength will get this many characters
+ my $maxlength = 66000;
+
+ # maxlength from the HTML
+ if ( $field->type ne 'textarea' ) {
+ if ( exists $field->{maxlength} ) {
+ $maxlength = $field->{maxlength};
+ # TODO: what to do about maxlength==0 ? non-numeric? less than 0 ?
+ }
+ }
+
+ my $fill = $default_fill;
+
+ if ( exists $specs->{$name} ) {
+ # process the per-field info
+
+ if ( exists $specs->{$name}->{fill} && defined $specs->{$name}->{fill} && length($specs->{$name}->{fill}) > 0 ) {
+ $fill = $specs->{$name}->{fill};
+ }
+
+ # maxlength override from specs
+ if ( exists $specs->{$name}->{maxlength} && defined $specs->{$name}->{maxlength} ) {
+ $maxlength = $specs->{$name}->{maxlength};
+ # TODO: what to do about maxlength==0 ? non-numeric? less than 0?
+ }
+ }
+
+ # stuff it
+ if ( ($maxlength % length($fill)) == 0 ) {
+ # the simple case
+ $field->value( $fill x ($maxlength/length($fill)) );
+ }
+ else {
+ # can be improved later
+ $field->value( substr( $fill x int(($maxlength + length($fill) - 1)/length($fill)), 0, $maxlength ) );
+ }
+ } # for @inputs
+
+ return;
+}
+
+=head1 TODO
+
+Add HTML::Lint and HTML::Tidy capabilities.
+
+=head1 AUTHOR
+
+Andy Lester, C<< <andy at petdance.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-test-www-mechanize at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-WWW-Mechanize>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Test::WWW::Mechanize
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Test-WWW-Mechanize>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Test-WWW-Mechanize>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-WWW-Mechanize>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Test-WWW-Mechanize>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to
+Michael Schwern,
+Mark Blackman,
+Mike O'Regan,
+Shawn Sorichetti,
+Chris Dolan,
+Matt Trout,
+MATSUNO Tokuhiro,
+and Pete Krawczyk for patches.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2004-2007 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.
+
+=cut
+
+1; # End of Test::WWW::Mechanize
31 README
@@ -0,0 +1,31 @@
+Test-WWW-Mechanize
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it get an idea of the modules uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2004 Andy Lester
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
28 perlcriticrc
@@ -0,0 +1,28 @@
+[-CodeLayout::ProhibitParensWithBuiltins]
+[CodeLayout::ProhibitHardTabs]
+allow_leading_tabs = 0
+
+[-CodeLayout::RequireTidyCode]
+
+[-ControlStructures::ProhibitPostfixControls]
+
+[-Documentation::RequirePodAtEnd]
+[-Documentation::RequirePodSections]
+
+[-Editor::RequireEmacsFileVariables]
+[-ErrorHandling::RequireCarping]
+
+[-InputOutput::ProhibitInteractiveTest]
+[-InputOutput::ProhibitBacktickOperators]
+
+[-Miscellanea::RequireRcsKeywords]
+
+[-Modules::RequireVersionVar]
+
+[-RegularExpressions::RequireExtendedFormatting]
+[-RegularExpressions::RequireLineBoundaryMatching]
+
+[-ValuesAndExpressions::ProhibitConstantPragma]
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+
+[-Variables::ProhibitPunctuationVars]
9 t/00load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+diag( "Testing Test::WWW::Mechanize $Test::WWW::Mechanize::VERSION, Perl $], $^X" );
65 t/content_contains.t
@@ -0,0 +1,65 @@
+#!perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# test regex
+test_out( 'ok 1 - Does it say test page?' );
+$mech->content_contains( 'Test Page', "Does it say test page?" );
+test_test( "Finds the contains" );
+
+
+test_out( 'not ok 1 - Where is Mungo?' );
+test_fail(+3);
+test_diag(q( searched: "<html>\x{0a} <head>\x{0a} <title>Test Page</title>\x{0a} </h"...) );
+test_diag(q( can't find: "Mungo") );
+$mech->content_contains( 'Mungo', "Where is Mungo?" );
+test_test( "Handles not finding it" );
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
66 t/content_lacks.t
@@ -0,0 +1,66 @@
+#!perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# test regex
+test_out( 'ok 1 - Does it say Mungo eats cheese?' );
+$mech->content_lacks( 'Mungo eats cheese', "Does it say Mungo eats cheese?" );
+test_test( "Finds the lacks" );
+
+
+test_out( "not ok 1 - Shouldn't say it's a test page" );
+test_fail(+4);
+test_diag(q( searched: "<html>\x{0a} <head>\x{0a} <title>Test Page</title>\x{0a} </h"...) );
+test_diag(q( and found: "Test Page") );
+test_diag(q( at position: 27) );
+$mech->content_lacks( 'Test Page', "Shouldn't say it's a test page" );
+test_test( "Handles not finding it" );
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
70 t/follow_link_ok.t
@@ -0,0 +1,70 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+FOLLOW_GOOD_LINK: {
+ my $mech = Test::WWW::Mechanize->new();
+ isa_ok( $mech,'Test::WWW::Mechanize' );
+
+ $mech->get('http://localhost:'.PORT.'/goodlinks.html');
+ $mech->follow_link_ok( {n=>1}, "Go after first link" );
+}
+
+#FOLLOW_BAD_LINK: {
+my $mech = Test::WWW::Mechanize->new();
+isa_ok( $mech,'Test::WWW::Mechanize' );
+TODO: {
+ local $TODO = "I don't know how to get Test::Builder::Tester to handle regexes for the timestamp.";
+
+ $mech->get('http://localhost:'.PORT.'/badlinks.html');
+ test_out('not ok 1 - Go after bad link');
+ test_fail(+1);
+ $mech->follow_link_ok( {n=>2}, "Go after bad link" );
+ test_diag('');
+ test_test('Handles bad links');
+}
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
66 t/followable_links.t
@@ -0,0 +1,66 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+use URI::file;
+
+use constant PORT => 13432;
+
+my $base = 'http://localhost:'.PORT;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server = TWMServer->new(PORT);
+my $pid = $server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech = Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get("$base/manylinks.html");
+
+# Good links.
+my @links = $mech->followable_links();
+@links = map { $_->url_abs } @links;
+my @expected = (
+ "$base/goodlinks.html",
+ 'http://bongo.com/wang.html',
+ 'https://secure.bongo.com/',
+ "$base/badlinks.html",
+ "$base/goodlinks.html",
+);
+is_deeply( \@links, \@expected, "Got the right links" );
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
49 t/get_ok-parms.t
@@ -0,0 +1,49 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 16;
+use Test::Builder::Tester;
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $ua_args;
+
+sub Test::WWW::Mechanize::success { return 1; }
+sub Test::WWW::Mechanize::get {
+ my $self = shift;
+ my $url = shift;
+ use Data::Dumper;
+ $ua_args = {@_};
+ print Dumper( \@_ ) if @_ % 2;
+ return 1;
+}
+
+my $mech = Test::WWW::Mechanize->new();
+isa_ok( $mech, 'Test::WWW::Mechanize' );
+
+my $url = "dummy://url";
+$mech->get_ok( $url );
+ok( eq_hash( {}, $ua_args ), 'passing URL only' );
+
+$mech->get_ok( $url, 'Description' );
+ok( eq_hash( {}, $ua_args ), 'Passing description' );
+
+$mech->get_ok( $url, undef, 'Description' );
+ok( eq_hash( {}, $ua_args ), 'Passing undef for hash' );
+
+my $wanted = { foo=>1, bar=>2, baz=>3 };
+
+$mech->get_ok( $url, [ %$wanted ] );
+ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous list for hash' );
+
+$mech->get_ok( $url, [ %$wanted ], 'Description' );
+ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous list for hash' );
+
+$mech->get_ok( $url, { %$wanted } );
+ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous array for hash' );
+
+$mech->get_ok( $url, { %$wanted }, 'Description' );
+ok( eq_hash( $wanted, $ua_args ), 'Passing anonymous array for hash' );
81 t/get_ok.t
@@ -0,0 +1,81 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 11;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+GOOD_GET: {
+ my $goodlinks='http://localhost:'.PORT.'/goodlinks.html';
+
+ $mech->get($goodlinks);
+ ok($mech->success, 'sanity check: we can load goodlinks.html');
+
+ test_out('ok 1 - Try to get goodlinks.html');
+ my $ok = $mech->get_ok($goodlinks, 'Try to get goodlinks.html');
+ test_test('Gets existing URI and reports success');
+ is( ref($ok), '', "get_ok() should only return a scalar" );
+ ok( $ok, "And the result should be true" );
+}
+
+BAD_GET: {
+ my $badurl = "http://wango.nonexistent.xx-only-testing/";
+ $mech->get($badurl);
+ ok(!$mech->success, "sanity check: we can't load NONEXISTENT.html");
+
+ test_out( 'not ok 1 - Try to get bad URL' );
+ test_fail( +3 );
+ test_diag( "500" );
+ test_diag( "Can't connect to wango.nonexistent.xx-only-testing:80 (Bad hostname 'wango.nonexistent.xx-only-testing')" );
+ my $ok = $mech->get_ok( $badurl, 'Try to get bad URL' );
+ test_test( 'Fails to get nonexistent URI and reports failure' );
+
+ is( ref($ok), '', "get_ok() should only return a scalar" );
+ ok( !$ok, "And the result should be false" );
+}
+
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
72 t/has_tag.t
@@ -0,0 +1,72 @@
+#!perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 7;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+test_out( 'ok 1 - looking for "Test" link' );
+$mech->has_tag( h1 => 'Test Page', 'looking for "Test" link' );
+test_test( 'Handles finding tag by content' );
+
+test_out( 'not ok 1 - looking for "Quiz" link' );
+test_fail( +1 );
+$mech->has_tag( h1 => 'Quiz', 'looking for "Quiz" link' );
+test_test( 'Handles unfindable tag by content' );
+
+test_out( 'ok 1 - Should have qr/Test 3/i link' );
+$mech->has_tag_like( a => qr/Test 3/, 'Should have qr/Test 3/i link' );
+test_test( 'Handles finding tag by content regexp' );
+
+test_out( 'not ok 1 - Should be missing qr/goof/i link' );
+test_fail( +1 );
+$mech->has_tag_like( a => qr/goof/i, 'Should be missing qr/goof/i link' );
+test_test( 'Handles unfindable tag by content regexp' );
+
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
13 t/html/badlinks.html
@@ -0,0 +1,13 @@
+<html>
+ <head>
+ <title>Test Page</title>
+ </head>
+ <body>
+ Test Page
+ <a href='goodlinks.html'>good</a>
+ <a href='bad1.html'>Test</a>
+ <a href='bad2.html'>Test</a>
+ <a href='bad3.html'>Test</a>
+ </body>
+</html>
+
13 t/html/form.html
@@ -0,0 +1,13 @@
+<html>
+ <head>
+ <title>Test Page</title>
+ </head>
+ <body>
+ <h1>Test Page</h1>
+ <form action="form.html">
+ <input name="name" size="15">
+ <input name="email" size="15" maxlength="40">
+ </form>
+ </body>
+</html>
+
12 t/html/goodlinks.html
@@ -0,0 +1,12 @@
+<html>
+ <head>
+ <title>Test Page</title>
+ </head>
+ <body>
+ <h1>Test Page</h1>
+ <a href='goodlinks.html'>Test 1</a>
+ <a href='badlinks.html'>Test 2</a>
+ <a href='goodlinks.html'>Test 3</a>
+ </body>
+</html>
+
16 t/html/manylinks.html
@@ -0,0 +1,16 @@
+<html>
+ <head>
+ <title>Test Page</title>
+ </head>
+ <body>
+ <h1>Test Page of many link types</h1>
+ <a href='goodlinks.html'>Test 1</a>
+ <a href='http://bongo.com/wang.html'>Blah blah</a>
+ <a href="https://secure.bongo.com/">Secure</a>
+ <a href="mailto:president@whitehouse.gov">Mail your complaints</A>
+ <a href="ftp://ftp.ubuntu.org/">Get your distro</a>
+ <a href='badlinks.html'>Test 2</a>
+ <a href='goodlinks.html'>Test 3</a>
+ </body>
+</html>
+
95 t/link_content.t
@@ -0,0 +1,95 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 9;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+my @urls=$mech->links();
+
+# test regex
+test_out('not ok 1 - link_content_like');
+test_fail(+2);
+test_diag(" 'blah' doesn't look much like a regex to me.");
+$mech->link_content_like(\@urls,'blah','Testing the regex');
+test_test('Handles bad regexs');
+
+# like
+test_out('ok 1 - Checking all page links contain: Test');
+$mech->link_content_like(\@urls,qr/Test/,'Checking all page links contain: Test');
+test_test('Handles All page links contents successful');
+
+test_out('not ok 1 - Checking all page link content failures');
+test_fail(+4);
+test_diag('goodlinks.html');
+test_diag('badlinks.html');
+test_diag('goodlinks.html');
+$mech->link_content_like(\@urls,qr/BadTest/,'Checking all page link content failures');
+test_test('Handles link content not found');
+
+# unlike
+# test regex
+test_out('not ok 1 - link_content_unlike');
+test_fail(+2);
+test_diag(" 'blah' doesn't look much like a regex to me.");
+$mech->link_content_unlike(\@urls,'blah','Testing the regex');
+test_test('Handles bad regexs');
+
+test_out('ok 1 - Checking all page links do not contain: BadTest');
+$mech->link_content_unlike(\@urls,qr/BadTest/,'Checking all page links do not contain: BadTest');
+test_test('Handles All page links unlike contents successful');
+
+test_out('not ok 1 - Checking all page link unlike content failures');
+test_fail(+4);
+test_diag('goodlinks.html');
+test_diag('badlinks.html');
+test_diag('goodlinks.html');
+$mech->link_content_unlike(\@urls,qr/Test/,'Checking all page link unlike content failures');
+test_test('Handles link unlike content found');
+
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
85 t/link_status.t
@@ -0,0 +1,85 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 8;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# Good links.
+my $links=$mech->links();
+test_out('ok 1 - Checking all links status are 200');
+$mech->link_status_is($links,200,'Checking all links status are 200');
+test_test('Handles All Links successful');
+
+$mech->link_status_isnt($links,404,'Checking all links isnt');
+
+# Bad links
+#$mech->get(URI::file->cwd().'t/badlinks.html');
+$mech->get('http://localhost:'.PORT.'/badlinks.html');
+
+$links=$mech->links();
+test_out('not ok 1 - Checking all links some bad');
+test_fail(+2);
+test_diag('goodlinks.html');
+$mech->link_status_is($links,404,'Checking all links some bad');
+test_test('Handles bad links');
+
+
+test_out('not ok 1 - Checking specified link not found');
+test_fail(+2);
+test_diag('test2.html');
+$mech->links_ok('test2.html','Checking specified link not found');
+test_test('Handles link not found');
+
+test_out('not ok 1 - Checking all links not 200');
+test_fail(+2);
+test_diag('goodlinks.html');
+$mech->link_status_isnt($links,200,'Checking all links not 200');
+test_test('Handles all links mismatch');
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
81 t/links_ok.t
@@ -0,0 +1,81 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 8;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# Good links.
+my $links=$mech->links();
+test_out('ok 1 - Checking all links successful');
+$mech->links_ok($links,'Checking all links successful');
+test_test('Handles All Links successful');
+
+$mech->links_ok('goodlinks.html','Specified link');
+
+$mech->links_ok([qw(goodlinks.html badlinks.html)],'Specified link list');
+
+# Bad links
+$mech->get('http://localhost:'.PORT.'/badlinks.html');
+
+$links=$mech->links();
+test_out('not ok 1 - Checking all links some bad');
+test_fail(+4);
+test_diag('bad1.html');
+test_diag('bad2.html');
+test_diag('bad3.html');
+$mech->links_ok($links,'Checking all links some bad');
+test_test('Handles bad links');
+
+test_out('not ok 1 - Checking specified link not found');
+test_fail(+2);
+test_diag('test2.html');
+$mech->links_ok('test2.html','Checking specified link not found');
+test_test('Handles link not found');
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
30 t/new.t
@@ -0,0 +1,30 @@
+#!perl -T
+
+use warnings;
+use strict;
+use Test::More tests => 7;
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+NEW: {
+ my $m = Test::WWW::Mechanize->new;
+ isa_ok( $m, 'Test::WWW::Mechanize' );
+}
+
+# Stolen from WWW::Mechanize's t/new.t.
+# If this works, then subclassing works OK.
+CONSTRUCTOR_PARMS: {
+ my $alias = "Windows IE 6";
+ my $m = Test::WWW::Mechanize->new( agent => $alias );
+ isa_ok( $m, 'Test::WWW::Mechanize' );
+ can_ok( $m, 'request' );
+ is( $m->agent, $alias, "Aliases don't get translated in the constructor" );
+
+ $m->agent_alias( $alias );
+ 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" );
+}
93 t/page_links_content.t
@@ -0,0 +1,93 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 9;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# test regex
+test_out('not ok 1 - page_links_content_like');
+test_fail(+2);
+test_diag(" 'blah' doesn't look much like a regex to me.");
+$mech->page_links_content_like('blah','Testing the regex');
+test_test('Handles bad regexs');
+
+# like
+test_out('ok 1 - Checking all page links contain: Test');
+$mech->page_links_content_like(qr/Test/,'Checking all page links contain: Test');
+test_test('Handles All page links contents successful');
+
+test_out('not ok 1 - Checking all page link content failures');
+test_fail(+4);
+test_diag('goodlinks.html');
+test_diag('badlinks.html');
+test_diag('goodlinks.html');
+$mech->page_links_content_like(qr/BadTest/,'Checking all page link content failures');
+test_test('Handles link content not found');
+
+# unlike
+# test regex
+test_out('not ok 1 - page_links_content_unlike');
+test_fail(+2);
+test_diag(" 'blah' doesn't look much like a regex to me.");
+$mech->page_links_content_unlike('blah','Testing the regex');
+test_test('Handles bad regexs');
+
+test_out('ok 1 - Checking all page links do not contain: BadTest');
+$mech->page_links_content_unlike(qr/BadTest/,'Checking all page links do not contain: BadTest');
+test_test('Handles All page links unlike contents successful');
+
+test_out('not ok 1 - Checking all page link unlike content failures');
+test_fail(+4);
+test_diag('goodlinks.html');
+test_diag('badlinks.html');
+test_diag('goodlinks.html');
+$mech->page_links_content_unlike(qr/Test/,'Checking all page link unlike content failures');
+test_test('Handles link unlike content found');
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
71 t/page_links_ok.t
@@ -0,0 +1,71 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+
+isa_ok($mech,'Test::WWW::Mechanize');
+
+$mech->get('http://localhost:'.PORT.'/goodlinks.html');
+
+# Good links.
+test_out('ok 1 - Checking all page links successful');
+$mech->page_links_ok('Checking all page links successful');
+test_test('Handles All page links successful');
+
+# Bad links
+$mech->get('http://localhost:'.PORT.'/badlinks.html');
+
+test_out('not ok 1 - Checking some page link failures');
+test_fail(+4);
+test_diag('bad1.html');
+test_diag('bad2.html');
+test_diag('bad3.html');
+$mech->page_links_ok('Checking some page link failures');
+test_test('Handles link not found');
+
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
6 t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 0.08";
+plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
8 t/pod.t
@@ -0,0 +1,8 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
55 t/stuff_inputs.t
@@ -0,0 +1,55 @@
+#!perl -Tw
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Test::Builder::Tester;
+use URI::file;
+
+use constant PORT => 13432;
+
+$ENV{http_proxy} = ''; # All our tests are running on localhost
+
+BEGIN {
+ use_ok( 'Test::WWW::Mechanize' );
+}
+
+my $server=TWMServer->new(PORT);
+my $pid=$server->background;
+ok($pid,'HTTP Server started') or die "Can't start the server";
+
+sub cleanup { kill(9,$pid) if !$^S };
+$SIG{__DIE__}=\&cleanup;
+
+my $mech=Test::WWW::Mechanize->new();
+isa_ok( $mech, 'Test::WWW::Mechanize' );
+
+$mech->get('http://localhost:'.PORT.'/form.html');
+$mech->stuff_inputs();
+
+
+cleanup();
+
+{
+ package TWMServer;
+ use base 'HTTP::Server::Simple::CGI';
+
+ sub handle_request {
+ my $self=shift;
+ my $cgi=shift;
+
+ my $file=(split('/',$cgi->path_info))[-1]||'index.html';
+ $file=~s/\s+//g;
+
+ if(-r "t/html/$file") {
+ if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
+ print "HTTP/1.0 200 OK\r\n";
+ print "Content-Type: text/html\r\nContent-Length: ",
+ length($response), "\r\n\r\n", $response;
+ return;
+ }
+ }
+
+ print "HTTP/1.0 404 Not Found\r\n\r\n";
+ }
+}
96 tags
@@ -0,0 +1,96 @@
+!_TAG_FILE_FORMAT 2 /extended format; --format=1 will not append ;" to lines/
+!_TAG_FILE_SORTED 1 /0=unsorted, 1=sorted, 2=foldcase/
+!_TAG_PROGRAM_AUTHOR Darren Hiebert /dhiebert@users.sourceforge.net/
+!_TAG_PROGRAM_NAME Exuberant Ctags //
+!_TAG_PROGRAM_URL http://ctags.sourceforge.net /official site/
+!_TAG_PROGRAM_VERSION 5.7 //
+BAD_GET t/get_ok.t /^BAD_GET: {$/;" l
+CONSTRUCTOR_PARMS t/new.t /^CONSTRUCTOR_PARMS: {$/;" l
+FOLLOW_GOOD_LINK t/follow_link_ok.t /^FOLLOW_GOOD_LINK: {$/;" l
+GOOD_GET t/get_ok.t /^GOOD_GET: {$/;" l
+MY Makefile.PL /^sub MY::postamble {$/;" s
+NEW t/new.t /^NEW: {$/;" l
+PORT t/content_contains.t /^use constant PORT => 13432;$/;" c
+PORT t/content_lacks.t /^use constant PORT => 13432;$/;" c
+PORT t/follow_link_ok.t /^use constant PORT => 13432;$/;" c
+PORT t/followable_links.t /^use constant PORT => 13432;$/;" c
+PORT t/get_ok.t /^use constant PORT => 13432;$/;" c
+PORT t/has_tag.t /^use constant PORT => 13432;$/;" c
+PORT t/link_content.t /^use constant PORT => 13432;$/;" c
+PORT t/link_status.t /^use constant PORT => 13432;$/;" c
+PORT t/links_ok.t /^use constant PORT => 13432;$/;" c
+PORT t/page_links_content.t /^use constant PORT => 13432;$/;" c
+PORT t/page_links_ok.t /^use constant PORT => 13432;$/;" c
+PORT t/stuff_inputs.t /^use constant PORT => 13432;$/;" c
+TODO t/follow_link_ok.t /^TODO: {$/;" l
+TWMServer t/content_contains.t /^ package TWMServer;$/;" p
+TWMServer t/content_lacks.t /^ package TWMServer;$/;" p
+TWMServer t/follow_link_ok.t /^ package TWMServer;$/;" p
+TWMServer t/followable_links.t /^ package TWMServer;$/;" p
+TWMServer t/get_ok.t /^ package TWMServer;$/;" p
+TWMServer t/has_tag.t /^ package TWMServer;$/;" p
+TWMServer t/link_content.t /^ package TWMServer;$/;" p
+TWMServer t/link_status.t /^ package TWMServer;$/;" p
+TWMServer t/links_ok.t /^ package TWMServer;$/;" p
+TWMServer t/page_links_content.t /^ package TWMServer;$/;" p
+TWMServer t/page_links_ok.t /^ package TWMServer;$/;" p
+TWMServer t/stuff_inputs.t /^ package TWMServer;$/;" p
+Test t/get_ok-parms.t /^sub Test::WWW::Mechanize::get {$/;" s
+Test t/get_ok-parms.t /^sub Test::WWW::Mechanize::success { return 1; }$/;" s
+Test::WWW::Mechanize Mechanize.pm /^package Test::WWW::Mechanize;$/;" p
+_check_links_content Mechanize.pm /^sub _check_links_content {$/;" s
+_check_links_status Mechanize.pm /^sub _check_links_status {$/;" s
+_format_links Mechanize.pm /^sub _format_links {$/;" s
+_tag_walk Mechanize.pm /^sub _tag_walk {$/;" s
+base_is Mechanize.pm /^sub base_is {$/;" s
+base_like Mechanize.pm /^sub base_like {$/;" s
+base_unlike Mechanize.pm /^sub base_unlike {$/;" s
+cleanup t/content_contains.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/content_lacks.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/follow_link_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/followable_links.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/get_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/has_tag.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/link_content.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/link_status.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/links_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/page_links_content.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/page_links_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+cleanup t/stuff_inputs.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
+content_contains Mechanize.pm /^sub content_contains {$/;" s
+content_is Mechanize.pm /^sub content_is {$/;" s
+content_lacks Mechanize.pm /^sub content_lacks {$/;" s
+content_like Mechanize.pm /^sub content_like {$/;" s
+content_unlike Mechanize.pm /^sub content_unlike {$/;" s
+critic Makefile.PL /^critic:$/;" l
+follow_lin