File Coverage

blib/lib/HTML/FormFu/Filter/HTMLScrubber.pm
Criterion Covered Total %
statement 23 27 85.1
branch 3 6 50.0
condition n/a
subroutine 6 7 85.7
pod 0 2 0.0
total 32 42 76.1


line stmt bran cond sub pod time code
1 2     2   727 use strict;
  2         6  
  2         124  
2              
3             package HTML::FormFu::Filter::HTMLScrubber;
4             $HTML::FormFu::Filter::HTMLScrubber::VERSION = '2.07';
5             # ABSTRACT: filter removing HTML markup
6              
7 2     2   13 use Moose;
  2         5  
  2         14  
8 2     2   13574 use MooseX::Attribute::Chained;
  2         4  
  2         85  
9             extends 'HTML::FormFu::Filter';
10              
11 2     2   13 use Clone ();
  2         5  
  2         173  
12              
13             has allow => ( is => 'rw', traits => ['Chained'] );
14             has comment => ( is => 'rw', traits => ['Chained'] );
15             has default => ( is => 'rw', traits => ['Chained'] );
16             has rules => ( is => 'rw', traits => ['Chained'] );
17             has script => ( is => 'rw', traits => ['Chained'] );
18              
19 2     2   1129 use HTML::Scrubber;
  2         18293  
  2         380  
20              
21             sub filter {
22 3     3 0 8 my ( $self, $value ) = @_;
23              
24 3 50       14 return if !defined $value;
25              
26 3         13 my %params = ( allow => 0 );
27 3         7 foreach (qw(allow comment default rules script)) {
28 15         447 my $val = $self->$_;
29 15 100       37 $params{$_} = $val if ( defined($val) );
30             }
31              
32 3         17 my $scrubber = HTML::Scrubber->new(%params);
33              
34 3         431 return $scrubber->scrub($value);
35             }
36              
37             sub clone {
38 0     0 0   my $self = shift;
39              
40 0           my $clone = $self->SUPER::clone(@_);
41              
42 0 0         $clone->allow( Clone::clone $self->allow )
43             if ref $self->allow;
44              
45 0           return $clone;
46             }
47              
48             __PACKAGE__->meta->make_immutable;
49              
50             1;
51              
52             __END__
53              
54             =pod
55              
56             =encoding UTF-8
57              
58             =head1 NAME
59              
60             HTML::FormFu::Filter::HTMLScrubber - filter removing HTML markup
61              
62             =head1 VERSION
63              
64             version 2.07
65              
66             =head1 DESCRIPTION
67              
68             Remove HTML markup using L<HTML::Scrubber>.
69              
70             All the functionality of L<HTML::Scrubber> can be accessed using
71             this module, other than the C<process> directive (which has a name
72             clash with the L<HTML::FormFu::Filter> framework).
73              
74             For details of the filtering functionality see
75             L<HTML::Scrubber/allow>, L<HTML::Scrubber/comment>,
76             L<HTML::Scrubber/default>, L<HTML::Scrubber/rules> and
77             L<HTML::Scrubber/script>
78              
79             =head1 AUTHOR
80              
81             Carl Franks, C<cfranks@cpan.org>
82              
83             Extended by Nigel Metheringham, C<nigelm@cpan.org>
84              
85             Based on the original source code of L<HTML::Widget::Filter::HTMLStrip>, by
86             Lyo Kato, C<lyo.kato@gmail.com>
87              
88             =head1 LICENSE
89              
90             This library is free software, you can redistribute it and/or modify it under
91             the same terms as Perl itself.
92              
93             =head1 AUTHOR
94              
95             Carl Franks <cpan@fireartist.com>
96              
97             =head1 COPYRIGHT AND LICENSE
98              
99             This software is copyright (c) 2018 by Carl Franks.
100              
101             This is free software; you can redistribute it and/or modify it under
102             the same terms as the Perl 5 programming language system itself.
103              
104             =cut