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