Lines 68-73
sub _process_tt_content {
Link Here
|
68 |
$has_use_raw++ |
68 |
$has_use_raw++ |
69 |
if $line =~ m{\[% USE raw %\]}; # Does [% Use raw %] exist? |
69 |
if $line =~ m{\[% USE raw %\]}; # Does [% Use raw %] exist? |
70 |
|
70 |
|
|
|
71 |
my $e; |
72 |
if ( $line =~ qr{<a href="([^"]+)} ) { |
73 |
my $to_uri_escape = $1; |
74 |
while ( |
75 |
$to_uri_escape =~ m{ |
76 |
\[% |
77 |
(?<pre_chomp>(\s|\-|~)*) |
78 |
(?<tt_block>[^%\-~]+) |
79 |
(?<post_chomp>(\s|\-|~)*) |
80 |
%\]}gmxs |
81 |
) |
82 |
{ |
83 |
( $new_line, $e ) = process_tt_block($new_line, { %+, filter => 'uri' }); |
84 |
push @errors, { line => $line, line_number => $line_number, error => $e } if $e; |
85 |
} |
86 |
} |
87 |
|
71 |
# Loop on TT blocks |
88 |
# Loop on TT blocks |
72 |
while ( |
89 |
while ( |
73 |
$line =~ m{ |
90 |
$line =~ m{ |
Lines 78-195
sub _process_tt_content {
Link Here
|
78 |
%\]}gmxs |
95 |
%\]}gmxs |
79 |
) |
96 |
) |
80 |
{ |
97 |
{ |
81 |
my $tt_block = $+{tt_block}; |
98 |
( $new_line, $e ) = process_tt_block($new_line, \%+); |
82 |
my $pre_chomp = $+{pre_chomp}; |
99 |
push @errors, { line => $line, line_number => $line_number, error => $e } if $e; |
83 |
my $post_chomp = $+{post_chomp}; |
|
|
84 |
|
85 |
next if |
86 |
# It's a TT directive, no filters needed |
87 |
grep { $tt_block =~ $_ } @tt_directives |
88 |
|
89 |
# It is a comment |
90 |
or $tt_block =~ m{^\#} |
91 |
|
92 |
# Already escaped with a special filter |
93 |
# We could escape it but should be safe |
94 |
or $tt_block =~ m{\s?\|\s?\$KohaDates\s?$} |
95 |
or $tt_block =~ m{\s?\|\s?\$Price\s?$} |
96 |
|
97 |
# Already escaped correctly with raw |
98 |
or $tt_block =~ m{\|\s?\$raw} |
99 |
|
100 |
# Assignment, maybe we should require to use SET (?) |
101 |
or $tt_block =~ m{=} |
102 |
|
103 |
# Already has url or uri filter |
104 |
or $tt_block =~ m{\|\s?ur(l|i)} |
105 |
|
106 |
# Specific for [% foo UNLESS bar %] |
107 |
or $tt_block =~ m{^(?<before>\S+)\s+UNLESS\s+(?<after>\S+)} |
108 |
; |
109 |
|
110 |
$pre_chomp = |
111 |
$pre_chomp |
112 |
? $pre_chomp =~ m|-| |
113 |
? q|- | |
114 |
: $pre_chomp =~ m|~| |
115 |
? q|~ | |
116 |
: q| | |
117 |
: q| |; |
118 |
$post_chomp = |
119 |
$post_chomp |
120 |
? $post_chomp =~ m|-| |
121 |
? q| -| |
122 |
: $post_chomp =~ m|~| |
123 |
? q| ~| |
124 |
: q| | |
125 |
: q| |; |
126 |
|
127 |
if ( |
128 |
|
129 |
# Use the uri filter |
130 |
# If html filtered or not filtered |
131 |
$new_line =~ qr{ |
132 |
<a\shref="(tel:|mailto:)? |
133 |
\[% |
134 |
\s*$pre_chomp\s* |
135 |
\Q$tt_block\E |
136 |
\s*$post_chomp\s* |
137 |
(\|\s*html)? |
138 |
\s* |
139 |
%\] |
140 |
}xms |
141 |
|
142 |
# And not already uri or url filtered |
143 |
and not $new_line =~ qr{ |
144 |
<a\shref="(tel:|mailto:)? |
145 |
\[% |
146 |
\s*$pre_chomp\s* |
147 |
\Q$tt_block\E |
148 |
\s|\s(uri|url) |
149 |
\s*$post_chomp\s* |
150 |
%\] |
151 |
}xms |
152 |
) |
153 |
{ |
154 |
$tt_block =~ s/^\s*|\s*$//g; # trim |
155 |
$tt_block =~ s/\s*\|\s*html\s*//; |
156 |
$new_line =~ s{ |
157 |
\[% |
158 |
\s*$pre_chomp\s* |
159 |
\Q$tt_block\E(\s*\|\s*html)? |
160 |
\s*$post_chomp\s* |
161 |
%\] |
162 |
}{[%$pre_chomp$tt_block | uri$post_chomp%]}xms; |
163 |
push @errors, |
164 |
{ |
165 |
error => 'wrong_html_filter', |
166 |
line => $line, |
167 |
line_number => $line_number |
168 |
}; |
169 |
next; |
170 |
} |
171 |
elsif ( |
172 |
$tt_block !~ m{\|\s?html} # already has html filter |
173 |
) |
174 |
{ |
175 |
$tt_block =~ s/^\s*|\s*$//g; # trim |
176 |
$new_line =~ s{ |
177 |
\[% |
178 |
\s*$pre_chomp\s* |
179 |
\Q$tt_block\E |
180 |
\s*$post_chomp\s* |
181 |
%\] |
182 |
}{[%$pre_chomp$tt_block | html$post_chomp%]}xms; |
183 |
|
184 |
push @errors, |
185 |
{ |
186 |
error => 'missing_filter', |
187 |
line => $line, |
188 |
line_number => $line_number |
189 |
}; |
190 |
next; |
191 |
} |
192 |
} |
100 |
} |
|
|
101 |
|
193 |
push @new_lines, $new_line; |
102 |
push @new_lines, $new_line; |
194 |
} |
103 |
} |
195 |
else { |
104 |
else { |
Lines 206-211
sub _process_tt_content {
Link Here
|
206 |
return { errors => \@errors, new_content => $new_content }; |
115 |
return { errors => \@errors, new_content => $new_content }; |
207 |
} |
116 |
} |
208 |
|
117 |
|
|
|
118 |
sub process_tt_block { |
119 |
my ( $line, $params ) = @_; |
120 |
my $tt_block = $params->{tt_block}; |
121 |
my $pre_chomp = $params->{pre_chomp}; |
122 |
my $post_chomp = $params->{post_chomp}; |
123 |
my $filter = $params->{filter} || 'html'; |
124 |
my $error; |
125 |
|
126 |
return ( $line, $error ) if |
127 |
# It's a TT directive, no filters needed |
128 |
grep { $tt_block =~ $_ } @tt_directives |
129 |
|
130 |
# It is a comment |
131 |
or $tt_block =~ m{^\#} |
132 |
|
133 |
# Already escaped with a special filter |
134 |
# We could escape it but should be safe |
135 |
or $tt_block =~ m{\s?\|\s?\$KohaDates\s?$} |
136 |
or $tt_block =~ m{\s?\|\s?\$Price\s?$} |
137 |
|
138 |
# Already escaped correctly with raw |
139 |
or $tt_block =~ m{\|\s?\$raw} |
140 |
|
141 |
# Assignment, maybe we should require to use SET (?) |
142 |
or $tt_block =~ m{=} |
143 |
|
144 |
# Already has url or uri filter |
145 |
or $tt_block =~ m{\|\s?ur(l|i)} |
146 |
|
147 |
# Specific for [% foo UNLESS bar %] |
148 |
or $tt_block =~ m{^(?<before>\S+)\s+UNLESS\s+(?<after>\S+)} |
149 |
; |
150 |
|
151 |
$pre_chomp = |
152 |
$pre_chomp |
153 |
? $pre_chomp =~ m|-| |
154 |
? q|- | |
155 |
: $pre_chomp =~ m|~| |
156 |
? q|~ | |
157 |
: q| | |
158 |
: q| |; |
159 |
$post_chomp = |
160 |
$post_chomp |
161 |
? $post_chomp =~ m|-| |
162 |
? q| -| |
163 |
: $post_chomp =~ m|~| |
164 |
? q| ~| |
165 |
: q| | |
166 |
: q| |; |
167 |
|
168 |
if ( |
169 |
# Use the uri filter is needed |
170 |
# If html filtered or not filtered |
171 |
$filter ne 'html' |
172 |
and ( |
173 |
$tt_block !~ m{\|} |
174 |
or $tt_block =~ m{\|\s?html} |
175 |
or $tt_block !~ m{\s*|\s*(uri|url)} |
176 |
) |
177 |
) { |
178 |
$tt_block =~ s/^\s*|\s*$//g; # trim |
179 |
$tt_block =~ s/\s*\|\s*html\s*//; |
180 |
$line =~ s{ |
181 |
\[% |
182 |
\s*$pre_chomp\s* |
183 |
\Q$tt_block\E(\s*\|\s*html)? |
184 |
\s*$post_chomp\s* |
185 |
%\] |
186 |
}{[%$pre_chomp$tt_block | uri$post_chomp%]}xms; |
187 |
|
188 |
$error = 'wrong_html_filter'; |
189 |
} |
190 |
elsif ( |
191 |
$tt_block !~ m{\|\s?html} # already has html filter |
192 |
) |
193 |
{ |
194 |
$tt_block =~ s/^\s*|\s*$//g; # trim |
195 |
$line =~ s{ |
196 |
\[% |
197 |
\s*$pre_chomp\s* |
198 |
\Q$tt_block\E |
199 |
\s*$post_chomp\s* |
200 |
%\] |
201 |
}{[%$pre_chomp$tt_block | html$post_chomp%]}xms; |
202 |
|
203 |
$error = 'missing_filter'; |
204 |
} |
205 |
return ( $line, $error ); |
206 |
} |
207 |
|
209 |
1; |
208 |
1; |
210 |
|
209 |
|
211 |
=head1 NAME |
210 |
=head1 NAME |