view release on metacpan or  search on metacpan

lib/CGI/Application/Plugin/HtmlTidy.pm  view on Meta::CPAN

package CGI::Application::Plugin::HtmlTidy;
BEGIN {
  $CGI::Application::Plugin::HtmlTidy::VERSION = '1.05';
}

use 5.006;
use strict;
use warnings;
use Carp;
use CGI::Application 4.01;
use HTML::Template;
use HTML::Tidy 1.08;

require Exporter;
our @ISA = qw(Exporter);

our @EXPORT = qw(htmltidy htmltidy_clean htmltidy_config);

sub import
{
    my $c = scalar caller;
    $c->add_callback( 'devpopup_report', \&htmltidy_validate ) if $c->can('devpopup');
    goto &Exporter::import;
}

sub htmltidy
{
    my $self = shift;
    my $opts = $self->param('htmltidy_config') || {};
    htmltidy_config( $self, %$opts ) unless $self->{ __PACKAGE__ . 'OPTIONS' };
    $self->{ __PACKAGE__ . 'HTMLTIDY' } ||= HTML::Tidy->new( $self->{ __PACKAGE__ . 'OPTIONS' } );
}

sub htmltidy_config
{
    my $self = shift;
    my %opts = @_;

    # if no options are supplied, use the default config file.
    # otherwise, all options are passed through (and expected to be
    # valid tidy-options).
    if( !%opts ) {
        $opts{config_file} = __find_config();
    }
    
    $self->{ __PACKAGE__ . 'OPTIONS' } = \%opts;
}

sub htmltidy_clean
{
    my ( $self, $outputref ) = @_;
    return unless __check_header($self);
    $$outputref = $self->htmltidy->clean($$outputref);
}

sub htmltidy_validate
{
    my ( $self, $outputref ) = @_;
    return unless __check_header($self);
    $self->htmltidy->parse( 'why would i need to pass a file name if it isn\'t used?', $$outputref );
    if ( $self->htmltidy->messages )
    {
        my @msgs;
        my @output = map { { html => $_ } } split $/, $$outputref;
        my ($errors, $warnings) = (0,0);
        foreach ( $self->htmltidy->messages() )
        {
            $_->type == TIDY_WARNING ? $warnings++ : $errors++;
            push @{ $output[ $_->line - 1 ]->{messages} },
              {
                type => $_->type == TIDY_WARNING ? 'warning' : 'error',
                line => $_->line,
                column => $_->column,
                text   => $_->text,
              };
        }
        my $t = HTML::Template->new( filename => __find_my_path() . '/validate.tmpl', die_on_bad_params => 0, cache => 1 );
        $t->param( output => \@output );
        $self->devpopup->add_report(
            title   => 'HTML::Tidy validation report',
            summary => "$errors errors, $warnings warnings",
            report  => $t->output
        );
    }
    else
    {
        $self->devpopup->add_report(
            title   => 'HTML::Tidy validation report',
            summary => "Your HTML is valid!",
        );
    }
}

sub __check_header
{
    my $self = shift;

    return unless $self->header_type eq 'header';    # don't operate on redirects or 'none'

    my %props = $self->header_props;
    my ($type) = grep /type/i, keys %props;

    return 1 unless defined $type;                   # no type defaults to html, so we have work to do

    return $props{$type} =~ /html/i;
}

### find the config file
### 1. see if we can find the package version
### 2. fall back to /etc/tidy.conf
sub __find_config
{
    my $inc = __find_my_path() . '/tidy.conf';
    return -f $inc ? $inc : '/etc/tidy.conf';
}

sub __find_my_path
{
    my $inc = $INC{'CGI/Application/Plugin/HtmlTidy.pm'};
    $inc =~ s/\.pm$//;
    return $inc;
}

1;

__END__

=pod

=head1 NAME

CGI::Application::Plugin::HtmlTidy - Add HTML::Tidy support to CGI::Application

=head1 VERSION

version 1.05

=head1 SYNOPSIS

  use CGI::Application::Plugin::HtmlTidy;
  
  sub cgiapp_postrun {
    my ($self, $contentref) = @_;

	# your post-process code here
	
    $self->htmltidy_clean($contentref);