Skip to content

Commit

Permalink
making perlcritic happy
Browse files Browse the repository at this point in the history
  • Loading branch information
petdance committed Jun 2, 2008
1 parent 1f22d2d commit b8fbeb6
Show file tree
Hide file tree
Showing 5 changed files with 99 additions and 75 deletions.
4 changes: 4 additions & 0 deletions Changes
Expand Up @@ -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
Expand Down
82 changes: 42 additions & 40 deletions bin/weblint
Expand Up @@ -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 ) {
Expand All @@ -29,64 +29,66 @@ 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;
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
44 changes: 29 additions & 15 deletions lib/HTML/Lint.pm
Expand Up @@ -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
Expand All @@ -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};
}

Expand Down Expand Up @@ -171,6 +171,8 @@ sub clear_errors {
my $self = shift;

$self->{_errors} = [];

return;
}

=head2 $lint->only_types( $type1[, $type2...] )
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -299,7 +301,6 @@ sub gripe {
}

sub _start_document {
my $self = shift;
}

sub _end_document {
Expand All @@ -310,6 +311,8 @@ sub _end_document {
$self->gripe( 'doc-tag-required', tag => $tag );
}
}

return;
}

sub _start {
Expand Down Expand Up @@ -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} )
);
}
}
Expand All @@ -355,6 +358,8 @@ sub _start {
if ( $self->can($tagfunc) ) {
$self->$tagfunc( $tag, @attr );
}

return;
}

sub _text {
Expand All @@ -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 {
Expand All @@ -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
Expand All @@ -399,21 +406,25 @@ sub _end {
if ( $self->can($tagfunc) ) {
$self->$tagfunc( $tag, $line );
}

return;
}

sub _element_push {
my $self = shift;
for ( @_ ) {
push( @{$self->{_stack}}, [$_,$self->{_line},$self->{_column}] );
} # while

return;
}

sub _find_tag_in_stack {
my $self = shift;
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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -508,3 +521,4 @@ Andy Lester, andy at petdance.com
=cut

1;
6 changes: 3 additions & 3 deletions lib/HTML/Lint/Error.pm
Expand Up @@ -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";
Expand Down Expand Up @@ -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()
Expand All @@ -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()
Expand Down
38 changes: 21 additions & 17 deletions lib/Test/HTML/Lint.pm
Expand Up @@ -57,6 +57,8 @@ sub import {
$Tester->plan(@_);

$self->export_to_level(1, $self, @EXPORT);

return;
}

=head2 html_ok( [$lint, ] $html, $name )
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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.
Expand Down

0 comments on commit b8fbeb6

Please sign in to comment.