view release on metacpan or  search on metacpan

lib/Apache2/WebApp/Plugin/Filters.pm  view on Meta::CPAN

#~~~~~~~~~~~~~~~~~~~~~~~~~~[  OBJECT METHODS  ]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

#----------------------------------------------------------------------------+
# encode_url($url)
#
# Encode URL to ASCII.

sub encode_url {
    my ( $self, $url )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    $url =~ s/([\W])/"%" . uc( sprintf("%2.2x", ord($1)) )/eg;
    return $url;
}

#----------------------------------------------------------------------------+
# decode_url($url)
#
# Decode ASCII to URL.

sub decode_url {
    my ( $self, $url ) 
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    $url =~ tr/+/ /;
    $url =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
    $url =~ s/<!--(.|\n)*-->//g;
    return $url;
}

#----------------------------------------------------------------------------+
# strip_domain_alias($domain)
#
# Remove the subdomain (alias) from a domain name.

sub strip_domain_alias {
    my ( $self, $domain ) 
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    $domain =~ /(?: |\.|\-)([\w-]+?)\.(\w+?) \z/xs;
    return "$1.$2";
}

#----------------------------------------------------------------------------+
# strip_html($markup)
#
# Remove all HTML tags and attributes.

sub strip_html {
    my ( $self, $markup )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my $hs = HTML::StripScripts::Parser->new({
        Context => 'NoTags',
      });

    my $text = $hs->filter_html($markup);
    $text =~ s/<!--filtered-->//g;
    return $text;
}

#----------------------------------------------------------------------------+
# untaint_html($markup)
#
# Remove restricted HTML tags and attributes.

sub untaint_html {
    my ( $self, $markup ) 
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my $hs = HTML::StripScripts::Parser->new({
        AllowHref   => 1,
        AllowRelURL => 1,
        AllowSrc    => 1,
        BanAllBut   => [qw(
          a blockquote br dd dl div em font form img input hr h1 h2 h3 h4 h5 h6