Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 6458 Template Toolkit files test case

Browse source 
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>
This commit is contained in:
Frédéric Demians 2011-07-21 10:18:29 +02:00 committed by Chris Cormack
parent 714c8b924e
commit a41100a445
7 changed files with 142 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
misc/translator/TTParser.pm → C4/TTParser.pm
View file

@ -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 ) {

20
misc/translator/TmplToken.pm → C4/TmplToken.pm
View file

@ -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;
}
###############################################################################

6
misc/translator/TmplTokenType.pm → C4/TmplTokenType.pm
View file

@ -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;

32
misc/translator/TmplTokenizer.pm
View file

@ -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;

8
misc/translator/tmpl_process3.pl
View file

@ -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}) {

28
misc/translator/xgettext.pl
View file

@ -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 '*****';

84
xt/tt_valid.t Executable file
View file

@ -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