File Coverage

blib/lib/Test/HTML/Tidy/Recursive.pm

Criterion	Covered	Total	%
statement	35	65	53.8
branch	3	6	50.0
condition	2	3	66.6
subroutine	9	15	60.0
pod	6	6	100.0
total	55	95	57.8

package Test::HTML::Tidy::Recursive;
$Test::HTML::Tidy::Recursive::VERSION = '0.6.2';
use strict;
use warnings;
use 5.008;

use Test::More;

use HTML::T5 qw/ TIDY_INFO TIDY_WARNING /;
use File::Find::Object ();
use Path::Tiny qw/ path /;

use MooX qw/ late /;

has filename_re => (
    is      => 'ro',
    default => sub {
        return qr/\.x?html\z/;
    }
);

has targets => ( is => 'ro', isa => 'ArrayRef', required => 1 );

has filename_filter => (
    is      => 'ro',
    default => sub {
        return sub { return 1; }
    }
);

has _tidy        => ( is => 'rw' );
has _error_count => ( is => 'rw', isa => 'Int', default => 0 );

sub report_error
{
    my ( $self, $args ) = @_;

    $self->_error_count( 1 + $self->_error_count );
    diag( $args->{message} );

    return;
}

sub calc_tidy
{
    my $self = shift;

    my $tidy = HTML::T5->new( { output_xhtml => 1, } );
    $tidy->ignore( type => TIDY_WARNING, type => TIDY_INFO );

    return $tidy;
}

sub run
{
    my $self = shift;
    plan tests => 1;
    local $SIG{__WARN__} = sub {
        my $w = shift;
        if ( $w !~ /\AUse of uninitialized/ )
        {
            die $w;
        }
        return;
    };

    $self->_tidy( $self->calc_tidy );
    $self->traverse;
    $self->_tidy('NULL');

    # TEST
    return is( $self->_error_count, 0, "No errors" );
}

sub check_using_tidy
{
    my ( $self, $args ) = @_;

    my $fn = $args->{filename};

    $self->_tidy->parse( $fn, ( path($fn)->slurp_raw() ) );

    for my $message ( $self->_tidy->messages )
    {
        $self->report_error(
            {
                message => scalar $message->as_string
            }
        );
    }

    $self->_tidy->clear_messages();

    return;
}

sub check_file
{
    my ( $self, $args ) = @_;

    $self->check_using_tidy($args);

    return;
}

sub traverse
{
    my ($self) = @_;
    $self->_error_count(0);
    my $filename_re = $self->filename_re;
    my $filter      = $self->filename_filter;

    foreach my $target ( @{ $self->targets } )
    {
        my $ffo = File::Find::Object->new( {}, $target );
        while ( my $item = $ffo->next_obj() )
        {
            my $fn = $item->path();
            if ( not $filter->($fn) )
            {
                $ffo->prune;
            }
            elsif ( $item->is_file() and $fn =~ $filename_re )
            {
                $self->check_file( { filename => $fn } );
            }
        }
    }

    return;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test::HTML::Tidy::Recursive - recursively check files in a directory using
HTML::T5 .

=head1 VERSION

version 0.6.2

=head1 SYNOPSIS

    use Test::HTML::Tidy::Recursive;

    Test::HTML::Tidy::Recursive->new({
        targets => ['./dest-html', './dest-html-production'],
        })->run;

Or with over-riding the defaults:

    use Test::HTML::Tidy::Recursive;

    Test::HTML::Tidy::Recursive->new({
        filename_re => qr/\.x?html?\z/i,
        filename_filter => sub { return shift !~ m#MathJax#; },
        targets => ['./dest-html', './dest-html-production'],
        })->run;

=head1 DESCRIPTION

This module acts as test module which runs L<HTML::T5> on some directory
trees containing HTML/XHTML files and checks that they are all valid.

It was extracted from a bunch of nearly duplicate test scripts in some of
my (= Shlomi Fish) web sites, as an attempt to avoid duplicate code and
functionality.

=head1 METHODS

=head2 calc_tidy

Calculates the L<HTML::T5> object - can be overriden.

=head2 filename_filter

A parameter with a callback to filter the files. Defaults to accept all files.

=head2 filename_re

A regex for which filenames are checked. Defaults to files ending in ".html"
or ".xhtml".

=head2 run

The method that runs the program.

=head2 $obj->check_file({filename => $path_string})

Override this method in subclasses to check a file in a different way.

=head2 $obj->check_using_tidy({filename => $path_string})

Actually check a file using tidy. Used by check_file() by default,
but can also be called there in subclasses.

=head2 $obj->report_error({message => $string});

Reports the error and increment the error count.

=head2 $obj->traverse()

The method that gets called by run() to do the actual traversal of the tree
without actually checking for no errors. Useful for testing and debugging.

=head2 targets

A parameter that accepts an array reference of targets as strings.

=head1 SEE ALSO

L<HTML::T5> .

=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Websites

The following websites have more information about this module, and may be of help to you. As always,
in addition to those websites please use your favorite search engine to discover more resources.

=over 4

=item *

MetaCPAN

A modern, open-source CPAN search engine, useful to view POD in HTML format.

L<https://metacpan.org/release/Test-HTML-Tidy-Recursive>

=item *

RT: CPAN's Bug Tracker

The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.

L<https://rt.cpan.org/Public/Dist/Display.html?Name=Test-HTML-Tidy-Recursive>

=item *

CPANTS

The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.

L<http://cpants.cpanauthors.org/dist/Test-HTML-Tidy-Recursive>

=item *

CPAN Testers

The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.

L<http://www.cpantesters.org/distro/T/Test-HTML-Tidy-Recursive>

=item *

CPAN Testers Matrix

The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.

L<http://matrix.cpantesters.org/?dist=Test-HTML-Tidy-Recursive>

=item *

CPAN Testers Dependencies

The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.

L<http://deps.cpantesters.org/?module=Test::HTML::Tidy::Recursive>

=back

=head2 Bugs / Feature Requests

Please report any bugs or feature requests by email to C<bug-test-html-tidy-recursive at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=Test-HTML-Tidy-Recursive>. You will be automatically notified of any
progress on the request by the system.

=head2 Source Code

The code is open to the world, and available for you to hack on. Please feel free to browse it and play
with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
from your repository :)

L<https://github.com/shlomif/perl-Test-HTML-Tidy-Recursive>

  git clone https://github.com/shlomif/perl-Test-HTML-Tidy-Recursive

=head1 AUTHOR

Shlomi Fish <[e-mail]>

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
L<https://github.com/shlomif/test-html-tidy-recursive/issues>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2016 by Shlomi Fish.

This is free software, licensed under:

  The MIT (X11) License

=cut