xt/tt_valid.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) 2011 Tamil s.a.r.l.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use Test::More tests => 3;
  22 use File::Find;
  23 use Cwd;
  24 use C4::TTParser;
  25
  26 my @themes;
  27
  28 # OPAC themes
  29 my $opac_dir  = 'koha-tmpl/opac-tmpl';
  30 opendir ( my $dh, $opac_dir ) or die "can't opendir $opac_dir: $!";
  31 for my $theme ( grep { not /^\.|lib|js|xslt/ } readdir($dh) ) {
  32     push @themes, "$opac_dir/$theme/en";
  33 }
  34 close $dh;
  35
  36 # STAFF themes
  37 my $staff_dir = 'koha-tmpl/intranet-tmpl';
  38 opendir ( $dh, $staff_dir ) or die "can't opendir $staff_dir: $!";
  39 for my $theme ( grep { not /^\.|lib|js/ } readdir($dh) ) {
  40     push @themes, "$staff_dir/$theme/en";
  41 }
  42 close $dh;
  43
  44 my $checkers = [
  45     {
  46         description => 'TT syntax: not using TT directive within HTML tag',
  47         check => sub {
  48             my ($self, $name, $token) = @_;
  49             my $attr = $token->{_attr};
  50             next unless $attr;
  51             push @{$self->{errors}->{$name}}, $token->{_lc} if $attr->{'[%'} or $attr->{'[%-'};
  52         },
  53         errors => {},
  54     },
  55     {
  56         description => '<body> tag with id and class attributes',
  57         check => sub {
  58             my ($self, $name, $token) = @_;
  59             return if $name =~ /bodytag\.inc/;
  60             my $tag = $token->{_string};
  61             push @{$self->{errors}->{$name}}, $token->{_lc}
  62               if $tag =~ /^<body/ &&
  63                  ($tag !~ /id=".+"/ || $tag !~ /class=".+"/);
  64         },
  65         errors => {},
  66     },
  67 ];
  68 find( sub {
  69     my $dir = getcwd();
  70     return if $dir =~ /blib/;
  71     return unless /\.(tt|inc)$/;
  72     ($dir) = $dir =~ /koha-tmpl\/(.*)$/;
  73     my $name = $_;
  74     my $parser = C4::TTParser->new;
  75     $parser->build_tokens( $name );
  76     while ( my $token = $parser->next_token ) {
  77         my $attr = $token->{_attr};
  78         next unless $attr;
  79         for my $checker (@$checkers) {
  80             $checker->{check}->($checker, "$dir/$name", $token);
  81         }
  82     }
  83   }, @themes
  84 );
  85
  86 for my $check (@$checkers) {
  87   my @files = sort keys %{$check->{errors}};
  88   ok( !@files, $check->{description} )
  89       or diag(
  90             "Files list: \n",
  91             join( "\n", map { "$_: " . join(', ', @{$check->{errors}->{$_}})
  92                 } @files )
  93          );
  94 }
  95
  96 my $testtoken = 0;
  97 my $ttparser = C4::TTParser->new();
  98 $ttparser->unshift_token($testtoken);
  99 my $testtokenagain = C4::TTParser::next_token();
 100 is( $testtoken, $testtokenagain, "Token received same as original put on stack");
 101
 102
 103 =head1 NAME
 104
 105 tt_valid.t
 106
 107 =head1 DESCRIPTION
 108
 109 This test validate Template Toolkit (TT) Koha files.
 110
 111 For the time being, two validations are done:
 112
 113 [1] Test if TT files contain TT directive within HTML tag. For example:
 114
 115   <li[% IF
 116
 117 This kind of construction MUST be avoided because it breaks Koha translation
 118 process.
 119
 120 [2] Test tag <body> tags have both attibutes 'id' and 'class'
 121
 122 =head1 USAGE
 123
 124 From Koha root directory:
 125
 126 prove -v xt/tt_valid.t
 127
 128 =cut
 129