/ 
HTML-Scrubber-0.02
River stage two • 12 direct dependents • 48 total dependents
/ HTML::Scrubber

NAME

HTML::Scrubber - Perl extension for scrubbing/sanitizing html

SYNOPSIS

#!/usr/bin/perl -w
use HTML::Scrubber;
use strict;
                                                                        #
my $html = q[
    <HR>                                                                #
    <B> bold                                                            #
        <U> underlined                                                  #
            <I>                                                         #
                <A href=#>  LINK    </A>                                #
            </I>                                                        #
        </U>                                                            #
    </B>                                                                #
    </HR>                                                               #
];
                                                                        #
my $scrubber = HTML::Scrubber->new( allow => [ qw[ p b i u hr br ] ] );
                                                                        #
print $scrubber->scrub($html);
                                                                        #
$scrubber->deny( qw[ p b i u hr br ] );
                                                                        #
print $scrubber->scrub($html);
                                                                        #

DESCRIPTION

If you wanna "scrubbing"/"sanitize" html input, this be the modulehtml

I wasn't satisfied with HTML::Sanitizer because it is based on HTML::TreeBuilder, so I thought I'd write something similar that works directly with HTML::Parser.

METHODS

First a note on documentation: just study the EXAMPLE below. It's all the documentation you could need

Also, be sure to read all the comments as well as How does it work?.

If you're new to perl, good luck to you.

scrub_file

$html = $scrubber->scrub_file('foo.html');   ## returns giant string
die "Eeek $!" unless defined $html;  ## opening foo.html may have failed
$scrubber->scrub_file('foo.html', 'new.html') or die "Eeek $!";
$scrubber->scrub_file('foo.html', *STDOUT)
    or die "Eeek $!"
        if fileno STDOUT;

scrub

print $scrubber->scrub($html);  ## returns giant string
$scrubber->scrub($html, 'new.html') or die "Eeek $!";
$scrubber->scrub($html', *STDOUT)
    or die "Eeek $!"
        if fileno STDOUT;

How does it work?

When a tag is encountered, HTML::Scrubber allows/denies the tag using the explicit rule if one exists.

If no explicit rule exists, Scrubber applies the default rule.

If an explicit rule exists, but it's a simple rule(1), the default attribute rule is applied.

EXAMPLE

#!/usr/bin/perl -w
use HTML::Scrubber;
use strict;
                                                                        #
my @allow = qw[ br hr b a ];
                                                                        #
my @rules = (
    script => 0,
    img => {
        src => qr{^(?!http://)}i, # only relative image links allowed
        alt => 1,                 # alt attribute allowed
        '*' => 0,                 # deny all other attributes
    },
);
                                                                        #
my @default = (
    0   =>    # default rule, deny all tags
    {
        '*'           => 1, # default rule, allow all attributes
        'href'        => qr{^(?!(?:java)?script)}i,
        'src'         => qr{^(?!(?:java)?script)}i,
#   If your perl doesn't have qr
#   just use a string with length greater than 1
        'cite'        => '(?i-xsm:^(?!(?:java)?script))',
        'language'    => 0,
        'name'        => 1, # could be sneaky, but hey ;)
        'onblur'      => 0,
        'onchange'    => 0,
        'onclick'     => 0,
        'ondblclick'  => 0,
        'onerror'     => 0,
        'onfocus'     => 0,
        'onkeydown'   => 0,
        'onkeypress'  => 0,
        'onkeyup'     => 0,
        'onload'      => 0,
        'onmousedown' => 0,
        'onmousemove' => 0,
        'onmouseout'  => 0,
        'onmouseover' => 0,
        'onmouseup'   => 0,
        'onreset'     => 0,
        'onselect'    => 0,
        'onsubmit'    => 0,
        'onunload'    => 0,
        'src'         => 0,
        'type'        => 0,
    }
);
                                                                        #
my $scrubber = HTML::Scrubber->new();
$scrubber->allow( @allow );
$scrubber->rules( @rules ); # key/value pairs
$scrubber->default( @default );
$scrubber->comment(1); # 1 allow, 0 deny
                                                                        #
## preferred way to create the same object
$scrubber = HTML::Scrubber->new(
    allow   => \@allow,
    rules   => \@rules,
    default => \@default,
    comment => 1,
    process => 0,
);
                                                                        #
require Data::Dumper,die Data::Dumper::Dumper($scrubber) if @ARGV;
                                                                        #
my $it = q[
    <?php   echo(" EVIL EVIL EVIL "); ?>    <!-- asdf -->
    <hr>
    <I FAKE="attribute" > IN ITALICS WITH FAKE="attribute" </I><br>
    <B> IN BOLD </B><br>
    <A NAME="evil">
        <A HREF="javascript:alert('die die die');">HREF=JAVA &lt;!&gt;</A>
        <br>
        <A HREF="image/bigone.jpg" ONMOUSEOVER="alert('die die die');"> 
            <IMG SRC="image/smallone.jpg" ALT="ONMOUSEOVER JAVASCRIPT">
        </A>
    </A> <br> 
];
                                                                        #
print "#original text",$/, $it, $/;
print
    "#scrubbed text (default ",
    $scrubber->default(), # no arguments returns the current value
    " comment ",
    $scrubber->comment(),
    " process ",
    $scrubber->process(),
    " )",
    $/,
    $scrubber->scrub($it),
    $/;
                                                                        #
$scrubber->default(1); # allow all tags by default
$scrubber->comment(0); # deny comments
                                                                        #
print
    "#scrubbed text (default ",
    $scrubber->default(),
    " comment ",
    $scrubber->comment(),
    " process ",
    $scrubber->process(),
    " )",
    $/,
    $scrubber->scrub($it),
    $/;
                                                                        #
$scrubber->process(1);        # allow process instructions (dangerous)
$default[0] = 1;              # allow all tags by default
$default[1]->{'*'} = 0;       # deny all attributes by default
$scrubber->default(@default); # set the default again
                                                                        #
print
    "#scrubbed text (default ",
    $scrubber->default(),
    " comment ",
    $scrubber->comment(),
    " process ",
    $scrubber->process(),
    " )",
    $/,
    $scrubber->scrub($it),
    $/;

FUN

If you have Test::Inline (and you've installed HTML::Scrubber), try

pod2test Scrubber.pm >scrubber.t
perl scrubber.t

SEE ALSO

HTML::Parser, Test::Inline, HTML::Sanitizer.

AUTHOR

D.H aka PodMaster

Please use http://rt.cpan.org/ to report bugs.

Just go to http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML-Scrubber to see a bug list and/or repot new ones.

LICENSE

Copyright (c) 2003 by D.H. aka PodMaster. All rights reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. If you don't know what this means, visit http://perl.com/ or http://cpan.org/.