From b8fbeb68c01b3568c01134b18fb40c5ddfd35738 Mon Sep 17 00:00:00 2001
From: Andy Lester <andy@petdance.com>
Date: Mon, 2 Jun 2008 16:11:57 +0000
Subject: [PATCH] making perlcritic happy

---
 Changes                |  4 +++
 bin/weblint            | 82 +++++++++++++++++++++---------------------
 lib/HTML/Lint.pm       | 44 +++++++++++++++--------
 lib/HTML/Lint/Error.pm |  6 ++--
 lib/Test/HTML/Lint.pm  | 38 +++++++++++---------
 5 files changed, 99 insertions(+), 75 deletions(-)

diff --git a/Changes b/Changes
index c2ab5f8..8029343 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,10 @@ Revision history HTML::Lint and Test::HTML::Lint.
         [FIXES]
         <textarea> now knows about the wrap attribute.
 
+        [INTERNALS]
+        Lots of enhancements pointed out by Perl::Critic.
+
+
 2.02    Thu Nov  3 11:49:18 CST 2005
         [ENHANCEMENTS]
         * The warnings for missing ALT and HEIGHT/WIDTH on your images
diff --git a/bin/weblint b/bin/weblint
index fb482d2..0657629 100755
--- a/bin/weblint
+++ b/bin/weblint
@@ -14,12 +14,12 @@ my $helper    = 1;
 my $fluff     = 1;
 
 GetOptions(
-    "help"	    => \$help,
-    "context:i"	    => \$context,
-    "only"	    => sub { $structure = $helper = $fluff = 0; },
-    "structure!"    => \$structure,
-    "helper!"	    => \$helper,
-    "fluff!"	    => \$fluff,
+    'help'       => \$help,
+    'context:i'  => \$context,
+    'only'       => sub { $structure = $helper = $fluff = 0; },
+    'structure!' => \$structure,
+    'helper!'    => \$helper,
+    'fluff!'     => \$fluff,
 ) or $help = 1;
 
 if ( !@ARGV || $help ) {
@@ -29,9 +29,9 @@ if ( !@ARGV || $help ) {
 }
 
 my @types;
-push( @types, HTML::Lint::Error::STRUCTURE )	if $structure;
-push( @types, HTML::Lint::Error::HELPER )	if $helper;
-push( @types, HTML::Lint::Error::FLUFF )	if $fluff;
+push( @types, HTML::Lint::Error::STRUCTURE ) if $structure;
+push( @types, HTML::Lint::Error::HELPER )    if $helper;
+push( @types, HTML::Lint::Error::FLUFF )     if $fluff;
 
 my $lint = new HTML::Lint;
 $lint->only_types( @types ) if @types;
@@ -39,54 +39,56 @@ for my $url ( @ARGV ) {
     my @lines;
     $lint->newfile( $url );
     if ( $url =~ /^https?:/ ) {
-	eval { require LWP::Simple };
-	if ( $@ ) {
-	    warn "Can't retrieve URLs without LWP::Simple installed";
-	    next;
-	}
+        eval { require LWP::Simple };
+        if ( $@ ) {
+            warn qq{Can't retrieve URLs without LWP::Simple installed};
+            next;
+        }
 
-	my $content = LWP::Simple::get( $url );
-	if ( $content ) {
-	    @lines = split( "\n", $content );
-	    $_ = "$_\n" for @lines;
-	} else {
-	    warn "Unable to fetch $url\n";
-	    next;
-	}
-    } else {
-	open( my $fh, $url ) or die "Can't open $url: $!";
-	@lines = <$fh>;
-	close $fh;
+        my $content = LWP::Simple::get( $url );
+        if ( $content ) {
+            @lines = split( /\n/, $content );
+            $_ = "$_\n" for @lines;
+        }
+        else {
+            warn "Unable to fetch $url\n";
+            next;
+        }
+    }
+    else {
+        open( my $fh, $url ) or die "Can't open $url: $!";
+        @lines = <$fh>;
+        close $fh;
     }
     $lint->parse( $_ ) for @lines;
     $lint->eof();
     for my $error ( $lint->errors() ) {
-	print $error->as_string(), "\n";
-	if ( defined $context ) {
-	    $context += 0;
-	    my $lineno = $error->line - 1;
+        print $error->as_string(), "\n";
+        if ( defined $context ) {
+            $context += 0;
+            my $lineno = $error->line - 1;
 
-	    my $start = $lineno-$context;
-	    $start = 0 if $start < 0;
+            my $start = $lineno-$context;
+            $start = 0 if $start < 0;
 
-	    my $end = $lineno+$context;
-	    $end = $#lines if $end > $#lines;
+            my $end = $lineno+$context;
+            $end = $#lines if $end > $#lines;
 
-	    print "    $_\n" for @lines[$start..$end];
-	    print "\n";
-	}
+            print "    $_\n" for @lines[$start..$end];
+            print "\n";
+        }
     }
     $lint->clear_errors();
 } # for files
 
 __END__
 Usage: weblint [filename or url]... (filename - reads STDIN)
-    --help	    This message
+    --help          This message
     --context[=n]   Show the offending line (and n surrounding lines)
 
     Error types: (default: all on)
     --[no]structure Structural issues, like unclosed tag pairs
     --[no]helper    Helper issues, like missing HEIGHT & WIDTH
-    --[no]fluff	    Fluff that can be removed, like bad tag attributes
-    --only	    Turns off all other error types, as in --only --fluff
+    --[no]fluff     Fluff that can be removed, like bad tag attributes
+    --only          Turns off all other error types, as in --only --fluff
 
diff --git a/lib/HTML/Lint.pm b/lib/HTML/Lint.pm
index b69d62d..0fe250b 100644
--- a/lib/HTML/Lint.pm
+++ b/lib/HTML/Lint.pm
@@ -64,7 +64,7 @@ C<only_types> parm.
 
 If you want more than one, you must pass an arrayref:
 
-    my $lint = HTML::Lint->new( 
+    my $lint = HTML::Lint->new(
         only_types => [HTML::Lint::Error::STRUCTURE, HTML::Lint::Error::FLUFF] );
 
 =cut
@@ -81,7 +81,7 @@ sub new {
     bless $self, $class;
 
     if ( my $only = $args{only_types} ) {
-        $self->only_types( ref $only eq "ARRAY" ? @$only : $only );
+        $self->only_types( ref $only eq "ARRAY" ? @{$only} : $only );
         delete $args{only_types};
     }
 
@@ -171,6 +171,8 @@ sub clear_errors {
     my $self = shift;
 
     $self->{_errors} = [];
+
+    return;
 }
 
 =head2 $lint->only_types( $type1[, $type2...] )
@@ -225,9 +227,9 @@ sub gripe {
 
 =head2 $lint->newfile( $filename )
 
-Call C<newfile()> whenever you switch to another file in a batch of 
-linting.  Otherwise, the object thinks everything is from the same file.
-Note that the list of errors is NOT cleared.
+Call C<newfile()> whenever you switch to another file in a batch
+of linting.  Otherwise, the object thinks everything is from the
+same file.  Note that the list of errors is NOT cleared.
 
 Note that I<$filename> does NOT need to match what's put into parse()
 or parse_file().  It can be a description, a URL, or whatever.
@@ -268,7 +270,7 @@ use HTML::Tagset 3.03;
 use HTML::Lint::HTML4 qw( %isKnownAttribute %isRequired %isNonrepeatable %isObsolete );
 use HTML::Entities qw( %char2entity );
 
-our @ISA = qw( HTML::Parser );
+use base 'HTML::Parser';
 
 sub new {
     my $class = shift;
@@ -299,7 +301,6 @@ sub gripe {
 }
 
 sub _start_document {
-    my $self = shift;
 }
 
 sub _end_document {
@@ -310,6 +311,8 @@ sub _end_document {
             $self->gripe( 'doc-tag-required', tag => $tag );
         }
     }
+
+    return;
 }
 
 sub _start {
@@ -342,7 +345,7 @@ sub _start {
         if ( $isNonrepeatable{$tag} ) {
             $self->gripe( 'elem-nonrepeatable',
                             tag => $tag,
-                            where => HTML::Lint::Error::where(@$where)
+                            where => HTML::Lint::Error::where( @{$where} )
                         );
         }
     }
@@ -355,6 +358,8 @@ sub _start {
     if ( $self->can($tagfunc) ) {
         $self->$tagfunc( $tag, @attr );
     }
+
+    return;
 }
 
 sub _text {
@@ -363,11 +368,13 @@ sub _text {
     while ( $text =~ /([^\x09\x0A\x0D -~])/g ) {
         my $bad = $1;
         $self->gripe(
-            'text-use-entity', 
+            'text-use-entity',
                 char => sprintf( '\x%02lX', ord($bad) ),
                 entity => $char2entity{ $bad },
         );
     }
+
+    return;
 }
 
 sub _end {
@@ -383,8 +390,8 @@ sub _end {
         if ( $self->_in_context($tag) ) {
             my @leftovers = $self->_element_pop_back_to($tag);
             for ( @leftovers ) {
-                my ($tag,$line,$col) = @$_;
-                $self->gripe( 'elem-unclosed', tag => $tag, 
+                my ($tag,$line,$col) = @{$_};
+                $self->gripe( 'elem-unclosed', tag => $tag,
                         where => HTML::Lint::Error::where($line,$col) )
                         unless $HTML::Tagset::optionalEndTag{$tag};
             } # for
@@ -399,6 +406,8 @@ sub _end {
     if ( $self->can($tagfunc) ) {
         $self->$tagfunc( $tag, $line );
     }
+
+    return;
 }
 
 sub _element_push {
@@ -406,6 +415,8 @@ sub _element_push {
     for ( @_ ) {
         push( @{$self->{_stack}}, [$_,$self->{_line},$self->{_column}] );
     } # while
+
+    return;
 }
 
 sub _find_tag_in_stack {
@@ -413,7 +424,7 @@ sub _find_tag_in_stack {
     my $tag = shift;
     my $stack = $self->{_stack};
 
-    my $offset = @$stack - 1;
+    my $offset = @{$stack} - 1;
     while ( $offset >= 0 ) {
         if ( $stack->[$offset][0] eq $tag ) {
             return $offset;
@@ -453,11 +464,13 @@ sub _start_img {
         # Check sizes
     }
     else {
-        $self->gripe( "elem-img-sizes-missing", src=>$src );
+        $self->gripe( 'elem-img-sizes-missing', src=>$src );
     }
     if ( not defined $attr{alt} ) {
-        $self->gripe( "elem-img-alt-missing", src=>$src );
+        $self->gripe( 'elem-img-alt-missing', src=>$src );
     }
+
+    return;
 }
 
 =head1 BUGS, WISHES AND CORRESPONDENCE
@@ -494,7 +507,7 @@ be notified of progress on your bug as I make changes.
 
 =head1 LICENSE
 
-Copyright 2005 Andy Lester, All Rights Reserved.
+Copyright 2005-2008 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.
@@ -508,3 +521,4 @@ Andy Lester, andy at petdance.com
 
 =cut
 
+1;
diff --git a/lib/HTML/Lint/Error.pm b/lib/HTML/Lint/Error.pm
index d5468e2..fdf90fd 100644
--- a/lib/HTML/Lint/Error.pm
+++ b/lib/HTML/Lint/Error.pm
@@ -98,7 +98,7 @@ sub _expand_error {
     my $specs = $errors{$errcode};
     my $str;
     if ( $specs ) {
-        ($str, $self->{_type}) = @$specs;
+        ($str, $self->{_type}) = @{$specs};
     }
     else {
         $str = "Unknown code: $errcode";
@@ -170,7 +170,7 @@ sub where {
         $col = $self->column;
     }
     $col ||= 0;
-    return sprintf( "(%s:%s)", $line, $col + 1 );
+    return sprintf( '(%s:%s)', $line, $col + 1 );
 }
 
 =head2 as_string()
@@ -182,7 +182,7 @@ Returns a nicely-formatted string for printing out to stdout or some similar use
 sub as_string {
     my $self = shift;
 
-    return sprintf( "%s %s %s", $self->file, $self->where, $self->errtext );
+    return sprintf( '%s %s %s', $self->file, $self->where, $self->errtext );
 }
 
 =head2 file()
diff --git a/lib/Test/HTML/Lint.pm b/lib/Test/HTML/Lint.pm
index 56134ee..3732eea 100644
--- a/lib/Test/HTML/Lint.pm
+++ b/lib/Test/HTML/Lint.pm
@@ -57,6 +57,8 @@ sub import {
     $Tester->plan(@_);
 
     $self->export_to_level(1, $self, @EXPORT);
+
+    return;
 }
 
 =head2 html_ok( [$lint, ] $html, $name )
@@ -85,29 +87,31 @@ sub html_ok {
     my $lint;
 
     if ( ref($_[0]) eq "HTML::Lint" ) {
-	$lint = shift;
-	$lint->newfile();
-	$lint->clear_errors();
-    } else {
-	$lint = HTML::Lint->new;
+        $lint = shift;
+        $lint->newfile();
+        $lint->clear_errors();
+    }
+    else {
+        $lint = HTML::Lint->new;
     }
     my $html = shift;
     my $name = shift;
 
     my $ok = defined $html;
     if ( !$ok ) {
-	$Tester->ok( 0, $name );
-    } else {
-	$lint->parse( $html );
-	my $nerr = scalar $lint->errors;
-	$ok = !$nerr;
+        $Tester->ok( 0, $name );
+    }
+    else {
+        $lint->parse( $html );
+        my $nerr = scalar $lint->errors;
+        $ok = !$nerr;
         $Tester->ok( $ok, $name );
-	if ( !$ok ) {
-	    my $msg = "Errors:";
-	    $msg .= " $name" if $name;
-	    $Tester->diag( $msg );
-	    $Tester->diag( $_->as_string ) for $lint->errors;
-	}
+        if ( !$ok ) {
+            my $msg = "Errors:";
+            $msg .= " $name" if $name;
+            $Tester->diag( $msg );
+            $Tester->diag( $_->as_string ) for $lint->errors;
+        }
     }
 
     return $ok;
@@ -139,7 +143,7 @@ this module is taken.
 
 =head1 LICENSE
 
-Copyright 2003 Andy Lester, All Rights Reserved.
+Copyright 2003-2008 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.