diff --git a/C4/Scrubber.pm b/C4/Scrubber.pm new file mode 100644 index 0000000000..e8e4023710 --- /dev/null +++ b/C4/Scrubber.pm @@ -0,0 +1,83 @@ +package C4::Scrubber; +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +use strict; +use warnings; +use Carp; +use HTML::Scrubber; + +use C4::Context; +use C4::Debug; + +use vars qw($VERSION @ISA); +use vars qw(%scrubbertypes $scrubbertype); + +BEGIN { + $VERSION = 0.01; + # @ISA = qw(HTML::Scrubber); +} + +INIT { + %scrubbertypes = ( + default => {}, # place holder, default settings are below as fallbacks in call to constructor + tag => {}, # uses defaults + comment => { + allow => [qw( br b i em big small )], + }, + staff => { + default => [ 1 =>{'*'=>1} ], + comment => 1, + }, + ); +} + + +sub new { + my $fakeself = shift; # not really OO, we return an HTML::Scrubber object. + my $type = (@_) ? shift : 'default'; + exists $scrubbertypes{$type} or croak "New called with unrecognized type '$type'"; + $debug and print STDERR "Building new Scrubber of type '$type'\n"; + my $settings = $scrubbertypes{$type}; + my $scrubber = HTML::Scrubber->new( + allow => exists $settings->{allow} ? $settings->{allow} : [], + rules => exists $settings->{rules} ? $settings->{rules} : [], + default => exists $settings->{default} ? $settings->{default} : [ 0 =>{'*'=>0} ], + comment => exists $settings->{comment} ? $settings->{comment} : 0, + process => 0, + ); + return $scrubber; +} + + +1; +__END__ + +=head1 C4::Sanitize + +Standardized wrapper with settings for building HTML::Scrubber tailored to various koha inputs. +More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}. + +The default is to scrub everything, leaving no markup at all. This is compatible with the expectations +for Tags. + +=head2 + +=head3 TO DO: Add real perldoc + +=head2 + +=cut + diff --git a/t/Scrubber.t b/t/Scrubber.t new file mode 100755 index 0000000000..218ecdfe56 --- /dev/null +++ b/t/Scrubber.t @@ -0,0 +1,68 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 10; +BEGIN { + use FindBin; + use lib $FindBin::Bin; + use override_context_prefs; + use_ok('C4::Scrubber'); +} + +sub pretty_line { + my $max = 54; + (@_) or return "#" x $max . "\n"; + my $phrase = " " . shift() . " "; + my $half = "#" x (($max - length($phrase))/2); + return $half . $phrase . $half . "\n"; +} + +my ($scrubber,$html,$result,@types,$collapse); +$collapse = 1; +@types = qw(comment tag); +$html = q| + + +
+
+