From ed12a749f1f88205356da6264206440860aaa240 Mon Sep 17 00:00:00 2001 From: =?UTF-8?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 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: { 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; + +@ISA = qw(Exporter); +@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 =~ /^{'_kids'}}; +} + +# only meaningful for TEXT_PARAMETRIZED tokens +sub anchors { + my $this = shift; + return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^{'_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; + +@ISA = qw(Exporter); +@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 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; - -@ISA = qw(Exporter); -@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 =~ /^{'_kids'}}; -} - -# only meaningful for TEXT_PARAMETRIZED tokens -sub anchors { - my $this = shift; - return map { $_->type == TmplTokenType::TAG && $_->string =~ /^{'_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; - -@ISA = qw(Exporter); -@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 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 ''; } 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 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/xt/tt_valid.t b/xt/tt_valid.t new file mode 100755 index 0000000..b7e2031 --- /dev/null +++ b/xt/tt_valid.t @@ -0,0 +1,82 @@ +#!/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)$/; + 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: + +