Refactoring: {strip,restrict}_html in eigene Module ausgelagert

diff --git a/SL/DB/Helper/AttrHTML.pm b/SL/DB/Helper/AttrHTML.pm
index b579972..b5471e0 100644 (file)
--- a/SL/DB/Helper/AttrHTML.pm
+++ b/SL/DB/Helper/AttrHTML.pm
@@ -5,30 +5,6 @@ use strict;
 use parent qw(Exporter);
 our @EXPORT = qw(attr_html);
 
-use utf8;
-use Carp;
-use Encode ();
-use HTML::Restrict ();
-use HTML::Parser;
-
-my %stripper;
-
-sub _strip_html {
-  my ($value) = @_;
-
-  if (!%stripper) {
-    %stripper = ( parser => HTML::Parser->new );
-
-    $stripper{parser}->handler(text => sub { $stripper{text} .= $_[1]; });
-  }
-
-  $stripper{text} = '';
-  $stripper{parser}->parse($value);
-  $stripper{parser}->eof;
-
-  return delete $stripper{text};
-}
-
 sub attr_html {
   my ($package, $attributes, %params) = @_;
 
@@ -49,12 +25,13 @@ sub _make_stripped {
   my ($package, $attribute, %params) = @_;
 
   no strict 'refs';
+  require SL::HTML::Util;
 
   *{ $package . '::' . $attribute . '_as_stripped_html' } = sub {
     my ($self, $value) = @_;
 
-    return $self->$attribute(_strip_html($value)) if @_ > 1;
-    return _strip_html($self->$attribute);
+    return $self->$attribute(SL::HTML::Util->strip($value)) if @_ > 1;
+    return SL::HTML::Util->strip($self->$attribute);
   };
 }
 
@@ -62,8 +39,9 @@ sub _make_restricted {
   my ($package, $attribute, %params) = @_;
 
   no strict 'refs';
+  require SL::HTML::Restrict;
 
-  my $cleaner = HTML::Restrict->new(rules => $params{allowed_tags});
+  my $cleaner = SL::HTML::Restrict->create(%params);
 
   *{ $package . '::' . $attribute . '_as_restricted_html' } = sub {
     my ($self, $value) = @_;

diff --git a/SL/HTML/Restrict.pm b/SL/HTML/Restrict.pm
new file mode 100644 (file)
index 0000000..f30bc87
--- /dev/null
+++ b/SL/HTML/Restrict.pm
@@ -0,0 +1,63 @@
+package SL::HTML::Restrict;
+
+use strict;
+use warnings;
+
+use HTML::Restrict ();
+
+sub create {
+  my ($class, %params)    = @_;
+  $params{allowed_tags} //= { map { ($_ => ['/']) } qw(b strong i em u ul ol li sub sup s strike br p div) };
+
+  return HTML::Restrict->new(rules => $params{allowed_tags});
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::HTML::Restrict - Restrict HTML tags to set of allowed tags
+
+=head1 SYNOPSIS
+
+  my $cleaner = SL::HTML::Restrict->create;
+  my $cleaned = $cleaner->process($unsafe_html);
+
+=head1
+
+Often you want to allow a fixed set of well-known HTML tags to be used
+– but nothing else. This is a thin wrapper providing a default set of
+the following elements:
+
+C<b br div em i li ol p s strike strong sub sup u ul>
+
+This list can be overwritten.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<create [%params]>
+
+Creates and returns a new instance of L<HTML::Restrict>. The optional
+parameter C<allowed_tags> must be an array reference of allowed tag
+names. If it's missing then the default set will be used (see above).
+
+Returns an instance of L<HTML::Restrict>.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut

diff --git a/SL/HTML/Util.pm b/SL/HTML/Util.pm
new file mode 100644 (file)
index 0000000..7212d64
--- /dev/null
+++ b/SL/HTML/Util.pm
@@ -0,0 +1,62 @@
+package SL::HTML::Util;
+
+use strict;
+use warnings;
+
+use HTML::Parser;
+
+my %stripper;
+
+sub strip {
+  my ($class_or_value) = @_;
+
+  my $value = !ref($class_or_value) && (($class_or_value // '') eq 'SL::HTML::Util') ? $_[1] : $class_or_value;
+
+  if (!%stripper) {
+    %stripper = ( parser => HTML::Parser->new );
+
+    $stripper{parser}->handler(text => sub { $stripper{text} .= $_[1]; });
+  }
+
+  $stripper{text} = '';
+  $stripper{parser}->parse($value);
+  $stripper{parser}->eof;
+
+  return delete $stripper{text};
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+SL::HTML::Util - Utility functions dealing with HTML
+
+=head1 SYNOPSIS
+
+  my $plain_text = SL::HTML::Util->strip('<h1>Hello World</h1>');
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<strip $html_content>
+
+Removes all HTML elements and tags from C<$html_content> and returns
+the remaining plain text.
+
+=back
+
+=head1 BUGS
+
+Nothing here yet.
+
+=head1 AUTHOR
+
+Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
+
+=cut

diff --git a/SL/Presenter/Tag.pm b/SL/Presenter/Tag.pm
index 924ab8b..bd48906 100644 (file)
--- a/SL/Presenter/Tag.pm
+++ b/SL/Presenter/Tag.pm
@@ -2,10 +2,12 @@ package SL::Presenter::Tag;
 
 use strict;
 
+use SL::HTML::Restrict;
+
 use parent qw(Exporter);
 
 use Exporter qw(import);
-our @EXPORT = qw(html_tag input_tag man_days_tag name_to_id select_tag stringify_attributes);
+our @EXPORT = qw(html_tag input_tag man_days_tag name_to_id select_tag stringify_attributes restricted_html);
 
 use Carp;
 
@@ -195,6 +197,15 @@ sub _set_id_attribute {
   return %{ $attributes };
 }
 
+my $html_restricter;
+
+sub restricted_html {
+  my ($self, $value) = @_;
+
+  $html_restricter ||= SL::HTML::Restrict->create;
+  return $html_restricter->process($value);
+}
+
 1;
 __END__
 
@@ -264,6 +275,10 @@ Creates a string from all elements in C<%items> suitable for usage as
 HTML tag attributes. Keys and values are HTML escaped even though keys
 must not contain non-ASCII characters for browsers to accept them.
 
+=item C<restricted_html $html>
+
+Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.
+
 =back
 
 =head2 HIGH-LEVEL FUNCTIONS