View | Details | Raw Unified | Return to bug 20975
Collapse All | Expand All

(-)a/C4/Templates.pm (-2 / +2 lines)
Lines 5-11 use warnings; Link Here
5
use Carp;
5
use Carp;
6
use CGI qw ( -utf8 );
6
use CGI qw ( -utf8 );
7
use List::MoreUtils qw/ any uniq /;
7
use List::MoreUtils qw/ any uniq /;
8
use Template::Stash::AutoEscaping;
8
use Koha::Template::AutoEscaping;
9
9
10
# Copyright 2009 Chris Cormack and The Koha Dev Team
10
# Copyright 2009 Chris Cormack and The Koha Dev Team
11
#
11
#
Lines 73-79 sub new { Link Here
73
            COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
73
            COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
74
            INCLUDE_PATH => \@includes,
74
            INCLUDE_PATH => \@includes,
75
            FILTERS => {},
75
            FILTERS => {},
76
            STASH => Template::Stash::AutoEscaping->new,
76
            STASH => Koha::Template::AutoEscaping->new,
77
            ENCODING => 'UTF-8',
77
            ENCODING => 'UTF-8',
78
        }
78
        }
79
    ) or die Template->error();
79
    ) or die Template->error();
(-)a/Koha/Template/AutoEscaping.pm (+123 lines)
Line 0 Link Here
1
package Koha::Template::AutoEscaping;
2
3
use Modern::Perl;
4
5
use Template::Config;
6
use parent ($Template::Config::STASH, 'Class::Data::Inheritable');
7
8
use Template::Stash::AutoEscaping::RawString;
9
10
our $DEBUG = 0;
11
12
sub new {
13
    my $class = shift;
14
    my $self = $class->SUPER::new(@_);
15
    $self->{method_for_raw} ||= 'raw';
16
    $self->{method_for_escape} ||= 'escape';
17
    $self->{_raw_string_class} ||= 'Template::Stash::AutoEscaping::RawString';
18
    $self->{ignore_escape} ||= [];
19
    $self->{die_on_unescaped} ||= 0;
20
21
    foreach my $ops ($Template::Stash::SCALAR_OPS, $Template::Stash::LIST_OPS)
22
    {
23
        $ops->{$self->{method_for_raw}} = sub {
24
            my $scalar = shift;
25
            return $self->{_raw_string_class}->new($scalar);
26
        };
27
28
        $ops->{$self->{method_for_escape}} = sub {
29
            my $scalar = shift;
30
            return $self->{_raw_string_class}->new(
31
                $self->escape($scalar),
32
            );
33
        };
34
35
    };
36
    return $self;
37
}
38
39
sub get_raw_args {
40
    my ( $args, $escaped_class ) = @_;
41
    my $changed = 0;
42
    my @raw_args;
43
    for my $v (@{ $args }) {
44
        my $new_v;
45
        if ( ref $v eq $escaped_class ) {
46
            $changed = 1;
47
            $new_v = $v->[0];
48
        } elsif (ref $v eq 'ARRAY') {
49
            $new_v = get_raw_args($v, $escaped_class);
50
            if ($new_v) {
51
                $changed = 1;
52
            } else {
53
                $new_v = $v;
54
            }
55
        } else {
56
            $new_v = $v;
57
        }
58
        push @raw_args, $new_v;
59
    }
60
61
    return unless $changed;
62
    return \@raw_args;
63
}
64
65
sub get {
66
    my ( $self, @args ) = @_;
67
68
    # note: hack for [% hash.${key} %] [% hash.item(key) %]
69
    # key expected raw string.
70
    if (ref $args[0] eq "ARRAY" && (scalar @{$args[0]} > 2)){
71
        my $changed = get_raw_args($args[0], 'Koha::Template::AutoEscaping');
72
        # retry by non-escaped args
73
        if ($changed) {
74
            $args[0] = $changed;
75
            return $self->get(@args);
76
        }
77
    }
78
79
    my ($var) = $self->SUPER::get(@args);
80
    if (ref $args[0] eq "ARRAY") {
81
        my $key = $args[0]->[0];
82
        warn $key if $DEBUG;
83
        if (grep { $key eq $_ } @{ $self->{ignore_escape} }) {
84
            warn "ignore escape $key" if $DEBUG;
85
            return $var;
86
        }
87
    }
88
89
    my $ref = ref $var;
90
    # string
91
    if ((!$ref) and (length($var) > 0)) {
92
        return $self->escape($var);
93
    }
94
    # via .raw vmethod
95
    if ($ref eq $self->{_raw_string_class}) {
96
        return "$var";
97
    }
98
    return $var;
99
}
100
101
# With %XML => xml_escape subroutine from Mojo
102
#our %XML = (
103
#  '&'  => '&',
104
#  '<'  => '&lt;',
105
#  '>'  => '&gt;',
106
#  '"'  => '&quot;',
107
#  '\'' => '&#39;'
108
#);
109
110
sub escape {
111
    my $self = shift;
112
    my $text = shift;
113
    for ($text) {
114
        s/&/&amp;/g;
115
        s/</&lt;/g;
116
        s/>/&gt;/g;
117
        s/"/&quot;/g;
118
        s/'/&#39;/g;
119
    }
120
    return $text;
121
}
122
123
1;
(-)a/benchmark_AutoEscaping.pl (-5 / +5 lines)
Lines 1-11 Link Here
1
use Modern::Perl;
1
use Modern::Perl;
2
use Template;
2
use Template;
3
use Template::Stash::AutoEscaping;
3
use Koha::Template::AutoEscaping;
4
4
my $tt = Template->new(
5
my $tt = Template->new(
5
    {
6
    {
6
        ABSOLUTE    => 1,
7
        ABSOLUTE    => 1,
7
        PLUGIN_BASE => 'Koha::Template::Plugin',
8
        PLUGIN_BASE => 'Koha::Template::Plugin',
8
        STASH       => Template::Stash::AutoEscaping->new,
9
        STASH => Koha::Template::AutoEscaping->new,
9
    }
10
    }
10
);
11
);
11
12
Lines 15-21 my @loop; Link Here
15
for my $i ( 0 .. 10000 ) {
16
for my $i ( 0 .. 10000 ) {
16
    push @loop, {
17
    push @loop, {
17
        foo => '<script>my foo</script>',
18
        foo => '<script>my foo</script>',
18
        bar => 'my bar',
19
        bar => '<script>my bar</script>',
19
    };
20
    };
20
}
21
}
21
my $vars = {
22
my $vars = {
Lines 32-38 __DATA__ Link Here
32
[% pouet %]
33
[% pouet %]
33
<div style="display:none;">
34
<div style="display:none;">
34
[% FOR l IN loop %]
35
[% FOR l IN loop %]
35
    [% l.foo.raw %] [% l.bar.raw %]
36
    [% l.foo %] [% l.bar.raw %]
36
    <br/>
37
    <br/>
37
[% END %]
38
[% END %]
38
</div>
39
</div>
39
- 

Return to bug 20975