--- /dev/null
+#!/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;
--- /dev/null
+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 =~ /^<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;
--- /dev/null
+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 <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;
+++ /dev/null
-#!/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;
+++ /dev/null
-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 =~ /^<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;
+++ /dev/null
-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 <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;
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;
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,
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 ){
}
# 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
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;
}
# 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 = ();
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;
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;
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}) {
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 '' );
}
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') {
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?
. (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;
$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
$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 '*****';
--- /dev/null
+#!/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
+
projects / koha.git / commitdiff