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;