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