[Koha-patches] [PATCH] [SIGNED-OFF] Bug 6458 Template Toolkit files test case
Katrin Fischer
Katrin.Fischer.83 at web.de
Thu Aug 11 18:07:09 CEST 2011
From: Frédéric Demians <f.demians at tamil.fr>
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 at 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 at web.de>
---
C4/TTParser.pm | 153 ++++++++++++++++++++++++++++++++++++
C4/TmplToken.pm | 158 ++++++++++++++++++++++++++++++++++++++
C4/TmplTokenType.pm | 129 +++++++++++++++++++++++++++++++
misc/translator/TTParser.pm | 153 ------------------------------------
misc/translator/TmplToken.pm | 158 --------------------------------------
misc/translator/TmplTokenType.pm | 129 -------------------------------
misc/translator/TmplTokenizer.pm | 32 ++++----
misc/translator/tmpl_process3.pl | 8 +-
misc/translator/xgettext.pl | 28 ++++----
xt/tt_valid.t | 84 ++++++++++++++++++++
10 files changed, 558 insertions(+), 474 deletions(-)
create mode 100755 C4/TTParser.pm
create mode 100644 C4/TmplToken.pm
create mode 100644 C4/TmplTokenType.pm
delete mode 100755 misc/translator/TTParser.pm
delete mode 100644 misc/translator/TmplToken.pm
delete mode 100644 misc/translator/TmplTokenType.pm
create mode 100755 xt/tt_valid.t
diff --git a/C4/TTParser.pm b/C4/TTParser.pm
new file mode 100755
index 0000000..e088124
--- /dev/null
+++ b/C4/TTParser.pm
@@ -0,0 +1,153 @@
+#!/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 C4::TTParser;
+use base qw(HTML::Parser);
+use C4::TmplToken;
+use strict;
+use warnings;
+
+#seems to be handled post tokenizer
+##hash where key is tag we are interested in and the value is a hash of the attributes we want
+#my %interesting_tags = (
+# img => { alt => 1 },
+#);
+
+#tokens found so far (used like a stack)
+my ( @tokens );
+
+#shiftnext token or undef
+sub next_token{
+ return shift @tokens;
+}
+
+#unshift token back on @tokens
+sub unshift_token{
+ my $self = shift;
+ unshift @tokens, shift;
+}
+
+#have a peep at next token
+sub peep_token{
+ return $tokens[0];
+}
+
+#wrapper for parse
+#please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
+#signature build_tokens( self, filename)
+sub build_tokens{
+ my ($self, $filename) = @_;
+ $self->{filename} = $filename;
+ $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
+ $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
+ $self->handler(end => "end", "self, line, tag, attr, text"); #signature is end( self, linenumber, tagename, origional text )
+ $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 C4::TmplTokenType::CDATA
+ $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
+ $self->parse_file($filename);
+ return $self;
+}
+
+#handle parsing of text
+sub text{
+ my $self = shift;
+ my $line = shift;
+ my $work = shift; # original text
+ my $is_cdata = shift;
+ while($work){
+ # if there is a template_toolkit tag
+ if( $work =~ m/\[%.*?\]/ ){
+ #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
+ if( $` ){
+ 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 = 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 = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
+
+ push @tokens, $t;
+ last;
+ }
+ }
+}
+
+sub declaration {
+ my $self = shift;
+ my $line = shift;
+ my $work = shift; #original text
+ my $is_cdata = shift;
+ my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
+ push @tokens, $t;
+}
+
+sub comment {
+ my $self = shift;
+ my $line = shift;
+ my $work = shift; #original text
+ my $is_cdata = shift;
+ my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
+ push @tokens, $t;
+}
+
+sub default {
+ my $self = shift;
+ my $line = shift;
+ my $work = shift; #original text
+ my $is_cdata = shift;
+ my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
+ push @tokens, $t;
+}
+
+
+#handle opening html tags
+sub start{
+ my $self = shift;
+ my $line = shift;
+ my $tag = shift;
+ my $hash = shift; #hash of attr/value pairs
+ my $text = shift; #origional text
+ 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 ) {
+ next unless defined $hash->{$key};
+ if ($key eq "/"){
+ $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 1 ];
+ }
+ else {
+ $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
+ }
+ }
+ $t->set_attributes( \%attr );
+ push @tokens, $t;
+}
+
+#handle closing html tags
+sub end{
+ my $self = shift;
+ my $line = shift;
+ my $tag = shift;
+ my $hash = shift;
+ my $text = shift;
+ # what format should this be in?
+ 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 ) {
+ next unless defined $hash->{$key};
+ $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
+ }
+ $t->set_attributes( \%attr );
+ push @tokens, $t;
+}
+
+1;
diff --git a/C4/TmplToken.pm b/C4/TmplToken.pm
new file mode 100644
index 0000000..a9cccd1
--- /dev/null
+++ b/C4/TmplToken.pm
@@ -0,0 +1,158 @@
+package C4::TmplToken;
+
+use strict;
+#use warnings; FIXME - Bug 2505
+use C4::TmplTokenType;
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+###############################################################################
+
+=head1 NAME
+
+TmplToken.pm - Object representing a scanner token for .tmpl files
+
+=head1 DESCRIPTION
+
+This is a class representing a token scanned from an HTML::Template .tmpl file.
+
+=cut
+
+###############################################################################
+
+$VERSION = 0.01;
+
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw();
+
+###############################################################################
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
+ return $self;
+}
+
+sub string {
+ my $this = shift;
+ return $this->{'_string'}
+}
+
+sub type {
+ my $this = shift;
+ return $this->{'_type'}
+}
+
+sub pathname {
+ my $this = shift;
+ return $this->{'_path'}
+}
+
+sub line_number {
+ my $this = shift;
+ return $this->{'_lc'}
+}
+
+sub attributes {
+ my $this = shift;
+ return $this->{'_attr'};
+}
+
+sub set_attributes {
+ my $this = shift;
+ $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
+ return $this;
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+sub children {
+ my $this = shift;
+ return $this->{'_kids'};
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+sub set_children {
+ my $this = shift;
+ $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
+ return $this;
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
+sub parameters_and_fields {
+ my $this = shift;
+ return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
+ ($_->type == C4::TmplTokenType::TAG
+ && $_->string =~ /^<input\b/is)? $_: ()}
+ @{$this->{'_kids'}};
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+sub anchors {
+ my $this = shift;
+ return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+sub form {
+ my $this = shift;
+ return $this->{'_form'};
+}
+
+# only meaningful for TEXT_PARAMETRIZED tokens
+sub set_form {
+ my $this = shift;
+ $this->{'_form'} = $_[0];
+ return $this;
+}
+
+sub has_js_data {
+ my $this = shift;
+ return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
+}
+
+sub js_data {
+ my $this = shift;
+ return $this->{'_js_data'};
+}
+
+sub set_js_data {
+ my $this = shift;
+ $this->{'_js_data'} = $_[0];
+ return $this;
+}
+
+# predefined tests
+
+sub tag_p {
+ my $this = shift;
+ return $this->type == C4::TmplTokenType::TAG;
+}
+
+sub cdata_p {
+ my $this = shift;
+ return $this->type == C4::TmplTokenType::CDATA;
+}
+
+sub text_p {
+ my $this = shift;
+ return $this->type == C4::TmplTokenType::TEXT;
+}
+
+sub text_parametrized_p {
+ my $this = shift;
+ return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
+}
+
+sub directive_p {
+ my $this = shift;
+ return $this->type == C4::TmplTokenType::DIRECTIVE;
+}
+
+###############################################################################
+
+1;
diff --git a/C4/TmplTokenType.pm b/C4/TmplTokenType.pm
new file mode 100644
index 0000000..fc674b5
--- /dev/null
+++ b/C4/TmplTokenType.pm
@@ -0,0 +1,129 @@
+package C4::TmplTokenType;
+
+use strict;
+#use warnings; FIXME - Bug 2505
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+###############################################################################
+
+=head1 NAME
+
+C4::TmplTokenType.pm - Types of TmplToken objects
+
+=head1 DESCRIPTION
+
+This is a Java-style "safe enum" singleton class for types of TmplToken objects.
+The predefined constants are
+
+=cut
+
+###############################################################################
+
+$VERSION = 0.01;
+
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(
+ &TEXT
+ &TEXT_PARAMETRIZED
+ &CDATA
+ &TAG
+ &DECL
+ &PI
+ &DIRECTIVE
+ &COMMENT
+ &UNKNOWN
+);
+
+###############################################################################
+
+use vars qw( $_text $_text_parametrized $_cdata
+ $_tag $_decl $_pi $_directive $_comment $_null $_unknown );
+
+BEGIN {
+ my $new = sub {
+ my $this = 'C4::TmplTokenType';#shift;
+ my $class = ref($this) || $this;
+ my $self = {};
+ bless $self, $class;
+ ($self->{'id'}, $self->{'name'}, $self->{'desc'}) = @_;
+ return $self;
+ };
+ $_text = &$new(0, 'TEXT');
+ $_text_parametrized = &$new(8, 'TEXT-PARAMETRIZED');
+ $_cdata = &$new(1, 'CDATA');
+ $_tag = &$new(2, 'TAG');
+ $_decl = &$new(3, 'DECL');
+ $_pi = &$new(4, 'PI');
+ $_directive = &$new(5, 'DIRECTIVE');
+ $_comment = &$new(6, 'COMMENT');
+ $_unknown = &$new(7, 'UNKNOWN');
+}
+
+sub to_string {
+ my $this = shift;
+ return $this->{'name'}
+}
+
+sub TEXT () { $_text }
+sub TEXT_PARAMETRIZED () { $_text_parametrized }
+sub CDATA () { $_cdata }
+sub TAG () { $_tag }
+sub DECL () { $_decl }
+sub PI () { $_pi }
+sub DIRECTIVE () { $_directive }
+sub COMMENT () { $_comment }
+sub UNKNOWN () { $_unknown }
+
+###############################################################################
+
+=over
+
+=item TEXT
+
+normal text (#text in the DTD)
+
+=item TEXT_PARAMETRIZED
+
+parametrized normal text
+(result of simple recognition of text interspersed with <TMPL_VAR> directives;
+this has to be explicitly enabled in the scanner)
+
+=item CDATA
+
+normal text (CDATA in the DTD)
+
+=item TAG
+
+something that has the form of an HTML tag
+
+=item DECL
+
+something that has the form of an SGML declaration
+
+=item PI
+
+something that has the form of an SGML processing instruction
+
+=item DIRECTIVE
+
+a Template Toolkit directive
+
+=item COMMENT
+
+something that has the form of an HTML comment
+(and is not recognized as an HTML::Template directive)
+
+=item UNKNOWN
+
+something that is not recognized at all by the scanner
+
+=back
+
+Note that end of file is currently represented by undef,
+instead of a constant predefined by this module.
+
+=cut
+
+1;
diff --git a/misc/translator/TTParser.pm b/misc/translator/TTParser.pm
deleted file mode 100755
index 9bc0bbb..0000000
--- a/misc/translator/TTParser.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-#!/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;
-use base qw(HTML::Parser);
-use TmplToken;
-use strict;
-use warnings;
-
-#seems to be handled post tokenizer
-##hash where key is tag we are interested in and the value is a hash of the attributes we want
-#my %interesting_tags = (
-# img => { alt => 1 },
-#);
-
-#tokens found so far (used like a stack)
-my ( @tokens );
-
-#shiftnext token or undef
-sub next_token{
- return shift @tokens;
-}
-
-#unshift token back on @tokens
-sub unshift_token{
- my $self = shift;
- unshift @tokens, shift;
-}
-
-#have a peep at next token
-sub peep_token{
- return $tokens[0];
-}
-
-#wrapper for parse
-#please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
-#signature build_tokens( self, filename)
-sub build_tokens{
- my ($self, $filename) = @_;
- $self->{filename} = $filename;
- $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
- $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
- $self->handler(end => "end", "self, line, tag, attr, text"); #signature is end( self, linenumber, tagename, origional text )
- $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->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
- $self->parse_file($filename);
- return $self;
-}
-
-#handle parsing of text
-sub text{
- my $self = shift;
- my $line = shift;
- my $work = shift; # original text
- my $is_cdata = shift;
- while($work){
- # if there is a template_toolkit tag
- 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} );
- push @tokens, $t;
- }
-
- #the match itself is a DIRECTIVE $&
- my $t = TmplToken->new( $&, 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} );
-
- push @tokens, $t;
- last;
- }
- }
-}
-
-sub declaration {
- my $self = shift;
- 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} );
- push @tokens, $t;
-}
-
-sub comment {
- my $self = shift;
- 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} );
- push @tokens, $t;
-}
-
-sub default {
- my $self = shift;
- 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} );
- push @tokens, $t;
-}
-
-
-#handle opening html tags
-sub start{
- my $self = shift;
- my $line = shift;
- 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 %attr;
- # tags seem to be uses in an 'interesting' way elsewhere..
- for my $key( %$hash ) {
- next unless defined $hash->{$key};
- if ($key eq "/"){
- $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 1 ];
- }
- else {
- $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
- }
- }
- $t->set_attributes( \%attr );
- push @tokens, $t;
-}
-
-#handle closing html tags
-sub end{
- my $self = shift;
- my $line = shift;
- my $tag = shift;
- my $hash = shift;
- my $text = shift;
- # what format should this be in?
- my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename} );
- my %attr;
- # tags seem to be uses in an 'interesting' way elsewhere..
- for my $key( %$hash ) {
- next unless defined $hash->{$key};
- $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
- }
- $t->set_attributes( \%attr );
- push @tokens, $t;
-}
-
-1;
diff --git a/misc/translator/TmplToken.pm b/misc/translator/TmplToken.pm
deleted file mode 100644
index cb883b4..0000000
--- a/misc/translator/TmplToken.pm
+++ /dev/null
@@ -1,158 +0,0 @@
-package TmplToken;
-
-use strict;
-#use warnings; FIXME - Bug 2505
-use TmplTokenType;
-require Exporter;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-###############################################################################
-
-=head1 NAME
-
-TmplToken.pm - Object representing a scanner token for .tmpl files
-
-=head1 DESCRIPTION
-
-This is a class representing a token scanned from an HTML::Template .tmpl file.
-
-=cut
-
-###############################################################################
-
-$VERSION = 0.01;
-
- at ISA = qw(Exporter);
- at EXPORT_OK = qw();
-
-###############################################################################
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = {};
- bless $self, $class;
- ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
- return $self;
-}
-
-sub string {
- my $this = shift;
- return $this->{'_string'}
-}
-
-sub type {
- my $this = shift;
- return $this->{'_type'}
-}
-
-sub pathname {
- my $this = shift;
- return $this->{'_path'}
-}
-
-sub line_number {
- my $this = shift;
- return $this->{'_lc'}
-}
-
-sub attributes {
- my $this = shift;
- return $this->{'_attr'};
-}
-
-sub set_attributes {
- my $this = shift;
- $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
- return $this;
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-sub children {
- my $this = shift;
- return $this->{'_kids'};
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-sub set_children {
- my $this = shift;
- $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
- return $this;
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
-sub parameters_and_fields {
- my $this = shift;
- return map { $_->type == TmplTokenType::DIRECTIVE? $_:
- ($_->type == TmplTokenType::TAG
- && $_->string =~ /^<input\b/is)? $_: ()}
- @{$this->{'_kids'}};
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-sub anchors {
- my $this = shift;
- return map { $_->type == TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-sub form {
- my $this = shift;
- return $this->{'_form'};
-}
-
-# only meaningful for TEXT_PARAMETRIZED tokens
-sub set_form {
- my $this = shift;
- $this->{'_form'} = $_[0];
- return $this;
-}
-
-sub has_js_data {
- my $this = shift;
- return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
-}
-
-sub js_data {
- my $this = shift;
- return $this->{'_js_data'};
-}
-
-sub set_js_data {
- my $this = shift;
- $this->{'_js_data'} = $_[0];
- return $this;
-}
-
-# predefined tests
-
-sub tag_p {
- my $this = shift;
- return $this->type == TmplTokenType::TAG;
-}
-
-sub cdata_p {
- my $this = shift;
- return $this->type == TmplTokenType::CDATA;
-}
-
-sub text_p {
- my $this = shift;
- return $this->type == TmplTokenType::TEXT;
-}
-
-sub text_parametrized_p {
- my $this = shift;
- return $this->type == TmplTokenType::TEXT_PARAMETRIZED;
-}
-
-sub directive_p {
- my $this = shift;
- return $this->type == TmplTokenType::DIRECTIVE;
-}
-
-###############################################################################
-
-1;
diff --git a/misc/translator/TmplTokenType.pm b/misc/translator/TmplTokenType.pm
deleted file mode 100644
index bfebebb..0000000
--- a/misc/translator/TmplTokenType.pm
+++ /dev/null
@@ -1,129 +0,0 @@
-package TmplTokenType;
-
-use strict;
-#use warnings; FIXME - Bug 2505
-require Exporter;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-###############################################################################
-
-=head1 NAME
-
-TmplTokenType.pm - Types of TmplToken objects
-
-=head1 DESCRIPTION
-
-This is a Java-style "safe enum" singleton class for types of TmplToken objects.
-The predefined constants are
-
-=cut
-
-###############################################################################
-
-$VERSION = 0.01;
-
- at ISA = qw(Exporter);
- at EXPORT_OK = qw(
- &TEXT
- &TEXT_PARAMETRIZED
- &CDATA
- &TAG
- &DECL
- &PI
- &DIRECTIVE
- &COMMENT
- &UNKNOWN
-);
-
-###############################################################################
-
-use vars qw( $_text $_text_parametrized $_cdata
- $_tag $_decl $_pi $_directive $_comment $_null $_unknown );
-
-BEGIN {
- my $new = sub {
- my $this = 'TmplTokenType';#shift;
- my $class = ref($this) || $this;
- my $self = {};
- bless $self, $class;
- ($self->{'id'}, $self->{'name'}, $self->{'desc'}) = @_;
- return $self;
- };
- $_text = &$new(0, 'TEXT');
- $_text_parametrized = &$new(8, 'TEXT-PARAMETRIZED');
- $_cdata = &$new(1, 'CDATA');
- $_tag = &$new(2, 'TAG');
- $_decl = &$new(3, 'DECL');
- $_pi = &$new(4, 'PI');
- $_directive = &$new(5, 'DIRECTIVE');
- $_comment = &$new(6, 'COMMENT');
- $_unknown = &$new(7, 'UNKNOWN');
-}
-
-sub to_string {
- my $this = shift;
- return $this->{'name'}
-}
-
-sub TEXT () { $_text }
-sub TEXT_PARAMETRIZED () { $_text_parametrized }
-sub CDATA () { $_cdata }
-sub TAG () { $_tag }
-sub DECL () { $_decl }
-sub PI () { $_pi }
-sub DIRECTIVE () { $_directive }
-sub COMMENT () { $_comment }
-sub UNKNOWN () { $_unknown }
-
-###############################################################################
-
-=over
-
-=item TEXT
-
-normal text (#text in the DTD)
-
-=item TEXT_PARAMETRIZED
-
-parametrized normal text
-(result of simple recognition of text interspersed with <TMPL_VAR> directives;
-this has to be explicitly enabled in the scanner)
-
-=item CDATA
-
-normal text (CDATA in the DTD)
-
-=item TAG
-
-something that has the form of an HTML tag
-
-=item DECL
-
-something that has the form of an SGML declaration
-
-=item PI
-
-something that has the form of an SGML processing instruction
-
-=item DIRECTIVE
-
-a Template Toolkit directive
-
-=item COMMENT
-
-something that has the form of an HTML comment
-(and is not recognized as an HTML::Template directive)
-
-=item UNKNOWN
-
-something that is not recognized at all by the scanner
-
-=back
-
-Note that end of file is currently represented by undef,
-instead of a constant predefined by this module.
-
-=cut
-
-1;
diff --git a/misc/translator/TmplTokenizer.pm b/misc/translator/TmplTokenizer.pm
index cb04513..6129f8d 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 '<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
--- 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
--- 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
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
+
--
1.7.4.1
More information about the Koha-patches
mailing list