Bug 6458 Template Toolkit files test case

This test validate Template Toolkit (TT) Koha files.

For the time being an unique validation is done: Test if TT files
contain TT directive within HTML tag. For example:

  <li[% IF

This kind of constuction MUST be avoided because it break Koha
translation process.

This patch transform also translation specific modules into C4 modules
in order to be able to use them in test case:

  C4::TTPaser
  C4::TmplToken
  C4::TmplTokenType

This patch is a Perl adaptation of a Haskell script from Frère Sébastien
Marie.

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Notes on testing:
- translate install de-DE - worked ok
- translate update de-DE > translate install de-DE - worked ok
- running the test xt/tt_valid.t - worked ok and pointed out lots of problems.
Found no problems.

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Signed-off-by: Chris Cormack <chrisc@catalyst.net.nz>

diff --git a/misc/translator/TTParser.pm b/C4/TTParser.pm
similarity index 79%
rename from misc/translator/TTParser.pm
rename to C4/TTParser.pm
index 9bc0bbb..e088124 100755 (executable)
--- a/misc/translator/TTParser.pm
+++ b/C4/TTParser.pm
@@ -1,8 +1,8 @@
 #!/usr/bin/env perl
 #simple parser for HTML with Template Toolkit directives. Tokens are put into @tokens and are accesible via next_token and peep_token
-package TTParser;
+package C4::TTParser;
 use base qw(HTML::Parser);
-use TmplToken;
+use C4::TmplToken;
 use strict;
 use warnings;
 
@@ -43,7 +43,7 @@ sub build_tokens{
     $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
     $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
 #    $self->handler(default => "default", "self, line, text, is_cdata"); # anything else
-    $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a TmplTokenType::CDATA
+    $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a C4::TmplTokenType::CDATA
     $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
     $self->parse_file($filename);
     return $self;
@@ -60,19 +60,19 @@ sub text{
         if( $work =~ m/\[%.*?\]/ ){
             #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
             if( $` ){
-                my $t = TmplToken->new( $`, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
+                my $t = C4::TmplToken->new( $`, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
                 push @tokens, $t;
             }
 
             #the match itself is a DIRECTIVE $&
-            my $t = TmplToken->new( $&, TmplTokenType::DIRECTIVE, $line, $self->{filename} );
+            my $t = C4::TmplToken->new( $&, C4::TmplTokenType::DIRECTIVE, $line, $self->{filename} );
             push @tokens, $t;
 
             # put work still to do back into work
             $work = $' ? $' : 0;
         } else {
             # If there is some left over work, treat it as text token
-            my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
+            my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
            
             push @tokens, $t;
             last;
@@ -85,7 +85,7 @@ sub declaration {
     my $line = shift;
     my $work = shift; #original text
     my $is_cdata = shift;
-    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
+    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
     push @tokens, $t;  
 }      
 
@@ -94,7 +94,7 @@ sub comment {
     my $line = shift;
     my $work = shift; #original text
     my $is_cdata = shift;
-    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
+    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
     push @tokens, $t;  
 }      
 
@@ -103,7 +103,7 @@ sub default {
     my $line = shift;
     my $work = shift; #original text
     my $is_cdata = shift;
-    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
+    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
     push @tokens, $t;  
 }      
 
@@ -115,7 +115,7 @@ sub start{
     my $tag = shift;
     my $hash = shift; #hash of attr/value pairs
     my $text = shift; #origional text
-    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename});
+    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename});
     my %attr;
     # tags seem to be uses in an 'interesting' way elsewhere..
     for my $key( %$hash ) {
@@ -139,7 +139,7 @@ sub end{
     my $hash = shift;
     my $text = shift;
     # what format should this be in?
-    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename} );
+    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename} );
     my %attr;
     # tags seem to be uses in an 'interesting' way elsewhere..
     for my $key( %$hash ) {

diff --git a/misc/translator/TmplToken.pm b/C4/TmplToken.pm
similarity index 83%
rename from misc/translator/TmplToken.pm
rename to C4/TmplToken.pm
index cb883b4..a9cccd1 100644 (file)
--- a/misc/translator/TmplToken.pm
+++ b/C4/TmplToken.pm
@@ -1,8 +1,8 @@
-package TmplToken;
+package C4::TmplToken;
 
 use strict;
 #use warnings; FIXME - Bug 2505
-use TmplTokenType;
+use C4::TmplTokenType;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -85,8 +85,8 @@ sub set_children {
 # FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
 sub parameters_and_fields {
     my $this = shift;
-    return map { $_->type == TmplTokenType::DIRECTIVE? $_:
-               ($_->type == TmplTokenType::TAG
+    return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
+               ($_->type == C4::TmplTokenType::TAG
                        && $_->string =~ /^<input\b/is)? $_: ()}
            @{$this->{'_kids'}};
 }
@@ -94,7 +94,7 @@ sub parameters_and_fields {
 # only meaningful for TEXT_PARAMETRIZED tokens
 sub anchors {
     my $this = shift;
-    return map { $_->type == TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
+    return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
 }
 
 # only meaningful for TEXT_PARAMETRIZED tokens
@@ -130,27 +130,27 @@ sub set_js_data {
 
 sub tag_p {
     my $this = shift;
-    return $this->type == TmplTokenType::TAG;
+    return $this->type == C4::TmplTokenType::TAG;
 }
 
 sub cdata_p {
     my $this = shift;
-    return $this->type == TmplTokenType::CDATA;
+    return $this->type == C4::TmplTokenType::CDATA;
 }
 
 sub text_p {
     my $this = shift;
-    return $this->type == TmplTokenType::TEXT;
+    return $this->type == C4::TmplTokenType::TEXT;
 }
 
 sub text_parametrized_p {
     my $this = shift;
-    return $this->type == TmplTokenType::TEXT_PARAMETRIZED;
+    return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
 }
 
 sub directive_p {
     my $this = shift;
-    return $this->type == TmplTokenType::DIRECTIVE;
+    return $this->type == C4::TmplTokenType::DIRECTIVE;
 }
 
 ###############################################################################

diff --git a/misc/translator/TmplTokenType.pm b/C4/TmplTokenType.pm
similarity index 95%
rename from misc/translator/TmplTokenType.pm
rename to C4/TmplTokenType.pm
index bfebebb..fc674b5 100644 (file)
--- a/misc/translator/TmplTokenType.pm
+++ b/C4/TmplTokenType.pm
@@ -1,4 +1,4 @@
-package TmplTokenType;
+package C4::TmplTokenType;
 
 use strict;
 #use warnings; FIXME - Bug 2505
@@ -10,7 +10,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 =head1 NAME
 
-TmplTokenType.pm - Types of TmplToken objects
+C4::TmplTokenType.pm - Types of TmplToken objects
 
 =head1 DESCRIPTION
 
@@ -43,7 +43,7 @@ use vars qw( $_text $_text_parametrized $_cdata
 
 BEGIN {
     my $new = sub {
-       my $this = 'TmplTokenType';#shift;
+       my $this = 'C4::TmplTokenType';#shift;
        my $class = ref($this) || $this;
        my $self = {};
        bless $self, $class;

diff --git a/misc/translator/TmplTokenizer.pm b/misc/translator/TmplTokenizer.pm
index cb04513..6129f8d 100644 (file)
--- a/misc/translator/TmplTokenizer.pm
+++ b/misc/translator/TmplTokenizer.pm
@@ -2,9 +2,9 @@ package TmplTokenizer;
 
 use strict;
 #use warnings; FIXME - Bug 2505
-use TmplTokenType;
-use TmplToken;
-use TTParser;
+use C4::TmplTokenType;
+use C4::TmplToken;
+use C4::TTParser;
 use VerboseWarnings qw( pedantic_p error_normal warn_normal warn_pedantic );
 require Exporter;
 
@@ -68,7 +68,7 @@ sub new {
     shift;
     my ($filename) = @_;
     #open my $handle,$filename or die "can't open $filename";
-    my $parser = TTParser->new;
+    my $parser = C4::TTParser->new;
     $parser->build_tokens( $filename );
     bless {
       filename => $filename,
@@ -259,11 +259,11 @@ sub _formalize_string_cformat{
 
 sub _formalize{
   my $t = shift;
-  if( $t->type == TmplTokenType::DIRECTIVE ){
+  if( $t->type == C4::TmplTokenType::DIRECTIVE ){
     return '%s';
-  } elsif( $t->type == TmplTokenType::TEXT ){
+  } elsif( $t->type == C4::TmplTokenType::TEXT ){
     return _formalize_string_cformat( $t->string );
-  } elsif( $t->type == TmplTokenType::TAG ){
+  } elsif( $t->type == C4::TmplTokenType::TAG ){
     if( $t->string =~ m/^a\b/is ){
       return '<a>';
     } elsif( $t->string =~ m/^input\b/is ){
@@ -281,13 +281,13 @@ sub _formalize{
 }
 
 # internal parametization, used within next_token
-# method that takes in an array of TEXT and DIRECTIVE tokens (DIRECTIVEs must be GET) and return a TmplTokenType::TEXT_PARAMETRIZED
+# method that takes in an array of TEXT and DIRECTIVE tokens (DIRECTIVEs must be GET) and return a C4::TmplTokenType::TEXT_PARAMETRIZED
 sub _parametrize_internal{
     my $this = shift;
     my @parts = @_;
     # my $s = "";
     # for my $item (@parts){
-    #     if( $item->type == TmplTokenType::TEXT ){
+    #     if( $item->type == C4::TmplTokenType::TEXT ){
     #         $s .= $item->string;
     #     } else {
     #         #must be a variable directive
@@ -297,7 +297,7 @@ sub _parametrize_internal{
     my $s = join( "", map { _formalize $_ } @parts );
     # should both the string and form be $s? maybe only the later? posibly the former....
     # used line number from first token, should suffice
-    my $t = TmplToken->new( $s, TmplTokenType::TEXT_PARAMETRIZED, $parts[0]->line_number, $this->filename );
+    my $t = C4::TmplToken->new( $s, C4::TmplTokenType::TEXT_PARAMETRIZED, $parts[0]->line_number, $this->filename );
     $t->set_children(@parts);
     $t->set_form($s);
     return $t;
@@ -321,14 +321,14 @@ sub next_token {
         }
         # if cformat mode is off, dont bother parametrizing, just return them as they come
         return $next unless $self->allow_cformat_p;
-        if( $next->type == TmplTokenType::TEXT ){
+        if( $next->type == C4::TmplTokenType::TEXT ){
             push @parts, $next;
         } 
-#        elsif( $next->type == TmplTokenType::DIRECTIVE && $next->string =~ m/\[%\s*\w+\s*%\]/ ){
-        elsif( $next->type == TmplTokenType::DIRECTIVE ){
+#        elsif( $next->type == C4::TmplTokenType::DIRECTIVE && $next->string =~ m/\[%\s*\w+\s*%\]/ ){
+        elsif( $next->type == C4::TmplTokenType::DIRECTIVE ){
             push @parts, $next;
         } 
-        elsif ( $next->type == TmplTokenType::CDATA){
+        elsif ( $next->type == C4::TmplTokenType::CDATA){
             $self->_set_js_mode(1);
             my $s0 = $next->string;
             my @head = ();
@@ -383,7 +383,7 @@ sub parametrize ($$$$) {
                    my $param = $params[$i - 1];
                    warn_normal "$fmt_0: $&: Expected a TMPL_VAR, but found a "
                            . $param->type->to_string . "\n", undef
-                           if $param->type != TmplTokenType::DIRECTIVE;
+                           if $param->type != C4::TmplTokenType::DIRECTIVE;
                    warn_normal "$fmt_0: $&: Unsupported "
                                . "field width or precision\n", undef
                            if defined $width || defined $prec;
@@ -400,7 +400,7 @@ sub parametrize ($$$$) {
                if (!defined $param) {
                    warn_normal "$fmt_0: $&: Parameter $i not known", undef;
                } else {
-                   if ($param->type == TmplTokenType::TAG
+                   if ($param->type == C4::TmplTokenType::TAG
                            && $param->string =~ /^<input\b/is) {
                        my $type = defined $param->attributes?
                                lc($param->attributes->{'type'}->[1]): undef;

diff --git a/misc/translator/tmpl_process3.pl b/misc/translator/tmpl_process3.pl
index d862a97..988e18b 100755 (executable)
--- a/misc/translator/tmpl_process3.pl
+++ b/misc/translator/tmpl_process3.pl
@@ -95,16 +95,16 @@ sub text_replace (**) {
     my $s = TmplTokenizer::next_token $h;
     last unless defined $s;
     my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
-    if ($kind eq TmplTokenType::TEXT) {
+    if ($kind eq C4::TmplTokenType::TEXT) {
         print $output find_translation($t);
-    } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
+    } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
         my $fmt = find_translation($s->form);
         print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
         $_ = $_[0];
         my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
-        $kind == TmplTokenType::TAG && %$attr?
+        $kind == C4::TmplTokenType::TAG && %$attr?
             text_replace_tag($t, $attr): $t });
-    } elsif ($kind eq TmplTokenType::TAG && %$attr) {
+    } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
         print $output text_replace_tag($t, $attr);
     } elsif ($s->has_js_data) {
         for my $t (@{$s->js_data}) {

diff --git a/misc/translator/xgettext.pl b/misc/translator/xgettext.pl
index 7b00be3..99e9612 100755 (executable)
--- a/misc/translator/xgettext.pl
+++ b/misc/translator/xgettext.pl
@@ -44,12 +44,12 @@ sub token_negligible_p( $ ) {
     my($x) = @_;
     my $t = $x->type;
     return !$extract_all_p && (
-           $t == TmplTokenType::TEXT? string_negligible_p( $x->string ):
-           $t == TmplTokenType::DIRECTIVE? 1:
-           $t == TmplTokenType::TEXT_PARAMETRIZED
+           $t == C4::TmplTokenType::TEXT? string_negligible_p( $x->string ):
+           $t == C4::TmplTokenType::DIRECTIVE? 1:
+           $t == C4::TmplTokenType::TEXT_PARAMETRIZED
                && join( '', map { my $t = $_->type;
-                       $t == TmplTokenType::DIRECTIVE?
-                               '1': $t == TmplTokenType::TAG?
+                       $t == C4::TmplTokenType::DIRECTIVE?
+                               '1': $t == C4::TmplTokenType::TAG?
                                        '': token_negligible_p( $_ )?
                                        '': '1' } @{$x->children} ) eq '' );
 }
@@ -91,15 +91,15 @@ sub text_extract (*) {
         my $s = TmplTokenizer::next_token $h;
         last unless defined $s;
         my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
-        if ($kind eq TmplTokenType::TEXT) {
+        if ($kind eq C4::TmplTokenType::TEXT) {
            if ($t =~ /\S/s && $t !~ /<!/){
                remember( $s, $t );
            }
-        } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
+        } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
            if ($s->form =~ /\S/s && $s->form !~ /<!/){
                remember( $s, $s->form );
            }
-        } elsif ($kind eq TmplTokenType::TAG && %$attr) {
+        } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
             # value [tag=input], meta
             my $tag = lc($1) if $t =~ /^<(\S+)/s;
             for my $a ('alt', 'content', 'title', 'value','label') {
@@ -165,19 +165,19 @@ msgstr ""
 EOF
     my $directory_re = quotemeta("$directory/");
     for my $t (string_list) {
-       if ($text{$t}->[0]->type == TmplTokenType::TEXT_PARAMETRIZED) {
+       if ($text{$t}->[0]->type == C4::TmplTokenType::TEXT_PARAMETRIZED) {
            my($token, $n) = ($text{$t}->[0], 0);
            printf OUTPUT "#. For the first occurrence,\n"
                    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
            for my $param ($token->parameters_and_fields) {
                $n += 1;
                my $type = $param->type;
-               my $subtype = ($type == TmplTokenType::TAG
+               my $subtype = ($type == C4::TmplTokenType::TAG
                        && $param->string =~ /^<input\b/is?
                                $param->attributes->{'type'}->[1]: undef);
                my $fmt = TmplTokenizer::_formalize( $param );
                $fmt =~ s/^%/%$n\$/;
-               if ($type == TmplTokenType::DIRECTIVE) {
+               if ($type == C4::TmplTokenType::DIRECTIVE) {
 #                  $type = "Template::Toolkit Directive";
                    $type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR';
                    my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is?
@@ -193,7 +193,7 @@ EOF
                            . (defined $value? " value=$value->[1]": '');
                }
            }
-       } elsif ($text{$t}->[0]->type == TmplTokenType::TAG) {
+       } elsif ($text{$t}->[0]->type == C4::TmplTokenType::TAG) {
            my($token) = ($text{$t}->[0]);
            printf OUTPUT "#. For the first occurrence,\n"
                    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
@@ -220,7 +220,7 @@ EOF
         $pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/;
            printf OUTPUT "#: %s:%d\n", $pathname, $token->line_number
                    if defined $pathname && defined $token->line_number;
-           $cformat_p = 1 if $token->type == TmplTokenType::TEXT_PARAMETRIZED;
+           $cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
        }
        printf OUTPUT "#, c-format\n" if $cformat_p;
        printf OUTPUT "msgid %s\n", TmplTokenizer::quote_po
@@ -246,7 +246,7 @@ sub convert_translation_file () {
        $msgid =~ s/^SELECTED>//;
 
        # Create dummy token
-       my $token = TmplToken->new( $msgid, TmplTokenType::UNKNOWN, undef, undef );
+       my $token = TmplToken->new( $msgid, C4::TmplTokenType::UNKNOWN, undef, undef );
        remember( $token, $msgid );
        $msgstr =~ s/^(?:LIMIT;|LIMITED;)//g; # unneeded for tmpl_process3
        $translation{$msgid} = $msgstr unless $msgstr eq '*****';

diff --git a/xt/tt_valid.t b/xt/tt_valid.t
new file mode 100755 (executable)
index 0000000..ae2e2e5
--- /dev/null
+++ b/xt/tt_valid.t
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+# Copyright (C) 2011 Tamil s.a.r.l.
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# 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.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use warnings;
+use strict;
+use Test::More tests => 1;
+use File::Find;
+use Cwd;
+use C4::TTParser;
+
+
+my @files_with_directive_in_tag = do {
+    my @files;
+    find( sub {
+        my $dir = getcwd();
+        return if $dir =~ /blib/;
+        return unless /\.(tt|inc)$/;
+        my $name = $_;
+        my $parser = C4::TTParser->new;
+        $parser->build_tokens( $name );  
+        my @lines;
+        while ( my $token = $parser->next_token ) {
+            my $attr = $token->{_attr};
+            next unless $attr;
+            push @lines, $token->{_lc} if $attr->{'[%'};
+        }
+        ($dir) = $dir =~ /koha-tmpl\/(.*)$/;
+        push @files, { name => "$dir/$name", lines => \@lines } if @lines;
+      }, ( "./koha-tmpl/opac-tmpl/prog/en",
+           "./koha-tmpl/intranet-tmpl/prog/en" )
+    );
+    @files;
+};
+
+
+ok( !@files_with_directive_in_tag, "TT syntax: not using TT directive within HTML tag" )
+    or diag(
+          "Files list: \n",
+          join( "\n", map { $_->{name} . ': ' . join(', ', @{$_->{lines}})
+              } @files_with_directive_in_tag )
+       );
+
+
+
+=head1 NAME
+
+tt_valid.t
+
+=head1 DESCRIPTION
+
+This test validate Template Toolkit (TT) Koha files.
+
+For the time being an unique validation is done: Test if TT files contain TT
+directive within HTML tag. For example:
+
+  <li[% IF
+
+This kind of constuction MUST be avoided because it break Koha translation
+process.
+
+=head1 USAGE
+
+From Koha root directory:
+
+prove -v xt/tt_valid.t
+
+=cut
+