Patch: add autolint() accessor/mutator

[moregan]

diff --git a/Mechanize.pm b/Mechanize.pm
index cf05b6f..f8739a4 100644
--- a/Mechanize.pm
+++ b/Mechanize.pm
@@ -117,6 +117,8 @@ and can simply do
 The C<< $mech->get_ok() >> only counts as one test in the test count.  Both the
 main IO operation and the linting must pass for the entire test to pass.

+You can control autolint on the fly with the C<< autolint >> method.
+
 =cut

 sub new {
@@ -131,7 +133,7 @@ sub new {

     my $self = $class->SUPER::new( %args );

-    $self->{autolint} = $autolint;
+    $self->autolint( $autolint );

     return $self;
 }
@@ -170,7 +172,7 @@ sub _maybe_lint {
     local $Test::Builder::Level = $Test::Builder::Level + 1;

     if ( $ok ) {
-        if ( $self->is_html && $self->{autolint} ) {
+        if ( $self->is_html && $self->autolint ) {
             $ok = $self->_lint_content_ok( $desc );
         }
         else {
@@ -488,13 +490,7 @@ sub _lint_content_ok {
         die "Test::WWW::Mechanize can't do linting without HTML::Lint: $@";
     }

-    # XXX Combine with the cut'n'paste version in get_ok()
-
-    my $lint = HTML::Lint->new;
-
-    if ( ref $self->{autolint} && $self->{autolint}->isa('HTML::Lint') ) {
-        $lint = $self->{autolint};
-    }
+    my $lint = (ref $self->{autolint} && $self->{autolint}->isa('HTML::Lint')) ? $self->{autolint} : HTML::Lint->new();

     $lint->parse( $self->content );

@@ -1402,6 +1398,41 @@ sub lacks_uncapped_inputs {
     return $ok;
 }

+
+=head1 METHODS: MISCELLANEOUS
+
+=head2 $mech->autolint( [$status] )
+
+Without an argument, this method returns a true or false value indicating
+whether autolint is active.
+
+When passed an argument, autolint is turned on or off depending on whether
+the argument is true or false, and the previous autolint status is returned.
+As with the autolint option of C<< new >>, C<< $status >> can be an
+L<< HTML::Lint >> object.
+
+If autolint is currently using an L<< HTML::Lint >> object you provided,
+the return is that object, so you can change and exactly restore
+autolint status:
+
+    my $old_status = $mech->autolint( 0 );
+    ... operations that should not be linted ...
+    $mech->autolint->( $old_status );
+
+=cut
+
+sub autolint {
+    my $self = shift;
+
+    my $ret = $self->{autolint};
+    if ( @_ ) {
+        $self->{autolint} = shift;
+    }
+
+    return $ret;
+}
+
+
 =head2 $mech->grep_inputs( \%properties )

 grep_inputs() returns an array of all the input controls in the
diff --git a/t/autolint.t b/t/autolint.t
index 1571cd7..040a34c 100644
--- a/t/autolint.t
+++ b/t/autolint.t
@@ -9,13 +9,56 @@ use URI::file;
 BEGIN {
     eval 'use HTML::Lint';
     plan skip_all => 'HTML::Lint is not installed, cannot test autolint' if $@;
-    plan tests => 8;
+    plan tests => 24;
 }

 BEGIN {
     use_ok( 'Test::WWW::Mechanize' );
 }

+ACCESSOR_MUTATOR: {
+    my $lint = HTML::Lint->new( only_types => HTML::Lint::Error::STRUCTURE );
+
+    ACCESSOR: {
+        my $mech = Test::WWW::Mechanize->new();
+        ok( !$mech->autolint(), 'no autolint to new yields autolint off' );
+
+        $mech = Test::WWW::Mechanize->new( autolint => undef );
+        ok( !$mech->autolint(), 'undef to new yields autolint off' );
+
+        $mech = Test::WWW::Mechanize->new( autolint => 0 );
+        ok( !$mech->autolint(), '0 to new yields autolint off' );
+
+        $mech = Test::WWW::Mechanize->new( autolint => 1 );
+        ok( $mech->autolint(), '1 to new yields autolint on' );
+
+        $mech = Test::WWW::Mechanize->new( autolint => [] );
+        ok( $mech->autolint(), 'non-false, non-object to new yields autolint on' );
+
+        $mech = Test::WWW::Mechanize->new( autolint => $lint );
+        ok( $mech->autolint(), 'HTML::Lint object to new yields autolint on' );
+    }
+
+    MUTATOR: {
+        my $mech = Test::WWW::Mechanize->new();
+
+        ok( !$mech->autolint(0), '0 returns autolint off' );
+        ok( !$mech->autolint(), '0 autolint really off' );
+
+        ok( !$mech->autolint(""), '"" returns autolint off' );
+        ok( !$mech->autolint(), '"" autolint really off' );
+
+        ok( !$mech->autolint(1), '1 returns autolint off (prior state)' );
+        ok( $mech->autolint(), '1 autolint really on' );
+
+        ok( $mech->autolint($lint), 'HTML::Lint object returns autolint on (prior state)' );
+        ok( $mech->autolint(), 'HTML::Lint object autolint really on' );
+        my $ret = $mech->autolint( 0 );
+        isa_ok( $ret, 'HTML::Lint' );
+        ok( !$mech->autolint(), 'autolint off after nuking HTML::Lint object' );
+    }
+}
+
 CUSTOM_LINTER: {
     my $lint = HTML::Lint->new( only_types => HTML::Lint::Error::STRUCTURE );

[petdance]

This has been added to T:W:Mech 1.39_01 and above.