File Coverage

blib/lib/HTML/StripTags.pm

Criterion	Covered	Total	%
statement	180	230	78.2
branch	98	120	81.6
condition	48	96	50.0
subroutine	6	6	100.0
pod	1	1	100.0
total	333	453	73.5

package HTML::StripTags;

=head1 NAME

HTML::StripTags - Strip HTML or XML tags from a string with Perl like PHP's strip_tags() does

=head1 SYNOPSIS

 use HTML::StripTags qw(strip_tags);

 $string       = 'Hallo beautiful world!';
 $allowed_tags = '';

 print strip_tags( $string, $allowed_tags );

=head1 DESCRIPTION

HTML::StripTags provides the function strip_tags() that can strip all HTML or XML tags from a string except the given allowed tags.
This is a Perl port of the PHP function strip_tags() based on PHP 5.3.3.

=head1 SECURITY NOTE

Please note: As per L PHP's strip_tags() is a very basic and unsafe method, so it's strongly recommended not to use it for cleaning up user input!
As HTML::StripTags uses the same state machine, the same applies to this module.

=head1 METHODS

=cut

#------------------------- Pragmas ---------------------------------------------
use strict;
use warnings;

#------------------------- Libs ------------------------------------------------
use Carp;
use Exporter;
use Switch 'fallthrough';

our $VERSION = '1.01';
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(strip_tags);

=head2 strip_tags()

A simple little state-machine to strip out html and php tags

State 0 is the output state, state 1 means we are inside a
normal html tag, state 2 means we are inside a php tag, state 3
means we are inside a "
                        if ($p >= 2 && $buf[$p-1] eq '-' && $buf[$p-2] eq '-') {
                            $in_q = $state = 0;
                            @tbuf = ();
                        }
                        last;
                    }
                    case qr/\d/ {
                        push @rbuf, $c;
                        last;
                    }
                }
                last;
            }
            case m/\'|\"/ {
                if ($state == 4) {
                    # Inside
                    last;
                } elsif (($state == 2) && $buf[$p-1] ne '\\') {
                    # Inside PHP
                    if ($lc eq $c) {
                        $lc = "\0";
                    } elsif ($lc ne '\\') {
                        $lc = $c;
                    }
                } elsif ($state == 0) {
                    # Outside a tag
                    push @rbuf, $c;
                } elsif ($allow && $state == 1) {
                    # Inside a tag
                    push @tbuf, $c;
                }
                if ($state && $p != 0 && ($state == 1 || $buf[$p-1] ne '\\') && (!$in_q || $buf[$p] eq $in_q)) {
                    if ($in_q) {
                        $in_q = 0;
                    } else {
                        $in_q = $buf[$p];
                    }
                }
                last;
            }
            case '!' {
                # JavaScript & Other HTML scripting languages
                if ($state == 1 && $buf[$p-1] eq '<') {
                    $state = 3;
                    $lc = $c;
                } else {
                    if ($state == 0) {
                        push @rbuf, $c;
                    } elsif ($allow && $state == 1) {
                        push @tbuf, $c;
                    }
                }
                last;
            }
            case '-' {
                if ($state == 3 && $p >= 2 && $buf[$p-1] eq '-' && $buf[$p-2] eq '!') {
                    #
                    $state = 4;
                } else {
                    next;
                }
                last;
            }
            case '?' {
                if ($state == 1 && $buf[$p-1] eq '<') {
                    # opened
                    $br=0;
                    $state=2;
                    last;
                }
            }
            case m/E|e/ {
                # !DOCTYPE exception
                if ($state==3 && $p > 6
                             && lc($buf[$p-1]) eq 'p'
                             && lc($buf[$p-2]) eq 'y'
                             && lc($buf[$p-3]) eq 't'
                             && lc($buf[$p-4]) eq 'c'
                             && lc($buf[$p-5]) eq 'o'
                             && lc($buf[$p-6]) eq 'd') {
                    # we're not in a