← Back to branch summary

~ubuntu-branches/ubuntu/natty/libtest-www-mechanize-perl/natty

« back to all changes in this revision

Viewing changes to .pc/cgi.patch/Mechanize.pm

  • Committer: Bazaar Package Importer
  • Author(s): gregor herrmann
  • Date: 2010-04-09 20:41:59 UTC
  • mto: This revision was merged to the branch mainline in revision 9.
  • Revision ID: james.westby@ubuntu.com-20100409204159-lufyutnhhx9bqrc4
Tags: 1.26-2
http://bugs.debian.org/577090
Add patch cgi.patch for compatibility with newer versions of CGI.pm;
thanks for Niko Tyni for the bug report and the patch (closes: #577090).

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/cgi.patch/Mechanize.pm
 
1
package Test::WWW::Mechanize;
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
 
 
6
=head1 NAME
 
7
 
 
8
Test::WWW::Mechanize - Testing-specific WWW::Mechanize subclass
 
9
 
 
10
=head1 VERSION
 
11
 
 
12
Version 1.26
 
13
 
 
14
=cut
 
15
 
 
16
our $VERSION = '1.26';
 
17
 
 
18
=head1 SYNOPSIS
 
19
 
 
20
Test::WWW::Mechanize is a subclass of L<WWW::Mechanize> that incorporates
 
21
features for web application testing.  For example:
 
22
 
 
23
    use Test::More tests => 5;
 
24
    use Test::WWW::Mechanize;
 
25
 
 
26
    my $mech = Test::WWW::Mechanize->new;
 
27
    $mech->get_ok( $page );
 
28
    $mech->base_is( 'http://petdance.com/', 'Proper <BASE HREF>' );
 
29
    $mech->title_is( "Invoice Status", "Make sure we're on the invoice page" );
 
30
    $mech->content_contains( "Andy Lester", "My name somewhere" );
 
31
    $mech->content_like( qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
 
32
 
 
33
This is equivalent to:
 
34
 
 
35
    use Test::More tests => 5;
 
36
    use WWW::Mechanize;
 
37
 
 
38
    my $mech = WWW::Mechanize->new;
 
39
    $mech->get( $page );
 
40
    ok( $mech->success );
 
41
    is( $mech->base, 'http://petdance.com', 'Proper <BASE HREF>' );
 
42
    is( $mech->title, "Invoice Status", "Make sure we're on the invoice page" );
 
43
    ok( index( $mech->content, "Andy Lester" ) >= 0, "My name somewhere" );
 
44
    like( $mech->content, qr/(cpan|perl)\.org/, "Link to perl.org or CPAN" );
 
45
 
 
46
but has nicer diagnostics if they fail.
 
47
 
 
48
Default descriptions will be supplied for most methods if you omit them. e.g.
 
49
 
 
50
    my $mech = Test::WWW::Mechanize->new;
 
51
    $mech->get_ok( 'http://petdance.com/' );
 
52
    $mech->base_is( 'http://petdance.com/' );
 
53
    $mech->title_is( "Invoice Status" );
 
54
    $mech->content_contains( "Andy Lester" );
 
55
    $mech->content_like( qr/(cpan|perl)\.org/ );
 
56
 
 
57
results in
 
58
 
 
59
    ok - Got 'http://petdance.com/' ok
 
60
    ok - Base is 'http://petdance.com/'
 
61
    ok - Title is 'Invoice Status'
 
62
    ok - Content contains 'Andy Lester'
 
63
    ok - Content is like '(?-xism:(cpan|perl)\.org)'
 
64
 
 
65
=cut
 
66
 
 
67
use WWW::Mechanize ();
 
68
use Test::LongString;
 
69
use Test::Builder ();
 
70
use Carp ();
 
71
use Carp::Assert::More;
 
72
 
 
73
use base 'WWW::Mechanize';
 
74
 
 
75
my $Test = Test::Builder->new();
 
76
 
 
77
 
 
78
=head1 CONSTRUCTOR
 
79
 
 
80
=head2 new( %args )
 
81
 
 
82
Behaves like, and calls, L<WWW::Mechanize>'s C<new> method.  Any parms
 
83
passed in get passed to WWW::Mechanize's constructor.
 
84
 
 
85
You can pass in C<< autolint => 1 >> to make Test::WWW::Mechanize
 
86
automatically run HTML::Lint after any of the following methods are
 
87
called.
 
88
 
 
89
=over
 
90
 
 
91
=item * get_ok()
 
92
 
 
93
=back
 
94
 
 
95
and will eventually do the same after any of the following:
 
96
 
 
97
=over
 
98
 
 
99
=item * post_ok()
 
100
 
 
101
=item * back_ok()
 
102
 
 
103
=item * submit_form_ok()
 
104
 
 
105
=item * follow_link_ok()
 
106
 
 
107
=item * click_ok()
 
108
 
 
109
=back
 
110
 
 
111
This means you no longerhave to do the following:
 
112
 
 
113
    my $mech = Test::WWW::Mechanize->new();
 
114
    $mech->get_ok( $url, 'Fetch the intro page' );
 
115
    $mech->html_lint_ok( 'Intro page looks OK' );
 
116
 
 
117
and can simply do
 
118
 
 
119
    my $mech = Test::WWW::Mechanize->new( autolint => 1 );
 
120
    $mech->get_ok( $url, 'Fetch the intro page' );
 
121
 
 
122
The C<< $mech->get_ok() >> only counts as one test in the test count.  Both the
 
123
main IO operation and the linting must pass for the entire test to pass.
 
124
 
 
125
=cut
 
126
 
 
127
sub new {
 
128
    my $class = shift;
 
129
 
 
130
    my %args = (
 
131
        agent => "Test-WWW-Mechanize/$VERSION",
 
132
        @_
 
133
    );
 
134
 
 
135
    my $autolint = delete $args{autolint};
 
136
 
 
137
    my $self = $class->SUPER::new( %args );
 
138
 
 
139
    $self->{autolint} = $autolint;
 
140
 
 
141
    return $self;
 
142
}
 
143
 
 
144
=head1 METHODS: HTTP VERBS
 
145
 
 
146
=head2 $mech->get_ok($url, [ \%LWP_options ,] $desc)
 
147
 
 
148
A wrapper around WWW::Mechanize's get(), with similar options, except
 
149
the second argument needs to be a hash reference, not a hash. Like
 
150
well-behaved C<*_ok()> functions, it returns true if the test passed,
 
151
or false if not.
 
152
 
 
153
A default description of "GET $url" is used if none if provided.
 
154
 
 
155
=cut
 
156
 
 
157
sub get_ok {
 
158
    my $self = shift;
 
159
 
 
160
    my ($url,$desc,%opts) = $self->_unpack_args( 'GET', @_ );
 
161
 
 
162
    $self->get( $url, %opts );
 
163
    my $ok = $self->success;
 
164
 
 
165
    $ok = $self->_maybe_lint( $ok, $desc );
 
166
 
 
167
    return $ok;
 
168
}
 
169
 
 
170
sub _maybe_lint {
 
171
    my $self = shift;
 
172
    my $ok   = shift;
 
173
    my $desc = shift;
 
174
 
 
175
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
176
 
 
177
    if ( $ok ) {
 
178
        if ( $self->is_html && $self->{autolint} ) {
 
179
            $ok = $self->_lint_content_ok( $desc );
 
180
        }
 
181
        else {
 
182
            $Test->ok( $ok, $desc );
 
183
        }
 
184
    }
 
185
    else {
 
186
        $Test->ok( $ok, $desc );
 
187
        $Test->diag( $self->status );
 
188
        $Test->diag( $self->response->message ) if $self->response;
 
189
    }
 
190
 
 
191
    return $ok;
 
192
}
 
193
 
 
194
=head2 $mech->head_ok($url, [ \%LWP_options ,] $desc)
 
195
 
 
196
A wrapper around WWW::Mechanize's head(), with similar options, except
 
197
the second argument needs to be a hash reference, not a hash. Like
 
198
well-behaved C<*_ok()> functions, it returns true if the test passed,
 
199
or false if not.
 
200
 
 
201
A default description of "HEAD $url" is used if none if provided.
 
202
 
 
203
=cut
 
204
 
 
205
sub head_ok {
 
206
    my $self = shift;
 
207
 
 
208
    my ($url,$desc,%opts) = $self->_unpack_args( 'HEAD', @_ );
 
209
 
 
210
    $self->head( $url, %opts );
 
211
    my $ok = $self->success;
 
212
 
 
213
    $Test->ok( $ok, $desc );
 
214
    if ( !$ok ) {
 
215
        $Test->diag( $self->status );
 
216
        $Test->diag( $self->response->message ) if $self->response;
 
217
    }
 
218
 
 
219
    return $ok;
 
220
}
 
221
 
 
222
 
 
223
=head2 $mech->post_ok( $url, [ \%LWP_options ,] $desc )
 
224
 
 
225
A wrapper around WWW::Mechanize's post(), with similar options, except
 
226
the second argument needs to be a hash reference, not a hash. Like
 
227
well-behaved C<*_ok()> functions, it returns true if the test passed,
 
228
or false if not.
 
229
 
 
230
A default description of "POST to $url" is used if none if provided.
 
231
 
 
232
=cut
 
233
 
 
234
sub post_ok {
 
235
    my $self = shift;
 
236
 
 
237
    my ($url,$desc,%opts) = $self->_unpack_args( 'POST', @_ );
 
238
 
 
239
    $self->post( $url, \%opts );
 
240
    my $ok = $self->success;
 
241
    $Test->ok( $ok, $desc );
 
242
    if ( !$ok ) {
 
243
        $Test->diag( $self->status );
 
244
        $Test->diag( $self->response->message ) if $self->response;
 
245
    }
 
246
 
 
247
    return $ok;
 
248
}
 
249
 
 
250
=head2 $mech->put_ok( $url, [ \%LWP_options ,] $desc )
 
251
 
 
252
A wrapper around WWW::Mechanize's put(), with similar options, except
 
253
the second argument needs to be a hash reference, not a hash. Like
 
254
well-behaved C<*_ok()> functions, it returns true if the test passed,
 
255
or false if not.
 
256
 
 
257
A default description of "PUT to $url" is used if none if provided.
 
258
 
 
259
=cut
 
260
 
 
261
sub put_ok {
 
262
    my $self = shift;
 
263
 
 
264
    my ($url,$desc,%opts) = $self->_unpack_args( 'PUT', @_ );
 
265
    $self->put( $url, \%opts );
 
266
 
 
267
    my $ok = $self->success;
 
268
    $Test->ok( $ok, $desc );
 
269
    if ( !$ok ) {
 
270
        $Test->diag( $self->status );
 
271
        $Test->diag( $self->response->message ) if $self->response;
 
272
    }
 
273
 
 
274
    return $ok;
 
275
}
 
276
 
 
277
=head2 $mech->submit_form_ok( \%parms [, $desc] )
 
278
 
 
279
Makes a C<submit_form()> call and executes tests on the results.
 
280
The form must be found, and then submitted successfully.  Otherwise,
 
281
this test fails.
 
282
 
 
283
I<%parms> is a hashref containing the parms to pass to C<submit_form()>.
 
284
Note that the parms to C<submit_form()> are a hash whereas the parms to
 
285
this function are a hashref.  You have to call this function like:
 
286
 
 
287
    $agent->submit_form_ok( {n=>3}, "looking for 3rd link" );
 
288
 
 
289
As with other test functions, C<$desc> is optional.  If it is supplied
 
290
then it will display when running the test harness in verbose mode.
 
291
 
 
292
Returns true value if the specified link was found and followed
 
293
successfully.  The L<HTTP::Response> object returned by submit_form()
 
294
is not available.
 
295
 
 
296
=cut
 
297
 
 
298
sub submit_form_ok {
 
299
    my $self = shift;
 
300
    my $parms = shift || {};
 
301
    my $desc = shift;
 
302
 
 
303
    if ( ref $parms ne 'HASH' ) {
 
304
       Carp::croak 'FATAL: parameters must be given as a hashref';
 
305
    }
 
306
 
 
307
    # return from submit_form() is an HTTP::Response or undef
 
308
    my $response = $self->submit_form( %{$parms} );
 
309
 
 
310
    my $ok;
 
311
    my $error;
 
312
    if ( !$response ) {
 
313
        $error = 'No matching form found';
 
314
    }
 
315
    else {
 
316
        if ( $response->is_success ) {
 
317
            $ok = 1;
 
318
        }
 
319
        else {
 
320
            $error = $response->as_string;
 
321
        }
 
322
    }
 
323
 
 
324
    $Test->ok( $ok, $desc );
 
325
    $Test->diag( $error ) if $error;
 
326
 
 
327
    return $ok;
 
328
}
 
329
 
 
330
 
 
331
=head2 $mech->follow_link_ok( \%parms [, $desc] )
 
332
 
 
333
Makes a C<follow_link()> call and executes tests on the results.
 
334
The link must be found, and then followed successfully.  Otherwise,
 
335
this test fails.
 
336
 
 
337
I<%parms> is a hashref containing the parms to pass to C<follow_link()>.
 
338
Note that the parms to C<follow_link()> are a hash whereas the parms to
 
339
this function are a hashref.  You have to call this function like:
 
340
 
 
341
    $mech->follow_link_ok( {n=>3}, "looking for 3rd link" );
 
342
 
 
343
As with other test functions, C<$desc> is optional.  If it is supplied
 
344
then it will display when running the test harness in verbose mode.
 
345
 
 
346
Returns a true value if the specified link was found and followed
 
347
successfully.  The L<HTTP::Response> object returned by follow_link()
 
348
is not available.
 
349
 
 
350
=cut
 
351
 
 
352
sub follow_link_ok {
 
353
    my $self = shift;
 
354
    my $parms = shift || {};
 
355
    my $desc = shift;
 
356
 
 
357
    if (!defined($desc)) {
 
358
        my $parms_str = join(', ', map { join('=', $_, $parms->{$_}) } keys(%{$parms}));
 
359
        $desc = qq{Followed link with "$parms_str"} if !defined($desc);
 
360
    }
 
361
 
 
362
    if ( ref $parms ne 'HASH' ) {
 
363
       Carp::croak 'FATAL: parameters must be given as a hashref';
 
364
    }
 
365
 
 
366
    # return from follow_link() is an HTTP::Response or undef
 
367
    my $response = $self->follow_link( %{$parms} );
 
368
 
 
369
    my $ok;
 
370
    my $error;
 
371
    if ( !$response ) {
 
372
        $error = 'No matching link found';
 
373
    }
 
374
    else {
 
375
        if ( $response->is_success ) {
 
376
            $ok = 1;
 
377
        }
 
378
        else {
 
379
            $error = $response->as_string;
 
380
        }
 
381
    }
 
382
 
 
383
    $Test->ok( $ok, $desc );
 
384
    $Test->diag( $error ) if $error;
 
385
 
 
386
    return $ok;
 
387
}
 
388
 
 
389
 
 
390
=head2 click_ok( $button[, $desc] )
 
391
 
 
392
Clicks the button named by C<$button>.  An optional C<$desc> can
 
393
be given for the test.
 
394
 
 
395
=cut
 
396
 
 
397
sub click_ok {
 
398
    my $self   = shift;
 
399
    my $button = shift;
 
400
    my $desc   = shift;
 
401
 
 
402
    my $response = $self->click( $button );
 
403
    if ( !$response ) {
 
404
        return $Test->ok( 0, $desc );
 
405
    }
 
406
 
 
407
    if ( !$response->is_success ) {
 
408
        $Test->diag( "Failed test $desc:" );
 
409
        $Test->diag( $response->as_string );
 
410
        return $Test->ok( 0, $desc );
 
411
    }
 
412
    return $Test->ok( 1, $desc );
 
413
}
 
414
 
 
415
 
 
416
sub _unpack_args {
 
417
    my $self   = shift;
 
418
    my $method = shift;
 
419
    my $url    = shift;
 
420
 
 
421
    my $desc;
 
422
    my %opts;
 
423
 
 
424
    if ( @_ ) {
 
425
        my $flex = shift; # The flexible argument
 
426
 
 
427
        if ( !defined( $flex ) ) {
 
428
            $desc = shift;
 
429
        }
 
430
        elsif ( ref $flex eq 'HASH' ) {
 
431
            %opts = %{$flex};
 
432
            $desc = shift;
 
433
        }
 
434
        elsif ( ref $flex eq 'ARRAY' ) {
 
435
            %opts = @{$flex};
 
436
            $desc = shift;
 
437
        }
 
438
        else {
 
439
            $desc = $flex;
 
440
        }
 
441
    } # parms left
 
442
 
 
443
    if ( not defined $desc ) {
 
444
        $url = $url->url if ref($url) eq 'WWW::Mechanize::Link';
 
445
        $desc = "$method $url";
 
446
    }
 
447
 
 
448
    return ($url, $desc, %opts);
 
449
}
 
450
 
 
451
 
 
452
 
 
453
=head1 METHODS: CONTENT CHECKING
 
454
 
 
455
=head2 $mech->html_lint_ok( [$desc] )
 
456
 
 
457
Checks the validity of the HTML on the current page.  If the page is not
 
458
HTML, then it fails.  The URI is automatically appended to the I<$desc>.
 
459
 
 
460
Note that HTML::Lint must be installed for this to work.  Otherwise,
 
461
it will blow up.
 
462
 
 
463
=cut
 
464
 
 
465
sub html_lint_ok {
 
466
    my $self = shift;
 
467
    my $desc = shift;
 
468
 
 
469
    my $uri = $self->uri;
 
470
    $desc = $desc ? "$desc ($uri)" : $uri;
 
471
 
 
472
    my $ok;
 
473
 
 
474
    if ( $self->is_html ) {
 
475
        $ok = $self->_lint_content_ok( $desc );
 
476
    }
 
477
    else {
 
478
        $ok = $Test->ok( 0, $desc );
 
479
        $Test->diag( q{This page doesn't appear to be HTML, or didn't get the proper text/html content type returned.} );
 
480
    }
 
481
 
 
482
    return $ok;
 
483
}
 
484
 
 
485
sub _lint_content_ok {
 
486
    my $self = shift;
 
487
    my $desc = shift;
 
488
 
 
489
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
490
 
 
491
    if ( not ( eval 'require HTML::Lint' ) ) {
 
492
        die "Test::WWW::Mechanize can't do linting without HTML::Lint: $@";
 
493
    }
 
494
 
 
495
    # XXX Combine with the cut'n'paste version in get_ok()
 
496
    my $lint = HTML::Lint->new;
 
497
    $lint->parse( $self->content );
 
498
 
 
499
    my @errors = $lint->errors;
 
500
    my $nerrors = @errors;
 
501
    my $ok;
 
502
    if ( $nerrors ) {
 
503
        $ok = $Test->ok( 0, $desc );
 
504
        $Test->diag( 'HTML::Lint errors for ' . $self->uri );
 
505
        $Test->diag( $_->as_string ) for @errors;
 
506
        my $s = $nerrors == 1 ? '' : 's';
 
507
        $Test->diag( "$nerrors error$s on the page" );
 
508
    }
 
509
    else {
 
510
        $ok = $Test->ok( 1, $desc );
 
511
    }
 
512
 
 
513
    return $ok;
 
514
}
 
515
 
 
516
=head2 $mech->title_is( $str [, $desc ] )
 
517
 
 
518
Tells if the title of the page is the given string.
 
519
 
 
520
    $mech->title_is( "Invoice Summary" );
 
521
 
 
522
=cut
 
523
 
 
524
sub title_is {
 
525
    my $self = shift;
 
526
    my $str = shift;
 
527
    my $desc = shift;
 
528
    $desc = qq{Title is "$str"} if !defined($desc);
 
529
 
 
530
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
531
    return is_string( $self->title, $str, $desc );
 
532
}
 
533
 
 
534
=head2 $mech->title_like( $regex [, $desc ] )
 
535
 
 
536
Tells if the title of the page matches the given regex.
 
537
 
 
538
    $mech->title_like( qr/Invoices for (.+)/
 
539
 
 
540
=cut
 
541
 
 
542
sub title_like {
 
543
    my $self = shift;
 
544
    my $regex = shift;
 
545
    my $desc = shift;
 
546
    $desc = qq{Title is like "$regex"} if !defined($desc);
 
547
 
 
548
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
549
    return like_string( $self->title, $regex, $desc );
 
550
}
 
551
 
 
552
=head2 $mech->title_unlike( $regex [, $desc ] )
 
553
 
 
554
Tells if the title of the page matches the given regex.
 
555
 
 
556
    $mech->title_unlike( qr/Invoices for (.+)/
 
557
 
 
558
=cut
 
559
 
 
560
sub title_unlike {
 
561
    my $self = shift;
 
562
    my $regex = shift;
 
563
    my $desc = shift;
 
564
    $desc = qq{Title is unlike "$regex"} if !defined($desc);
 
565
 
 
566
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
567
    return unlike_string( $self->title, $regex, $desc );
 
568
}
 
569
 
 
570
=head2 $mech->base_is( $str [, $desc ] )
 
571
 
 
572
Tells if the base of the page is the given string.
 
573
 
 
574
    $mech->base_is( "http://example.com/" );
 
575
 
 
576
=cut
 
577
 
 
578
sub base_is {
 
579
    my $self = shift;
 
580
    my $str = shift;
 
581
    my $desc = shift;
 
582
    $desc = qq{Base is "$str"} if !defined($desc);
 
583
 
 
584
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
585
    return is_string( $self->base, $str, $desc );
 
586
}
 
587
 
 
588
=head2 $mech->base_like( $regex [, $desc ] )
 
589
 
 
590
Tells if the base of the page matches the given regex.
 
591
 
 
592
    $mech->base_like( qr{http://example.com/index.php?PHPSESSID=(.+)});
 
593
 
 
594
=cut
 
595
 
 
596
sub base_like {
 
597
    my $self = shift;
 
598
    my $regex = shift;
 
599
    my $desc = shift;
 
600
    $desc = qq{Base is like "$regex"} if !defined($desc);
 
601
 
 
602
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
603
    return like_string( $self->base, $regex, $desc );
 
604
}
 
605
 
 
606
=head2 $mech->base_unlike( $regex [, $desc ] )
 
607
 
 
608
Tells if the base of the page matches the given regex.
 
609
 
 
610
    $mech->base_unlike( qr{http://example.com/index.php?PHPSESSID=(.+)});
 
611
 
 
612
=cut
 
613
 
 
614
sub base_unlike {
 
615
    my $self = shift;
 
616
    my $regex = shift;
 
617
    my $desc = shift;
 
618
    $desc = qq{Base is unlike "$regex"} if !defined($desc);
 
619
 
 
620
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
621
    return unlike_string( $self->base, $regex, $desc );
 
622
}
 
623
 
 
624
=head2 $mech->content_is( $str [, $desc ] )
 
625
 
 
626
Tells if the content of the page matches the given string
 
627
 
 
628
=cut
 
629
 
 
630
sub content_is {
 
631
    my $self = shift;
 
632
    my $str = shift;
 
633
    my $desc = shift;
 
634
 
 
635
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
636
    $desc = qq{Content is "$str"} if !defined($desc);
 
637
 
 
638
    return is_string( $self->content, $str, $desc );
 
639
}
 
640
 
 
641
=head2 $mech->content_contains( $str [, $desc ] )
 
642
 
 
643
Tells if the content of the page contains I<$str>.
 
644
 
 
645
=cut
 
646
 
 
647
sub content_contains {
 
648
    my $self = shift;
 
649
    my $str = shift;
 
650
    my $desc = shift;
 
651
 
 
652
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
653
    if ( ref($str) eq 'REGEX' ) {
 
654
        diag( 'content_contains takes a string, not a regex' );
 
655
    }
 
656
    $desc = qq{Content contains "$str"} if !defined($desc);
 
657
 
 
658
    return contains_string( $self->content, $str, $desc );
 
659
}
 
660
 
 
661
=head2 $mech->content_lacks( $str [, $desc ] )
 
662
 
 
663
Tells if the content of the page lacks I<$str>.
 
664
 
 
665
=cut
 
666
 
 
667
sub content_lacks {
 
668
    my $self = shift;
 
669
    my $str = shift;
 
670
    my $desc = shift;
 
671
 
 
672
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
673
    if ( ref($str) eq 'REGEX' ) {
 
674
        diag( 'content_lacks takes a string, not a regex' );
 
675
    }
 
676
    $desc = qq{Content lacks "$str"} if !defined($desc);
 
677
 
 
678
    return lacks_string( $self->content, $str, $desc );
 
679
}
 
680
 
 
681
=head2 $mech->content_like( $regex [, $desc ] )
 
682
 
 
683
Tells if the content of the page matches I<$regex>.
 
684
 
 
685
=cut
 
686
 
 
687
sub content_like {
 
688
    my $self = shift;
 
689
    my $regex = shift;
 
690
    my $desc = shift;
 
691
    $desc = qq{Content is like "$regex"} if !defined($desc);
 
692
 
 
693
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
694
    return like_string( $self->content, $regex, $desc );
 
695
}
 
696
 
 
697
=head2 $mech->content_unlike( $regex [, $desc ] )
 
698
 
 
699
Tells if the content of the page does NOT match I<$regex>.
 
700
 
 
701
=cut
 
702
 
 
703
sub content_unlike {
 
704
    my $self = shift;
 
705
    my $regex = shift;
 
706
    my $desc = shift;
 
707
    $desc = qq{Content is unlike "$regex"} if !defined($desc);
 
708
 
 
709
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
710
    return unlike_string( $self->content, $regex, $desc );
 
711
}
 
712
 
 
713
=head2 $mech->has_tag( $tag, $text [, $desc ] )
 
714
 
 
715
Tells if the page has a C<$tag> tag with the given content in its text.
 
716
 
 
717
=cut
 
718
 
 
719
sub has_tag {
 
720
    my $self = shift;
 
721
    my $tag  = shift;
 
722
    my $text = shift;
 
723
    my $desc = shift;
 
724
    $desc = qq{Page has $tag tag with "$text"} if !defined($desc);
 
725
 
 
726
    my $found = $self->_tag_walk( $tag, sub { $text eq $_[0] } );
 
727
 
 
728
    return $Test->ok( $found, $desc );
 
729
}
 
730
 
 
731
 
 
732
=head2 $mech->has_tag_like( $tag, $regex [, $desc ] )
 
733
 
 
734
Tells if the page has a C<$tag> tag with the given content in its text.
 
735
 
 
736
=cut
 
737
 
 
738
sub has_tag_like {
 
739
    my $self = shift;
 
740
    my $tag  = shift;
 
741
    my $regex = shift;
 
742
    my $desc = shift;
 
743
    $desc = qq{Page has $tag tag like "$regex"} if !defined($desc);
 
744
 
 
745
    my $found = $self->_tag_walk( $tag, sub { $_[0] =~ $regex } );
 
746
 
 
747
    return $Test->ok( $found, $desc );
 
748
}
 
749
 
 
750
 
 
751
sub _tag_walk {
 
752
    my $self = shift;
 
753
    my $tag  = shift;
 
754
    my $match = shift;
 
755
 
 
756
    my $p = HTML::TokeParser->new( \($self->content) );
 
757
 
 
758
    while ( my $token = $p->get_tag( $tag ) ) {
 
759
        my $tagtext = $p->get_trimmed_text( "/$tag" );
 
760
        return 1 if $match->( $tagtext );
 
761
    }
 
762
    return;
 
763
}
 
764
 
 
765
=head2 $mech->followable_links()
 
766
 
 
767
Returns a list of links that Mech can follow.  This is only http and
 
768
https links.
 
769
 
 
770
=cut
 
771
 
 
772
sub followable_links {
 
773
    my $self = shift;
 
774
 
 
775
    return $self->find_all_links( url_abs_regex => qr{^https?://} );
 
776
}
 
777
 
 
778
=head2 $mech->page_links_ok( [ $desc ] )
 
779
 
 
780
Follow all links on the current page and test for HTTP status 200
 
781
 
 
782
    $mech->page_links_ok('Check all links');
 
783
 
 
784
=cut
 
785
 
 
786
sub page_links_ok {
 
787
    my $self = shift;
 
788
    my $desc = shift;
 
789
 
 
790
    $desc = 'All links ok' unless defined $desc;
 
791
 
 
792
    my @links = $self->followable_links();
 
793
    my @urls = _format_links(\@links);
 
794
 
 
795
    my @failures = $self->_check_links_status( \@urls );
 
796
    my $ok = (@failures==0);
 
797
 
 
798
    $Test->ok( $ok, $desc );
 
799
    $Test->diag( $_ ) for @failures;
 
800
 
 
801
    return $ok;
 
802
}
 
803
 
 
804
=head2 $mech->page_links_content_like( $regex [, $desc ] )
 
805
 
 
806
Follow all links on the current page and test their contents for I<$regex>.
 
807
 
 
808
    $mech->page_links_content_like( qr/foo/,
 
809
      'Check all links contain "foo"' );
 
810
 
 
811
=cut
 
812
 
 
813
sub page_links_content_like {
 
814
    my $self = shift;
 
815
    my $regex = shift;
 
816
    my $desc = shift;
 
817
 
 
818
    $desc = qq{All links are like "$regex"} unless defined $desc;
 
819
 
 
820
    my $usable_regex=$Test->maybe_regex( $regex );
 
821
    unless(defined( $usable_regex )) {
 
822
        my $ok = $Test->ok( 0, 'page_links_content_like' );
 
823
        $Test->diag(qq{     "$regex" doesn't look much like a regex to me.});
 
824
        return $ok;
 
825
    }
 
826
 
 
827
    my @links = $self->followable_links();
 
828
    my @urls = _format_links(\@links);
 
829
 
 
830
    my @failures = $self->_check_links_content( \@urls, $regex );
 
831
    my $ok = (@failures==0);
 
832
 
 
833
    $Test->ok( $ok, $desc );
 
834
    $Test->diag( $_ ) for @failures;
 
835
 
 
836
    return $ok;
 
837
}
 
838
 
 
839
=head2 $mech->page_links_content_unlike( $regex [, $desc ] )
 
840
 
 
841
Follow all links on the current page and test their contents do not
 
842
contain the specified regex.
 
843
 
 
844
    $mech->page_links_content_unlike(qr/Restricted/,
 
845
      'Check all links do not contain Restricted');
 
846
 
 
847
=cut
 
848
 
 
849
sub page_links_content_unlike {
 
850
    my $self = shift;
 
851
    my $regex = shift;
 
852
    my $desc = shift;
 
853
    $desc = "All links are unlike '$regex'" if !defined($desc);
 
854
 
 
855
    my $usable_regex=$Test->maybe_regex( $regex );
 
856
    unless(defined( $usable_regex )) {
 
857
        my $ok = $Test->ok( 0, 'page_links_content_unlike' );
 
858
        $Test->diag(qq{     "$regex" doesn't look much like a regex to me.});
 
859
        return $ok;
 
860
    }
 
861
 
 
862
    my @links = $self->followable_links();
 
863
    my @urls = _format_links(\@links);
 
864
 
 
865
    my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
 
866
    my $ok = (@failures==0);
 
867
 
 
868
    $Test->ok( $ok, $desc );
 
869
    $Test->diag( $_ ) for @failures;
 
870
 
 
871
    return $ok;
 
872
}
 
873
 
 
874
=head2 $mech->links_ok( $links [, $desc ] )
 
875
 
 
876
Follow specified links on the current page and test for HTTP status
 
877
200.  The links may be specified as a reference to an array containing
 
878
L<WWW::Mechanize::Link> objects, an array of URLs, or a scalar URL
 
879
name.
 
880
 
 
881
    my @links = $mech->find_all_links( url_regex => qr/cnn\.com$/ );
 
882
    $mech->links_ok( \@links, 'Check all links for cnn.com' );
 
883
 
 
884
    my @links = qw( index.html search.html about.html );
 
885
    $mech->links_ok( \@links, 'Check main links' );
 
886
 
 
887
    $mech->links_ok( 'index.html', 'Check link to index' );
 
888
 
 
889
=cut
 
890
 
 
891
sub links_ok {
 
892
    my $self = shift;
 
893
    my $links = shift;
 
894
    my $desc = shift;
 
895
 
 
896
    my @urls = _format_links( $links );
 
897
    $desc = _default_links_desc(\@urls, 'are ok') unless defined $desc;
 
898
    my @failures = $self->_check_links_status( \@urls );
 
899
    my $ok = (@failures == 0);
 
900
 
 
901
    $Test->ok( $ok, $desc );
 
902
    $Test->diag( $_ ) for @failures;
 
903
 
 
904
    return $ok;
 
905
}
 
906
 
 
907
=head2 $mech->link_status_is( $links, $status [, $desc ] )
 
908
 
 
909
Follow specified links on the current page and test for HTTP status
 
910
passed.  The links may be specified as a reference to an array
 
911
containing L<WWW::Mechanize::Link> objects, an array of URLs, or a
 
912
scalar URL name.
 
913
 
 
914
    my @links = $mech->followable_links();
 
915
    $mech->link_status_is( \@links, 403,
 
916
      'Check all links are restricted' );
 
917
 
 
918
=cut
 
919
 
 
920
sub link_status_is {
 
921
    my $self = shift;
 
922
    my $links = shift;
 
923
    my $status = shift;
 
924
    my $desc = shift;
 
925
 
 
926
    my @urls = _format_links( $links );
 
927
    $desc = _default_links_desc(\@urls, "have status $status") if !defined($desc);
 
928
    my @failures = $self->_check_links_status( \@urls, $status );
 
929
    my $ok = (@failures == 0);
 
930
 
 
931
    $Test->ok( $ok, $desc );
 
932
    $Test->diag( $_ ) for @failures;
 
933
 
 
934
    return $ok;
 
935
}
 
936
 
 
937
=head2 $mech->link_status_isnt( $links, $status [, $desc ] )
 
938
 
 
939
Follow specified links on the current page and test for HTTP status
 
940
passed.  The links may be specified as a reference to an array
 
941
containing L<WWW::Mechanize::Link> objects, an array of URLs, or a
 
942
scalar URL name.
 
943
 
 
944
    my @links = $mech->followable_links();
 
945
    $mech->link_status_isnt( \@links, 404,
 
946
      'Check all links are not 404' );
 
947
 
 
948
=cut
 
949
 
 
950
sub link_status_isnt {
 
951
    my $self = shift;
 
952
    my $links = shift;
 
953
    my $status = shift;
 
954
    my $desc = shift;
 
955
 
 
956
    my @urls = _format_links( $links );
 
957
    $desc = _default_links_desc(\@urls, "do not have status $status") if !defined($desc);
 
958
    my @failures = $self->_check_links_status( \@urls, $status, 'isnt' );
 
959
    my $ok = (@failures == 0);
 
960
 
 
961
    $Test->ok( $ok, $desc );
 
962
    $Test->diag( $_ ) for @failures;
 
963
 
 
964
    return $ok;
 
965
}
 
966
 
 
967
 
 
968
=head2 $mech->link_content_like( $links, $regex [, $desc ] )
 
969
 
 
970
Follow specified links on the current page and test the resulting
 
971
content of each against I<$regex>.  The links may be specified as a
 
972
reference to an array containing L<WWW::Mechanize::Link> objects, an
 
973
array of URLs, or a scalar URL name.
 
974
 
 
975
    my @links = $mech->followable_links();
 
976
    $mech->link_content_like( \@links, qr/Restricted/,
 
977
        'Check all links are restricted' );
 
978
 
 
979
=cut
 
980
 
 
981
sub link_content_like {
 
982
    my $self = shift;
 
983
    my $links = shift;
 
984
    my $regex = shift;
 
985
    my $desc = shift;
 
986
 
 
987
    my $usable_regex=$Test->maybe_regex( $regex );
 
988
    unless(defined( $usable_regex )) {
 
989
        my $ok = $Test->ok( 0, 'link_content_like' );
 
990
        $Test->diag(qq{     "$regex" doesn't look much like a regex to me.});
 
991
        return $ok;
 
992
    }
 
993
 
 
994
    my @urls = _format_links( $links );
 
995
    $desc = _default_links_desc(\@urls, "are like '$regex'") if !defined($desc);
 
996
    my @failures = $self->_check_links_content( \@urls, $regex );
 
997
    my $ok = (@failures == 0);
 
998
 
 
999
    $Test->ok( $ok, $desc );
 
1000
    $Test->diag( $_ ) for @failures;
 
1001
 
 
1002
    return $ok;
 
1003
}
 
1004
 
 
1005
=head2 $mech->link_content_unlike( $links, $regex [, $desc ] )
 
1006
 
 
1007
Follow specified links on the current page and test that the resulting
 
1008
content of each does not match I<$regex>.  The links may be specified as a
 
1009
reference to an array containing L<WWW::Mechanize::Link> objects, an array
 
1010
of URLs, or a scalar URL name.
 
1011
 
 
1012
    my @links = $mech->followable_links();
 
1013
    $mech->link_content_unlike( \@links, qr/Restricted/,
 
1014
      'No restricted links' );
 
1015
 
 
1016
=cut
 
1017
 
 
1018
sub link_content_unlike {
 
1019
    my $self = shift;
 
1020
    my $links = shift;
 
1021
    my $regex = shift;
 
1022
    my $desc = shift;
 
1023
 
 
1024
    my $usable_regex=$Test->maybe_regex( $regex );
 
1025
    unless(defined( $usable_regex )) {
 
1026
        my $ok = $Test->ok( 0, 'link_content_unlike' );
 
1027
        $Test->diag(qq{     "$regex" doesn't look much like a regex to me.});
 
1028
        return $ok;
 
1029
    }
 
1030
 
 
1031
    my @urls = _format_links( $links );
 
1032
    $desc = _default_links_desc(\@urls, qq{are not like "$regex"}) if !defined($desc);
 
1033
    my @failures = $self->_check_links_content( \@urls, $regex, 'unlike' );
 
1034
    my $ok = (@failures == 0);
 
1035
 
 
1036
    $Test->ok( $ok, $desc );
 
1037
    $Test->diag( $_ ) for @failures;
 
1038
 
 
1039
    return $ok;
 
1040
}
 
1041
 
 
1042
# Create a default description for the link_* methods, including the link count.
 
1043
sub _default_links_desc {
 
1044
    my ($urls, $desc_suffix) = @_;
 
1045
    my $url_count = scalar(@{$urls});
 
1046
    return sprintf( '%d link%s %s', $url_count, $url_count == 1 ? '' : 's', $desc_suffix );
 
1047
}
 
1048
 
 
1049
# This actually performs the status check of each url.
 
1050
sub _check_links_status {
 
1051
    my $self = shift;
 
1052
    my $urls = shift;
 
1053
    my $status = shift || 200;
 
1054
    my $test = shift || 'is';
 
1055
 
 
1056
    # Create a clone of the $mech used during the test as to not disrupt
 
1057
    # the original.
 
1058
    my $mech = $self->clone();
 
1059
 
 
1060
    my @failures;
 
1061
 
 
1062
    for my $url ( @{$urls} ) {
 
1063
        if ( $mech->follow_link( url => $url ) ) {
 
1064
            if ( $test eq 'is' ) {
 
1065
                push( @failures, $url ) unless $mech->status() == $status;
 
1066
            }
 
1067
            else {
 
1068
                push( @failures, $url ) unless $mech->status() != $status;
 
1069
            }
 
1070
            $mech->back();
 
1071
        }
 
1072
        else {
 
1073
            push( @failures, $url );
 
1074
        }
 
1075
    } # for
 
1076
 
 
1077
    return @failures;
 
1078
}
 
1079
 
 
1080
# This actually performs the content check of each url. 
 
1081
sub _check_links_content {
 
1082
    my $self = shift;
 
1083
    my $urls = shift;
 
1084
    my $regex = shift || qr/<html>/;
 
1085
    my $test = shift || 'like';
 
1086
 
 
1087
    # Create a clone of the $mech used during the test as to not disrupt
 
1088
    # the original.
 
1089
    my $mech = $self->clone();
 
1090
 
 
1091
    my @failures;
 
1092
    for my $url ( @{$urls} ) {
 
1093
        if ( $mech->follow_link( url => $url ) ) {
 
1094
            my $content=$mech->content();
 
1095
            if ( $test eq 'like' ) {
 
1096
                push( @failures, $url ) unless $content=~/$regex/;
 
1097
            }
 
1098
            else {
 
1099
                push( @failures, $url ) unless $content!~/$regex/;
 
1100
            }
 
1101
            $mech->back();
 
1102
        }
 
1103
        else {
 
1104
            push( @failures, $url );
 
1105
        }
 
1106
    } # for
 
1107
 
 
1108
    return @failures;
 
1109
}
 
1110
 
 
1111
# Create an array of urls to match for mech to follow.
 
1112
sub _format_links {
 
1113
    my $links = shift;
 
1114
 
 
1115
    my @urls;
 
1116
    if (ref($links) eq 'ARRAY') {
 
1117
        if (defined($$links[0])) {
 
1118
            if (ref($$links[0]) eq 'WWW::Mechanize::Link') {
 
1119
                @urls = map { $_->url() } @{$links};
 
1120
            }
 
1121
            else {
 
1122
                @urls = @{$links};
 
1123
            }
 
1124
        }
 
1125
    }
 
1126
    else {
 
1127
        push(@urls,$links);
 
1128
    }
 
1129
    return @urls;
 
1130
}
 
1131
 
 
1132
=head2 $mech->stuff_inputs( [\%options] )
 
1133
 
 
1134
Finds all free-text input fields (text, textarea, and password) in the
 
1135
current form and fills them to their maximum length in hopes of finding
 
1136
application code that can't handle it.  Fields with no maximum length
 
1137
and all textarea fields are set to 66000 bytes, which will often be
 
1138
enough to overflow the data's eventual recepticle.
 
1139
 
 
1140
There is no return value.
 
1141
 
 
1142
If there is no current form then nothing is done.
 
1143
 
 
1144
The hashref $options can contain the following keys:
 
1145
 
 
1146
=over
 
1147
 
 
1148
=item * ignore
 
1149
 
 
1150
hash value is arrayref of field names to not touch, e.g.:
 
1151
 
 
1152
    $mech->stuff_inputs( {
 
1153
        ignore => [qw( specialfield1 specialfield2 )],
 
1154
    } );
 
1155
 
 
1156
=item * fill
 
1157
 
 
1158
hash value is default string to use when stuffing fields.  Copies
 
1159
of the string are repeated up to the max length of each field.  E.g.:
 
1160
 
 
1161
    $mech->stuff_inputs( {
 
1162
        fill => '@'  # stuff all fields with something easy to recognize
 
1163
    } );
 
1164
 
 
1165
=item * specs
 
1166
 
 
1167
hash value is arrayref of hashrefs with which you can pass detailed
 
1168
instructions about how to stuff a given field.  E.g.:
 
1169
 
 
1170
    $mech->stuff_inputs( {
 
1171
        specs=>{
 
1172
            # Some fields are datatype-constrained.  It's most common to
 
1173
            # want the field stuffed with valid data.
 
1174
            widget_quantity => { fill=>'9' },
 
1175
            notes => { maxlength=>2000 },
 
1176
        }
 
1177
    } );
 
1178
 
 
1179
The specs allowed are I<fill> (use this fill for the field rather than
 
1180
the default) and I<maxlength> (use this as the field's maxlength instead
 
1181
of any maxlength specified in the HTML).
 
1182
 
 
1183
=back
 
1184
 
 
1185
=cut
 
1186
 
 
1187
sub stuff_inputs {
 
1188
    my $self = shift;
 
1189
 
 
1190
    my $options = shift || {};
 
1191
    assert_isa( $options, 'HASH' );
 
1192
    assert_in( $_, ['ignore', 'fill', 'specs'] ) foreach ( keys %{$options} );
 
1193
 
 
1194
    # set up the fill we'll use unless a field overrides it
 
1195
    my $default_fill = '@';
 
1196
    if ( exists $options->{fill} && defined $options->{fill} && length($options->{fill}) > 0 ) {
 
1197
        $default_fill = $options->{fill};
 
1198
    }
 
1199
 
 
1200
    # fields in the form to not stuff
 
1201
    my $ignore = {};
 
1202
    if ( exists $options->{ignore} ) {
 
1203
        assert_isa( $options->{ignore}, 'ARRAY' );
 
1204
        $ignore = { map {($_, 1)} @{$options->{ignore}} };
 
1205
    }
 
1206
 
 
1207
    my $specs = {};
 
1208
    if ( exists $options->{specs} ) {
 
1209
        assert_isa( $options->{specs}, 'HASH' );
 
1210
        $specs = $options->{specs};
 
1211
        foreach my $field_name ( keys %{$specs} ) {
 
1212
            assert_isa( $specs->{$field_name}, 'HASH' );
 
1213
            assert_in( $_, ['fill', 'maxlength'] ) foreach ( keys %{$specs->{$field_name}} );
 
1214
        }
 
1215
    }
 
1216
 
 
1217
    my @inputs = $self->find_all_inputs( type_regex => qr/^(text|textarea|password)$/ );
 
1218
 
 
1219
    foreach my $field ( @inputs ) {
 
1220
        next if $field->readonly();
 
1221
        next if $field->disabled();  # TODO: HTML::Form::TextInput allows setting disabled--allow it here?
 
1222
 
 
1223
        my $name = $field->name();
 
1224
 
 
1225
        # skip if it's one of the fields to ignore
 
1226
        next if exists $ignore->{ $name };
 
1227
 
 
1228
        # fields with no maxlength will get this many characters
 
1229
        my $maxlength = 66000;
 
1230
 
 
1231
        # maxlength from the HTML
 
1232
        if ( $field->type ne 'textarea' ) {
 
1233
            if ( exists $field->{maxlength} ) {
 
1234
                $maxlength = $field->{maxlength};
 
1235
                # TODO: what to do about maxlength==0 ?  non-numeric? less than 0 ?
 
1236
            }
 
1237
        }
 
1238
 
 
1239
        my $fill = $default_fill;
 
1240
 
 
1241
        if ( exists $specs->{$name} ) {
 
1242
            # process the per-field info
 
1243
 
 
1244
            if ( exists $specs->{$name}->{fill} && defined $specs->{$name}->{fill} && length($specs->{$name}->{fill}) > 0 ) {
 
1245
                $fill = $specs->{$name}->{fill};
 
1246
            }
 
1247
 
 
1248
            # maxlength override from specs
 
1249
            if ( exists $specs->{$name}->{maxlength} && defined $specs->{$name}->{maxlength} ) {
 
1250
                $maxlength = $specs->{$name}->{maxlength};
 
1251
                # TODO: what to do about maxlength==0 ?  non-numeric? less than 0?
 
1252
            }
 
1253
        }
 
1254
 
 
1255
        # stuff it
 
1256
        if ( ($maxlength % length($fill)) == 0 ) {
 
1257
            # the simple case
 
1258
            $field->value( $fill x ($maxlength/length($fill)) );
 
1259
        }
 
1260
        else {
 
1261
            # can be improved later
 
1262
            $field->value( substr( $fill x int(($maxlength + length($fill) - 1)/length($fill)), 0, $maxlength ) );
 
1263
        }
 
1264
    } # for @inputs
 
1265
 
 
1266
    return;
 
1267
}
 
1268
 
 
1269
=head1 TODO
 
1270
 
 
1271
Add HTML::Tidy capabilities.
 
1272
 
 
1273
Add a broken image check.
 
1274
 
 
1275
=head1 AUTHOR
 
1276
 
 
1277
Andy Lester, C<< <andy at petdance.com> >>
 
1278
 
 
1279
=head1 BUGS
 
1280
 
 
1281
Please report any bugs or feature requests to
 
1282
<http://code.google.com/p/www-mechanize/issues/list>.  I will be
 
1283
notified, and then you'll automatically be notified of progress on
 
1284
your bug as I make changes.
 
1285
 
 
1286
=head1 SUPPORT
 
1287
 
 
1288
You can find documentation for this module with the perldoc command.
 
1289
 
 
1290
    perldoc Test::WWW::Mechanize
 
1291
 
 
1292
You can also look for information at:
 
1293
 
 
1294
=over 4
 
1295
 
 
1296
=item * Google Code bug tracker
 
1297
 
 
1298
L<http://code.google.com/p/www-mechanize/issues/list>
 
1299
 
 
1300
Please B<do not use> the old queues for WWW::Mechanize and
 
1301
Test::WWW::Mechanize at
 
1302
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-WWW-Mechanize>
 
1303
 
 
1304
=item * AnnoCPAN: Annotated CPAN documentation
 
1305
 
 
1306
L<http://annocpan.org/dist/Test-WWW-Mechanize>
 
1307
 
 
1308
=item * CPAN Ratings
 
1309
 
 
1310
L<http://cpanratings.perl.org/d/Test-WWW-Mechanize>
 
1311
 
 
1312
=item * Search CPAN
 
1313
 
 
1314
L<http://search.cpan.org/dist/Test-WWW-Mechanize>
 
1315
 
 
1316
=back
 
1317
 
 
1318
=head1 ACKNOWLEDGEMENTS
 
1319
 
 
1320
Thanks to
 
1321
Greg Sheard,
 
1322
Michael Schwern,
 
1323
Mark Blackman,
 
1324
Mike O'Regan,
 
1325
Shawn Sorichetti,
 
1326
Chris Dolan,
 
1327
Matt Trout,
 
1328
MATSUNO Tokuhiro,
 
1329
and Pete Krawczyk for patches.
 
1330
 
 
1331
=head1 COPYRIGHT & LICENSE
 
1332
 
 
1333
Copyright 2004-2009 Andy Lester.
 
1334
 
 
1335
This program is free software; you can redistribute it and/or
 
1336
modify it under the terms of either:
 
1337
 
 
1338
=over 4
 
1339
 
 
1340
=item * the GNU General Public License as published by the Free
 
1341
Software Foundation; either version 1, or (at your option) any
 
1342
later version, or
 
1343
 
 
1344
=item * the Artistic License version 2.0.
 
1345
 
 
1346
=back
 
1347
 
 
1348
=cut
 
1349
 
 
1350
1; # End of Test::WWW::Mechanize