File Coverage

blib/lib/Str/Filter.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	18	18	100.0
condition			n/a
subroutine	13	13	100.0
pod	9	9	100.0
total	80	80	100.0

package Str::Filter;

use strict;
use warnings;

our $VERSION = '0.01';

use base qw(Exporter);

use HTML::Strip;

our (@EXPORT_OK, %EXPORT_TAGS);

@EXPORT_OK = qw(
    filter_leading_whitespace
    filter_trailing_whitespace
    filter_collapse_whitespace
    filter_control_characters
    filter_ascii_only
    filter_escape_pipes
    filter_end_brackets
    filter_html
    filter_style_tags
); # on demand

%EXPORT_TAGS = (
    ALL => [ @EXPORT_OK ],
);

my $stripper = HTML::Strip->new();

#-------------------------------------------------------------------------------
sub filter_leading_whitespace {
    return unless $_[0];
    $_[0] =~ s/\A\s+//msx;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_trailing_whitespace {
    return unless $_[0];
    $_[0] =~ s/\s+\Z//msx;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_collapse_whitespace {
    return unless $_[0];
    $_[0] =~ s/\s+/ /msxg;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_control_characters {
    return unless $_[0];
    $_[0] =~ s/[[:cntrl:]]//msxg;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_ascii_only {
    return unless $_[0];
    # substitute non-ascii characters with nuthin
    $_[0] =~ s/[^[:ascii:]]//msxg;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_escape_pipes {
    return unless $_[0];
    ## no critic qw(ProhibitEscapedMetacharacters)
    $_[0] =~ s{\|}{\\|}msxg;
    ## use critic
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_end_brackets {
    return unless $_[0];
    $_[0] =~ s/\]\]//msxg;
    return 1;
}

#-------------------------------------------------------------------------------
sub filter_html {
    return unless $_[0];
    $_[0] = $stripper->parse($_[0]);
    $stripper->eof();
    return 1;
}

#-------------------------------------------------------------------------------
# this is not full|fool proof. The match between the tags could fail
sub filter_style_tags {
    return unless $_[0];
    ## no critic qw(ProhibitUnusualDelimiters)
    $_[0] =~ s!<\s*(style)("[^"]*"|'[^']*'|[^'">])*>[^<]+!!msxig;
    ## use critic
    return 1;
}

1;

__END__