Upgrade-Doku: Hinweis auf benötigtes Perl-Modul IPC::Run
[kivitendo-erp.git] / SL / DB / Helper / AttrHTML.pm
1 package SL::DB::Helper::AttrHTML;
2
3 use strict;
4
5 use parent qw(Exporter);
6 our @EXPORT = qw(attr_html);
7
8 sub attr_html {
9   my ($package, $attributes, %params) = @_;
10
11   # Set default parameters:
12   $params{with_stripped}   //= 1;
13   $params{with_restricted} //= 1;
14   $params{allowed_tags}    //= { map { ($_ => ['/']) } qw(b strong i em u ul ol li sub sup s strike br p div) };
15   $attributes                = [ $attributes ] unless ref($attributes) eq 'ARRAY';
16
17   # Do the work
18   foreach my $attribute (@{ $attributes }) {
19     _make_stripped(  $package, $attribute, %params) if ($params{with_stripped});
20     _make_restricted($package, $attribute, %params) if ($params{with_restricted});
21   }
22 }
23
24 sub _make_stripped {
25   my ($package, $attribute, %params) = @_;
26
27   no strict 'refs';
28   require SL::HTML::Util;
29
30   *{ $package . '::' . $attribute . '_as_stripped_html' } = sub {
31     my ($self, $value) = @_;
32
33     return $self->$attribute(SL::HTML::Util->strip($value)) if @_ > 1;
34     return SL::HTML::Util->strip($self->$attribute);
35   };
36 }
37
38 sub _make_restricted {
39   my ($package, $attribute, %params) = @_;
40
41   no strict 'refs';
42   require SL::HTML::Restrict;
43
44   my $cleaner = SL::HTML::Restrict->create(%params);
45
46   *{ $package . '::' . $attribute . '_as_restricted_html' } = sub {
47     my ($self, $value) = @_;
48
49     return $self->$attribute($cleaner->process($value)) if @_ > 1;
50     return $cleaner->process($self->$attribute);
51   };
52 }
53
54 1;
55 __END__
56
57 =pod
58
59 =encoding utf8
60
61 =head1 NAME
62
63 SL::DB::Helper::AttrHTML - Attribute helper for stripping
64 all/restricting to wanted HTML tags in columns
65
66 =head1 SYNOPSIS
67
68   # In a Rose model:
69   use SL::DB::Helper::AttrHTML;
70   __PACKAGE__->attr_html(
71     'content',
72     with_stripped => 0,
73     allowed_tags  => { b => [ '/' ], i => [ '/' ] },
74   );
75
76   # Use in HTML templates (no usage of HTML.escape() here!):
77   <div>
78     This is the post's content:<br>
79     [% SELF.obj.content_as_restricted_html %]
80   </div>
81
82   # Writing to it from a form:
83   <form method="post">
84     ...
85     [% L.textarea_tag('post.content_as_restricted_html', SELF.obj.content_as_restricted_html) %]
86   </form>
87
88 =head1 OVERVIEW
89
90 Sometimes you want an HTML editor on your web page. However, you only
91 want to allow certain tags. You also need to repeat that stuff when
92 displaying it without risking HTML/JavaScript injection attacks.
93
94 This plugin provides two helper methods for an attribute:
95 C<attribute_as_stripped_html> which removes all HTML tags, and
96 C<attribute_as_restricted_html> which removes all but a list of safe
97 HTML tags. Both are simple accessor methods.
98
99 =head1 FUNCTIONS
100
101 =over 4
102
103 =item C<attr_html $attributes, [%params]>
104
105 Package method. Call with the name of the attributes (either a scalar
106 for a single attribute or an array reference for multiple attributes)
107 for which the helper methods should be created.
108
109 C<%params> can include the following options:
110
111 =over 2
112
113 =item * C<with_stripped> is a scalar that controls the creation of the
114 C<attribute_as_stripped_html> method. It is on by default.
115
116 =item * C<with_restricted> is a scalar that controls the creation of the
117 C<attribute_as_restricted_html> method. It is on by default. If it is
118 on then the parameter C<allowed_tags> contains the tags that are kept
119 by this method.
120
121 =item * C<allowed_tags> must be a hash reference containing the tags
122 and attributes to keep. It follows the same structural layout as the
123 C<rules> parameter of L<HTML::Restrict/new>. Only relevant if
124 C<with_restricted> is trueish. It defaults to allow the following tags
125 without any attribute safe the trailing slash: C<b i u ul ol li sub
126 sup strike br p div>.
127
128 =back
129
130 =back
131
132 =head1 BUGS
133
134 Nothing here yet.
135
136 =head1 AUTHOR
137
138 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
139
140 =cut