From a41100a44519373efafb5c9f3cdc5607657d651e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Fr=C3=A9d=C3=A9ric=20Demians?= Date: Thu, 21 Jul 2011 10:18:29 +0200 Subject: [PATCH] Bug 6458 Template Toolkit files test case MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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: 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 Signed-off-by: Chris Cormack --- {misc/translator => C4}/TTParser.pm | 22 +++---- {misc/translator => C4}/TmplToken.pm | 20 +++--- {misc/translator => C4}/TmplTokenType.pm | 6 +- misc/translator/TmplTokenizer.pm | 32 ++++----- misc/translator/tmpl_process3.pl | 8 +-- misc/translator/xgettext.pl | 28 ++++---- xt/tt_valid.t | 84 ++++++++++++++++++++++++ 7 files changed, 142 insertions(+), 58 deletions(-) rename {misc/translator => C4}/TTParser.pm (79%) rename {misc/translator => C4}/TmplToken.pm (83%) rename {misc/translator => C4}/TmplTokenType.pm (95%) create mode 100755 xt/tt_valid.t 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 9bc0bbbcf8..e088124684 100755 --- 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 cb883b433f..a9cccd1105 100644 --- 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 =~ /^{'_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 =~ /^{'_kids'}}; + return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^{'_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 bfebebbe23..fc674b57ab 100644 --- 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 cb045137e4..6129f8d37e 100644 --- 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 ''; } 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 =~ /^attributes? lc($param->attributes->{'type'}->[1]): undef; diff --git a/misc/translator/tmpl_process3.pl b/misc/translator/tmpl_process3.pl index d862a97ff8..988e18b2f9 100755 --- 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 7b00be333e..99e96122ac 100755 --- 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 !~ /form =~ /\S/s && $s->form !~ /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 =~ /^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 index 0000000000..ae2e2e5581 --- /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: + +