@@ -, +, @@
translate install de-DE - worked ok
- running the test xt/tt_valid.t - worked ok and pointed out lots of problems.
---
{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
--- a/misc/translator/TTParser.pm
+++ a/misc/translator/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 ) {
--- a/misc/translator/TmplToken.pm
+++ a/misc/translator/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;
}
###############################################################################
--- a/misc/translator/TmplTokenType.pm
+++ a/misc/translator/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;
--- a/misc/translator/TmplTokenizer.pm
+++ a/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;
--- a/misc/translator/tmpl_process3.pl
+++ a/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}) {
--- a/misc/translator/xgettext.pl
+++ a/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 '*****';
--- a/xt/tt_valid.t
+++ a/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:
+
+