t/lib/QA/TemplateFilters.pm

   1 package t::lib::QA::TemplateFilters;
   2
   3 use Modern::Perl;
   4
   5 our @tt_directives = (
   6     qr{^\s*INCLUDE},
   7     qr{^\s*USE},
   8     qr{^\s*IF},
   9     qr{^\s*UNLESS},
  10     qr{^\s*ELSE},
  11     qr{^\s*ELSIF},
  12     qr{^\s*END},
  13     qr{^\s*SET},
  14     qr{^\s*WHILE},
  15     qr{^\s*FOR},
  16     qr{^\s*FOREACH},
  17     qr{^\s*MACRO},
  18     qr{^\s*SWITCH},
  19     qr{^\s*CASE},
  20     qr{^\s*PROCESS},
  21     qr{^\s*DEFAULT},
  22     qr{^\s*TRY},
  23     qr{^\s*CATCH},
  24     qr{^\s*BLOCK},
  25     qr{^\s*FILTER},
  26     qr{^\s*STOP},
  27     qr{^\s*NEXT},
  28     qr{^\s*LAST},
  29 );
  30
  31 our @tt_methods = (
  32     qr{\.push\(},
  33     qr{\.delete\(},
  34 );
  35
  36 sub fix_filters {
  37     return _process_tt_content( @_ )->{new_content};
  38 }
  39
  40 sub missing_filters {
  41     return @{_process_tt_content( @_ )->{errors}};
  42
  43 }
  44
  45 sub _process_tt_content {
  46     my ($content) = @_;
  47     my ( $use_raw, $has_use_raw );
  48     my @errors;
  49     my @new_lines;
  50     my $line_number;
  51     for my $line ( split "\n", $content ) {
  52         my $new_line = $line;
  53         $line_number++;
  54         if ( $line =~ m{\[%[^%]+%\]} ) {
  55
  56             # handle exceptions first
  57             if ( $line =~ m{\|\s*\$raw} ) {    # Is the file use the raw filter?
  58                 $use_raw = 1;
  59             }
  60
  61             # Do we have Asset without the raw filter?
  62             if ( $line =~ m{^\s*\[% Asset} && $line !~ m{\|\s*\$raw} ) {
  63                 push @errors,
  64                   {
  65                     error       => 'asset_must_be_raw',
  66                     line        => $line,
  67                     line_number => $line_number
  68                   };
  69                 $new_line =~ s/\)\s*%]/) | \$raw %]/;
  70                 $use_raw = 1;
  71                 push @new_lines, $new_line;
  72                 next;
  73             }
  74
  75             $has_use_raw++
  76               if $line =~ m{\[%(\s|-|~)*USE raw(\s|-|~)*%\]};    # Does [% Use raw %] exist?
  77
  78             my $e;
  79             if ( $line =~ qr{<a href="([^"]+)} ) {
  80                 my $to_uri_escape = $1;
  81                 while (
  82                     $to_uri_escape =~ m{
  83                         \[%
  84                         (?<pre_chomp>(\s|\-|~)*)
  85                         (?<tt_block>[^%\-~]+)
  86                         (?<post_chomp>(\s|\-|~)*)
  87                         %\]}gmxs
  88                   )
  89                 {
  90                     ( $new_line, $e ) = process_tt_block($new_line, { %+, filter => 'uri' });
  91                     push @errors, { line => $line, line_number => $line_number, error => $e } if $e;
  92                 }
  93             }
  94
  95             # Loop on TT blocks
  96             while (
  97                 $line =~ m{
  98                     \[%
  99                     (?<pre_chomp>(\s|\-|~)*)
 100                     (?<tt_block>[^%\-~]+)
 101                     (?<post_chomp>(\s|\-|~)*)
 102                     %\]}gmxs
 103               )
 104             {
 105                 ( $new_line, $e ) = process_tt_block($new_line, \%+);
 106                 push @errors, { line => $line, line_number => $line_number, error => $e } if $e;
 107             }
 108
 109             push @new_lines, $new_line;
 110         }
 111         else {
 112             push @new_lines, $new_line;
 113         }
 114
 115     }
 116
 117     # Adding [% USE raw %] on top if the filter is used
 118     @new_lines = ( '[% USE raw %]', @new_lines )
 119       if $use_raw and not $has_use_raw;
 120
 121     my $new_content = join "\n", @new_lines;
 122     return { errors => \@errors, new_content => $new_content };
 123 }
 124
 125 sub process_tt_block {
 126     my ( $line, $params ) = @_;
 127     my $tt_block   = $params->{tt_block};
 128     my $pre_chomp  = $params->{pre_chomp};
 129     my $post_chomp = $params->{post_chomp};
 130     my $filter     = $params->{filter} || 'html';
 131     my $error;
 132
 133     return ( $line, $error ) if
 134         # It's a TT directive, no filters needed
 135         grep { $tt_block =~ $_ } @tt_directives
 136
 137         # It's a TT method
 138         or grep { $tt_block =~ $_ } @tt_methods
 139
 140         # It is a comment
 141         or $tt_block =~ m{^\#}
 142
 143         # Already escaped with a special filter
 144         # We could escape it but should be safe
 145         or $tt_block =~ m{\s?\|\s?\$KohaDates[^\|]*$}
 146         or $tt_block =~ m{\s?\|\s?\$Price[^\|]*$}
 147         or $tt_block =~ m{\s?\|\s?\$HtmlTags[^\|]*$}
 148         or $tt_block =~ m{\s?\|\s?\$HtmlId[^\|]*$}
 149
 150         # Already escaped correctly with raw
 151         or $tt_block =~ m{\|\s?\$raw}
 152
 153         # Assignment, maybe we should require to use SET (?)
 154         or ( $tt_block =~ m{=} and not $tt_block =~ m{\s\|\s} )
 155
 156         # Already has url or uri filter
 157         or $tt_block =~ m{\|\s?ur(l|i)}
 158
 159         # Specific for [% foo UNLESS bar %]
 160         or $tt_block =~ m{^(?<before>\S+)\s+UNLESS\s+(?<after>\S+)}
 161     ;
 162
 163     $pre_chomp =
 164         $pre_chomp
 165       ? $pre_chomp =~ m|-|
 166           ? q|- |
 167           : $pre_chomp =~ m|~|
 168             ? q|~ |
 169             : q| |
 170       : q| |;
 171     $post_chomp =
 172         $post_chomp
 173       ? $post_chomp =~ m|-|
 174           ? q| -|
 175           : $post_chomp =~ m|~|
 176             ? q| ~|
 177             : q| |
 178       : q| |;
 179
 180     if (   $tt_block =~ m{\s?\|\s?\$KohaDates[^\|]*\|.*$}
 181         or $tt_block =~ m{\s?\|\s?\$Price[^\|]*\|.*$}
 182         or $tt_block =~ m{\s?\|\s?\$HtmlTags[^\|]*\|.*$}
 183     ) {
 184         $tt_block =~
 185           s/\s*\|\s*(uri|url|html)\s*$//;    # Could be another filter...
 186         $line =~ s{
 187             \[%
 188             \s*$pre_chomp\s*
 189             \Q$tt_block\E\s*\|\s*(uri|url|html)
 190             \s*$post_chomp\s*
 191             %\]
 192         }{[%$pre_chomp$tt_block$post_chomp%]}xms;
 193
 194         return ( $line, 'extra_filter_not_needed' );
 195     }
 196
 197     if (
 198         # Use the uri filter is needed
 199         # If html filtered or not filtered
 200         $filter ne 'html'
 201             and (
 202                     $tt_block !~ m{\|}
 203                 or ($tt_block =~ m{\|\s?html} and not $tt_block =~ m{\|\s?html_entity})
 204                 or $tt_block !~ m{\s*|\s*(uri|url)}
 205       )
 206     ) {
 207         $tt_block =~ s/^\s*|\s*$//g;    # trim
 208         $tt_block =~ s/\s*\|\s*html\s*//;
 209         $line =~ s{
 210                 \[%
 211                 \s*$pre_chomp\s*
 212                 \Q$tt_block\E(\s*\|\s*html)?
 213                 \s*$post_chomp\s*
 214                 %\]
 215             }{[%$pre_chomp$tt_block | uri$post_chomp%]}xms;
 216
 217         $error = 'wrong_html_filter';
 218     }
 219     elsif (
 220         $tt_block !~ m{\|\s?html} # already has html filter
 221       )
 222     {
 223         $tt_block =~ s/^\s*|\s*$//g; # trim
 224         $line =~ s{
 225             \[%
 226             \s*$pre_chomp\s*
 227             \Q$tt_block\E
 228             \s*$post_chomp\s*
 229             %\]
 230         }{[%$pre_chomp$tt_block | html$post_chomp%]}xms;
 231
 232         $error = 'missing_filter';
 233     }
 234     return ( $line, $error );
 235 }
 236
 237 1;
 238
 239 =head1 NAME
 240
 241 t::lib::QA::TemplateFilters - Module used by tests and QA script to catch missing filters in template files
 242
 243 =head1 SYNOPSIS
 244
 245     my $content = read_file($filename);
 246     my $new_content = t::lib::QA::TemplateFilters::fix_filters($content);
 247     my $errors      = t::lib::QA::TemplateFilters::missing_filters($content);
 248
 249 =head1 DESCRIPTION
 250
 251 The goal of this module is to make the subroutine reusable from the QA scripts
 252 and to not duplicate the code.
 253
 254 =head1 METHODS
 255
 256 =head2 fix_filters
 257
 258     Take a template content file in parameter and return the same content with
 259     the correct (guessed) filters.
 260     It will also add the [% USE raw %] statement if it is needed.
 261
 262 =head2 missing_filters
 263
 264     Take a template content file in parameter and return an arrayref of errors.
 265
 266     An error is a hashref with 3 keys, error and line, line_number.
 267     * error can be:
 268     asset_must_be_raw - When Asset is called without using raw
 269     missing_filter    - When a TT variable is displayed without filter
 270     wrong_html_filter - When a TT variable is using the html filter when uri (or url)
 271                         should be used instead.
 272
 273     * line is the line where the error has been found.
 274     * line_number is the line number where the error has been found.
 275
 276
 277 =head1 AUTHORS
 278
 279 Jonathan Druart <jonathan.druart@bugs.koha-community.org>
 280
 281 =head1 COPYRIGHT
 282
 283 Copyright 2017 - Koha Development Team
 284
 285 =head1 LICENSE
 286
 287 This file is part of Koha.
 288
 289 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by
 290 the Free Software Foundation; either version 3 of the License, or (at your option) any later version.
 291
 292 Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 293
 294 You should have received a copy of the GNU General Public License along with Koha; if not, see <http://www.gnu.org/licenses>.
 295
 296 =cut
 297
 298 1;