HTML::Tidy - (X)HTML validation in a Perl object

    use HTML::Tidy;

    my $tidy = HTML::Tidy->new( {config_file => 'path/to/config'} );
    $tidy->ignore( type => TIDY_WARNING, typed => TIDY_INFO );
    $tidy->parse( "foo.html", $contents_of_foo );

    for my $message ( $tidy->messages ) {
        print $message->as_string;
    }

    my $tidy = HTML::Tidy->new();

    my $tidy = HTML::Tidy->new( {config_file => 'path/to/tidy.cfg'} );

    my $tidy = HTML::Tidy->new( {
                                    output_xhtml => 1,
                                    tidy_mark => 0,
                                } );

    perldoc HTML::Tidy

package HTML::Tidy;

use 5.008;
use strict;
use warnings;
use Carp ();

use HTML::Tidy::Message;

our $VERSION = '1.54';

use base 'Exporter';

use constant TIDY_ERROR   => 3;
use constant TIDY_WARNING => 2;
use constant TIDY_INFO    => 1;

our @EXPORT = qw( TIDY_ERROR TIDY_WARNING TIDY_INFO );

sub new {
    my $class = shift;
    my $args = shift || {};
    my @unsupported_options = qw(
        force-output
        gnu-emacs-file
        gnu-emacs
        keep-time
        quiet
        slide-style
        write-back
    ); # REVIEW perhaps a list of supported options would be better

    my $self = bless {
        messages     => [],
        ignore_type  => [],
        ignore_text  => [],
        config_file  => '',
        tidy_options => {},
    }, $class;

    for my $key (keys %{$args} ) {
        if ($key eq 'config_file') {
            $self->{config_file} = $args->{$key};
            next;
        }

        my $newkey = $key;
        $newkey =~ tr/_/-/;

        if ( grep {$newkey eq $_} @unsupported_options ) {
            Carp::croak( "Unsupported option: $newkey" );
        }

        $self->{tidy_options}->{$newkey} = $args->{$key};
    }

    return $self;
}

sub messages {
    my $self = shift;

    return @{$self->{messages}};
}

sub clear_messages {
    my $self = shift;

    $self->{messages} = [];

    return;
}

sub ignore {
    my $self = shift;
    my @parms = @_;

    while ( @parms ) {
        my $parm = shift @parms;
        my $value = shift @parms;
        my @values = ref($value) eq 'ARRAY' ? @{$value} : ($value);

        Carp::croak( qq{Invalid ignore type of "$parm"} )
            unless ($parm eq 'text') or ($parm eq 'type');

        push( @{$self->{"ignore_$parm"}}, @values );
    } # while

    return;
} # ignore

sub parse {
    my $self = shift;
    my $filename = shift;
    if (@_ == 0) {
        Carp::croak('Usage: parser($filename,$str [, $str...])') ## no critic
    }
    my $html = join( '', @_ );

    utf8::encode($html) unless utf8::is_utf8($html);
    my ($errorblock,$newline) = _tidy_messages( $html,
                                                $self->{config_file},
                                                $self->{tidy_options}
                                              );
    utf8::decode($errorblock);

    return unless defined $errorblock;
    return !$self->_parse_errors($filename, $errorblock, $newline);
}

sub _parse_errors {
    my $self = shift;
    my $filename = shift;
    my $errs = shift;
    my $newline = shift;

    my $parse_errors;

    my @lines = split( /$newline/, $errs );

    for my $line ( @lines ) {
        chomp $line;

        my $message;
        if ( $line =~ /^line (\d+) column (\d+) - (Warning|Error|Info): (.+)$/ ) {
            my ($line, $col, $type, $text) = ($1, $2, $3, $4);
            $type =
                ($type eq 'Warning') ? TIDY_WARNING :
                ($type eq 'Info')    ? TIDY_INFO :
                                       TIDY_ERROR;
            $message = HTML::Tidy::Message->new( $filename, $type, $line, $col, $text );

        }
        elsif ( $line =~ m/^Info: (.+)$/  ) {
            # Info line we don't want

            my $text = $1;
            $message = HTML::Tidy::Message->new( $filename, TIDY_INFO, undef, undef, $text );
        }
        elsif ( $line =~ /^\d+ warnings?, \d+ errors? were found!/ ) {
            # Summary line we don't want

        }
        elsif ( $line eq 'No warnings or errors were found.' ) {
            # Summary line we don't want

        }
        elsif ( $line eq 'This document has errors that must be fixed before' ) {
            # Summary line we don't want

        }
        elsif ( $line eq 'using HTML Tidy to generate a tidied up version.' ) {
            # Summary line we don't want

        }
        elsif ( $line =~ m/^\s*$/  ) {
            # Blank line we don't want

        }
        else {
            Carp::carp "HTML::Tidy: Unknown error type: $line";
            ++$parse_errors;
        }
        push( @{$self->{messages}}, $message )
            if $message && $self->_is_keeper( $message );
    } # for
    return $parse_errors;
}

sub clean {
    my $self = shift;
    if (@_ == 0) {
        Carp::croak('Usage: clean($str [, $str...])') ## no critic
    }
    my $text = join( '', @_ );

    utf8::encode($text) unless utf8::is_utf8($text);
    if ( defined $text ) {
        $text .= "\n";
    }

    my ($cleaned, $errbuf, $newline) = _tidy_clean( $text,
                                          $self->{config_file},
                                          $self->{tidy_options});
    utf8::decode($cleaned);
    utf8::decode($errbuf);

    $self->_parse_errors('', $errbuf, $newline);
    return $cleaned;
}

# Tells whether a given message object is one that we should keep.

sub _is_keeper {
    my $self = shift;

    my $message = shift;

    my @ignore_types = @{$self->{ignore_type}};
    if ( @ignore_types ) {
        return if grep { $message->type == $_ } @ignore_types;
    }

    my @ignore_texts = @{$self->{ignore_text}};
    if ( @ignore_texts ) {
        return if grep { $message->text =~ $_ } @ignore_texts;
    }

    return 1;
}

# backcompat
sub libtidyp_version { shift->tidyp_version }

sub tidyp_version {
    my $version_str = _tidyp_version();

    return $version_str;
}

require XSLoader;
XSLoader::load('HTML::Tidy', $VERSION);

1;

__END__