File Coverage

blib/lib/HTML/BBCode/StripScripts.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	11	12	91.6
condition	3	6	50.0
subroutine	6	6	100.0
pod	3	3	100.0
total	53	57	92.9

package HTML::BBCode::StripScripts;

use strict;
use URI;
use base qw(HTML::StripScripts::Parser);

our $VERSION = '0.04';

my %bbattrib;
my %bbstyle;
my %bbstyle_overrides = (
   'text-decoration' => 'word',
   'font-style'      => 'word',
   'font-weight'     => 'word',
   'list-style-type' => 'word',
);


sub init_attrib_whitelist {
   unless (%bbattrib) {
      %bbattrib = %{__PACKAGE__->SUPER::init_attrib_whitelist};
      $bbattrib{'h5'}{'class'} = 'word';
   }
   return \%bbattrib;
}

sub init_style_whitelist {
   unless (%bbstyle) {
      %bbstyle = %{__PACKAGE__->SUPER::init_style_whitelist};
      @bbstyle{keys %bbstyle_overrides} = values %bbstyle_overrides;
   }
   return \%bbstyle;
}

sub validate_href_attribute {
   my ($self, $text) = @_;

   # Encode URLs if needed (as per bug 31927)
   my $uri = URI->new($text);
   my $query = $uri->query;
   if($query) {
      if($query =~ m/[^A-Za-z0-9\-_.!~*'()]/ && $query !~ m/%(?![A-Fa-f0-9])/) {
         $query =~ s/([^;&=A-Za-z0-9\-_.!~*'()\%])/sprintf("%%%02X", ord($1))/ge;
         $uri->query($query);
      }
   }

   $text = $uri->as_string;

   return $1
       if $self->{_hssCfg}{AllowRelURL}
       and $text =~ /^((?:[\w\-.!~*|;\/?=+\$,%#]|&){0,100})$/;

   $text =~ m< ^ ( (f|ht)tps? :// [\w\-\.]{1,100} (?:\:\d{1,5})?
                   (?: / (?:[\w\-.!~*|;/?=+\$,%#]|&){0,2000} )?
                 )
               $
             >x ? $1 : undef;
}


1;