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

(-)a/C4/Installer/PerlDependencies.pm (-5 lines)
Lines 852-862 our $PERL_DEPS = { Link Here
852
        required => 1,
852
        required => 1,
853
        min_ver => '0.28',
853
        min_ver => '0.28',
854
    },
854
    },
855
    'Template::Stash::AutoEscaping' => {
856
        'usage'    => 'Code',
857
        'required' => '1',
858
        'min_ver'  => '0.0303',
859
    },
860
};
855
};
861
856
862
1;
857
1;
(-)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::Escape;
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 72-78 sub new { Link Here
72
            COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
72
            COMPILE_DIR => $use_template_cache ? C4::Context->config('template_cache_dir') : '',
73
            INCLUDE_PATH => \@includes,
73
            INCLUDE_PATH => \@includes,
74
            FILTERS => {},
74
            FILTERS => {},
75
            STASH => Template::Stash::AutoEscaping->new,
75
            STASH => Koha::Template::Escape->new,
76
            ENCODING => 'UTF-8',
76
            ENCODING => 'UTF-8',
77
        }
77
        }
78
    ) or die Template->error();
78
    ) or die Template->error();
(-)a/Koha/Template/Escape.pm (-1 / +97 lines)
Line 0 Link Here
0
- 
1
package Koha::Template::Escape;
2
3
# This is largely inspired from Template::Stash::AutoEscaping
4
5
use Modern::Perl;
6
7
use Template::Config;
8
use parent ($Template::Config::STASH, 'Class::Data::Inheritable');
9
10
sub new {
11
    my $class = shift;
12
    my $self = $class->SUPER::new(@_);
13
    return $self;
14
}
15
16
sub get_raw_args {
17
    my ( $args, $escaped_class ) = @_;
18
    my $changed = 0;
19
    my @raw_args;
20
    for my $v (@{ $args }) {
21
        my $new_v;
22
        if ( ref $v eq $escaped_class ) {
23
            $changed = 1;
24
            $new_v = $v->[0];
25
        } elsif (ref $v eq 'ARRAY') {
26
            $new_v = get_raw_args($v, $escaped_class);
27
            if ($new_v) {
28
                $changed = 1;
29
            } else {
30
                $new_v = $v;
31
            }
32
        } else {
33
            $new_v = $v;
34
        }
35
        push @raw_args, $new_v;
36
    }
37
38
    return unless $changed;
39
    return \@raw_args;
40
}
41
42
sub get {
43
    my ( $self, @args ) = @_;
44
45
    # note: hack for [% hash.${key} %] [% hash.item(key) %]
46
    # key expected raw string.
47
    if (ref $args[0] eq "ARRAY" && (scalar @{$args[0]} > 2)){
48
        my $changed = get_raw_args($args[0], 'Koha::Template::Escape');
49
        # retry by non-escaped args
50
        if ($changed) {
51
            $args[0] = $changed;
52
            return $self->get(@args);
53
        }
54
    }
55
56
    my ($var) = $self->SUPER::get(@args);
57
    if (ref $args[0] eq "ARRAY") {
58
        my $key = $args[0]->[0];
59
        if (grep { $key eq $_ } @{ $self->{ignore_escape} }) {
60
            return $var;
61
        }
62
    }
63
64
    my $ref = ref $var;
65
    # string
66
    if ((!$ref) and (length($var) > 0)) {
67
        return $self->escape($var);
68
    }
69
    return $var;
70
}
71
72
# With %XML => xml_escape subroutine from Mojo
73
#our %XML = (
74
#  '&'  => '&',
75
#  '<'  => '&lt;',
76
#  '>'  => '&gt;',
77
#  '"'  => '&quot;',
78
#  '\'' => '&#39;'
79
#);
80
81
# Without XML => TT html filter and AutoEscaping
82
sub escape {
83
    my $class = shift;
84
    my $text = shift;
85
#    $text =~ s/([&<>"'])/$XML{$1}/ge;
86
    for ($text) {
87
        s/&/&amp;/g;
88
        s/</&lt;/g;
89
        s/>/&gt;/g;
90
        s/"/&quot;/g;
91
        s/'/&#39;/g;
92
    }
93
94
    return $text;
95
}
96
97
1;

Return to bug 13618