View | Details | Raw Unified | Return to bug 6458
Collapse All | Expand All

(-)a/C4/TTParser.pm (+153 lines)
Line 0 Link Here
1
#!/usr/bin/env perl
2
#simple parser for HTML with Template Toolkit directives. Tokens are put into @tokens and are accesible via next_token and peep_token
3
package C4::TTParser;
4
use base qw(HTML::Parser);
5
use C4::TmplToken;
6
use strict;
7
use warnings;
8
9
#seems to be handled post tokenizer
10
##hash where key is tag we are interested in and the value is a hash of the attributes we want
11
#my %interesting_tags = (
12
#    img => { alt => 1 },
13
#);
14
15
#tokens found so far (used like a stack)
16
my ( @tokens );
17
18
#shiftnext token or undef
19
sub next_token{
20
    return shift @tokens;
21
}
22
23
#unshift token back on @tokens
24
sub unshift_token{
25
    my $self = shift;
26
    unshift @tokens, shift;
27
}
28
29
#have a peep at next token
30
sub peep_token{
31
    return $tokens[0];
32
}
33
34
#wrapper for parse
35
#please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
36
#signature build_tokens( self, filename)
37
sub build_tokens{
38
    my ($self, $filename) = @_;
39
    $self->{filename} = $filename;
40
    $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
41
    $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
42
    $self->handler(end => "end", "self, line, tag, attr, text"); #signature is end( self, linenumber, tagename, origional text )
43
    $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
44
    $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
45
#    $self->handler(default => "default", "self, line, text, is_cdata"); # anything else
46
    $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a C4::TmplTokenType::CDATA
47
    $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
48
    $self->parse_file($filename);
49
    return $self;
50
}
51
52
#handle parsing of text
53
sub text{
54
    my $self = shift;
55
    my $line = shift;
56
    my $work = shift; # original text
57
    my $is_cdata = shift;
58
    while($work){
59
        # if there is a template_toolkit tag
60
        if( $work =~ m/\[%.*?\]/ ){
61
            #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
62
            if( $` ){
63
                my $t = C4::TmplToken->new( $`, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
64
                push @tokens, $t;
65
            }
66
67
            #the match itself is a DIRECTIVE $&
68
            my $t = C4::TmplToken->new( $&, C4::TmplTokenType::DIRECTIVE, $line, $self->{filename} );
69
            push @tokens, $t;
70
71
            # put work still to do back into work
72
            $work = $' ? $' : 0;
73
        } else {
74
            # If there is some left over work, treat it as text token
75
            my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
76
	    
77
            push @tokens, $t;
78
            last;
79
        }
80
    }
81
}
82
83
sub declaration {
84
    my $self = shift;
85
    my $line = shift;
86
    my $work = shift; #original text
87
    my $is_cdata = shift;
88
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
89
    push @tokens, $t;  
90
}      
91
92
sub comment {
93
    my $self = shift;
94
    my $line = shift;
95
    my $work = shift; #original text
96
    my $is_cdata = shift;
97
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
98
    push @tokens, $t;  
99
}      
100
101
sub default {
102
    my $self = shift;
103
    my $line = shift;
104
    my $work = shift; #original text
105
    my $is_cdata = shift;
106
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
107
    push @tokens, $t;  
108
}      
109
110
111
#handle opening html tags
112
sub start{
113
    my $self = shift;
114
    my $line = shift;
115
    my $tag = shift;
116
    my $hash = shift; #hash of attr/value pairs
117
    my $text = shift; #origional text
118
    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename});
119
    my %attr;
120
    # tags seem to be uses in an 'interesting' way elsewhere..
121
    for my $key( %$hash ) {
122
        next unless defined $hash->{$key};
123
        if ($key eq "/"){
124
            $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 1 ];
125
            }
126
        else {
127
        $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
128
            }
129
    }
130
    $t->set_attributes( \%attr );
131
    push @tokens, $t;
132
}
133
134
#handle closing html tags
135
sub end{
136
    my $self = shift;
137
    my $line = shift;
138
    my $tag = shift;
139
    my $hash = shift;
140
    my $text = shift;
141
    # what format should this be in?
142
    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename} );
143
    my %attr;
144
    # tags seem to be uses in an 'interesting' way elsewhere..
145
    for my $key( %$hash ) {
146
        next unless defined $hash->{$key};
147
        $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
148
    }
149
    $t->set_attributes( \%attr );
150
    push @tokens, $t;
151
}
152
153
1;
(-)a/C4/TmplToken.pm (+158 lines)
Line 0 Link Here
1
package C4::TmplToken;
2
3
use strict;
4
#use warnings; FIXME - Bug 2505
5
use C4::TmplTokenType;
6
require Exporter;
7
8
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
9
10
###############################################################################
11
12
=head1 NAME
13
14
TmplToken.pm - Object representing a scanner token for .tmpl files
15
16
=head1 DESCRIPTION
17
18
This is a class representing a token scanned from an HTML::Template .tmpl file.
19
20
=cut
21
22
###############################################################################
23
24
$VERSION = 0.01;
25
26
@ISA = qw(Exporter);
27
@EXPORT_OK = qw();
28
29
###############################################################################
30
31
sub new {
32
    my $this = shift;
33
    my $class = ref($this) || $this;
34
    my $self = {};
35
    bless $self, $class;
36
    ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
37
    return $self;
38
}
39
40
sub string {
41
    my $this = shift;
42
    return $this->{'_string'}
43
}
44
45
sub type {
46
    my $this = shift;
47
    return $this->{'_type'}
48
}
49
50
sub pathname {
51
    my $this = shift;
52
    return $this->{'_path'}
53
}
54
55
sub line_number {
56
    my $this = shift;
57
    return $this->{'_lc'}
58
}
59
60
sub attributes {
61
    my $this = shift;
62
    return $this->{'_attr'};
63
}
64
65
sub set_attributes {
66
    my $this = shift;
67
    $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
68
    return $this;
69
}
70
71
# only meaningful for TEXT_PARAMETRIZED tokens
72
sub children {
73
    my $this = shift;
74
    return $this->{'_kids'};
75
}
76
77
# only meaningful for TEXT_PARAMETRIZED tokens
78
sub set_children {
79
    my $this = shift;
80
    $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
81
    return $this;
82
}
83
84
# only meaningful for TEXT_PARAMETRIZED tokens
85
# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
86
sub parameters_and_fields {
87
    my $this = shift;
88
    return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
89
		($_->type == C4::TmplTokenType::TAG
90
			&& $_->string =~ /^<input\b/is)? $_: ()}
91
	    @{$this->{'_kids'}};
92
}
93
94
# only meaningful for TEXT_PARAMETRIZED tokens
95
sub anchors {
96
    my $this = shift;
97
    return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
98
}
99
100
# only meaningful for TEXT_PARAMETRIZED tokens
101
sub form {
102
    my $this = shift;
103
    return $this->{'_form'};
104
}
105
106
# only meaningful for TEXT_PARAMETRIZED tokens
107
sub set_form {
108
    my $this = shift;
109
    $this->{'_form'} = $_[0];
110
    return $this;
111
}
112
113
sub has_js_data {
114
    my $this = shift;
115
    return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
116
}
117
118
sub js_data {
119
    my $this = shift;
120
    return $this->{'_js_data'};
121
}
122
123
sub set_js_data {
124
    my $this = shift;
125
    $this->{'_js_data'} = $_[0];
126
    return $this;
127
}
128
129
# predefined tests
130
131
sub tag_p {
132
    my $this = shift;
133
    return $this->type == C4::TmplTokenType::TAG;
134
}
135
136
sub cdata_p {
137
    my $this = shift;
138
    return $this->type == C4::TmplTokenType::CDATA;
139
}
140
141
sub text_p {
142
    my $this = shift;
143
    return $this->type == C4::TmplTokenType::TEXT;
144
}
145
146
sub text_parametrized_p {
147
    my $this = shift;
148
    return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
149
}
150
151
sub directive_p {
152
    my $this = shift;
153
    return $this->type == C4::TmplTokenType::DIRECTIVE;
154
}
155
156
###############################################################################
157
158
1;
(-)a/C4/TmplTokenType.pm (+129 lines)
Line 0 Link Here
1
package C4::TmplTokenType;
2
3
use strict;
4
#use warnings; FIXME - Bug 2505
5
require Exporter;
6
7
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
8
9
###############################################################################
10
11
=head1 NAME
12
13
C4::TmplTokenType.pm - Types of TmplToken objects
14
15
=head1 DESCRIPTION
16
17
This is a Java-style "safe enum" singleton class for types of TmplToken objects.
18
The predefined constants are
19
20
=cut
21
22
###############################################################################
23
24
$VERSION = 0.01;
25
26
@ISA = qw(Exporter);
27
@EXPORT_OK = qw(
28
    &TEXT
29
    &TEXT_PARAMETRIZED
30
    &CDATA
31
    &TAG
32
    &DECL
33
    &PI
34
    &DIRECTIVE
35
    &COMMENT
36
    &UNKNOWN
37
);
38
39
###############################################################################
40
41
use vars qw( $_text $_text_parametrized $_cdata
42
    $_tag $_decl $_pi $_directive $_comment $_null $_unknown );
43
44
BEGIN {
45
    my $new = sub {
46
	my $this = 'C4::TmplTokenType';#shift;
47
	my $class = ref($this) || $this;
48
	my $self = {};
49
	bless $self, $class;
50
	($self->{'id'}, $self->{'name'}, $self->{'desc'}) = @_;
51
	return $self;
52
    };
53
    $_text		= &$new(0, 'TEXT');
54
    $_text_parametrized	= &$new(8, 'TEXT-PARAMETRIZED');
55
    $_cdata		= &$new(1, 'CDATA');
56
    $_tag		= &$new(2, 'TAG');
57
    $_decl		= &$new(3, 'DECL');
58
    $_pi		= &$new(4, 'PI');
59
    $_directive		= &$new(5, 'DIRECTIVE');
60
    $_comment		= &$new(6, 'COMMENT');
61
    $_unknown		= &$new(7, 'UNKNOWN');
62
}
63
64
sub to_string {
65
    my $this = shift;
66
    return $this->{'name'}
67
}
68
69
sub TEXT		() { $_text }
70
sub TEXT_PARAMETRIZED	() { $_text_parametrized }
71
sub CDATA		() { $_cdata }
72
sub TAG			() { $_tag }
73
sub DECL		() { $_decl }
74
sub PI			() { $_pi }
75
sub DIRECTIVE		() { $_directive }
76
sub COMMENT		() { $_comment }
77
sub UNKNOWN		() { $_unknown }
78
79
###############################################################################
80
81
=over
82
83
=item TEXT
84
85
normal text (#text in the DTD)
86
87
=item TEXT_PARAMETRIZED
88
89
parametrized normal text
90
(result of simple recognition of text interspersed with <TMPL_VAR> directives;
91
this has to be explicitly enabled in the scanner)
92
93
=item CDATA
94
95
normal text (CDATA in the DTD)
96
97
=item TAG
98
99
something that has the form of an HTML tag
100
101
=item DECL
102
103
something that has the form of an SGML declaration
104
105
=item PI
106
107
something that has the form of an SGML processing instruction
108
109
=item DIRECTIVE
110
111
a Template Toolkit directive
112
113
=item COMMENT
114
115
something that has the form of an HTML comment
116
(and is not recognized as an HTML::Template directive)
117
118
=item UNKNOWN
119
120
something that is not recognized at all by the scanner
121
122
=back
123
124
Note that end of file is currently represented by undef,
125
instead of a constant predefined by this module.
126
127
=cut
128
129
1;
(-)a/misc/translator/TTParser.pm (-153 lines)
Lines 1-153 Link Here
1
#!/usr/bin/env perl
2
#simple parser for HTML with Template Toolkit directives. Tokens are put into @tokens and are accesible via next_token and peep_token
3
package TTParser;
4
use base qw(HTML::Parser);
5
use TmplToken;
6
use strict;
7
use warnings;
8
9
#seems to be handled post tokenizer
10
##hash where key is tag we are interested in and the value is a hash of the attributes we want
11
#my %interesting_tags = (
12
#    img => { alt => 1 },
13
#);
14
15
#tokens found so far (used like a stack)
16
my ( @tokens );
17
18
#shiftnext token or undef
19
sub next_token{
20
    return shift @tokens;
21
}
22
23
#unshift token back on @tokens
24
sub unshift_token{
25
    my $self = shift;
26
    unshift @tokens, shift;
27
}
28
29
#have a peep at next token
30
sub peep_token{
31
    return $tokens[0];
32
}
33
34
#wrapper for parse
35
#please use this method INSTEAD of the HTML::Parser->parse_file method (and HTML::Parser->parse)
36
#signature build_tokens( self, filename)
37
sub build_tokens{
38
    my ($self, $filename) = @_;
39
    $self->{filename} = $filename;
40
    $self->handler(start => "start", "self, line, tagname, attr, text"); #signature is start( self, linenumber, tagname, hash of attributes, origional text )
41
    $self->handler(text => "text", "self, line, text, is_cdata"); #signature is text( self, linenumber, origional text, is_cdata )
42
    $self->handler(end => "end", "self, line, tag, attr, text"); #signature is end( self, linenumber, tagename, origional text )
43
    $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
44
    $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
45
#    $self->handler(default => "default", "self, line, text, is_cdata"); # anything else
46
    $self->marked_sections(1); #treat anything inside CDATA tags as text, should really make it a TmplTokenType::CDATA
47
    $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
48
    $self->parse_file($filename);
49
    return $self;
50
}
51
52
#handle parsing of text
53
sub text{
54
    my $self = shift;
55
    my $line = shift;
56
    my $work = shift; # original text
57
    my $is_cdata = shift;
58
    while($work){
59
        # if there is a template_toolkit tag
60
        if( $work =~ m/\[%.*?\]/ ){
61
            #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
62
            if( $` ){
63
                my $t = TmplToken->new( $`, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
64
                push @tokens, $t;
65
            }
66
67
            #the match itself is a DIRECTIVE $&
68
            my $t = TmplToken->new( $&, TmplTokenType::DIRECTIVE, $line, $self->{filename} );
69
            push @tokens, $t;
70
71
            # put work still to do back into work
72
            $work = $' ? $' : 0;
73
        } else {
74
            # If there is some left over work, treat it as text token
75
            my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
76
	    
77
            push @tokens, $t;
78
            last;
79
        }
80
    }
81
}
82
83
sub declaration {
84
    my $self = shift;
85
    my $line = shift;
86
    my $work = shift; #original text
87
    my $is_cdata = shift;
88
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
89
    push @tokens, $t;  
90
}      
91
92
sub comment {
93
    my $self = shift;
94
    my $line = shift;
95
    my $work = shift; #original text
96
    my $is_cdata = shift;
97
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
98
    push @tokens, $t;  
99
}      
100
101
sub default {
102
    my $self = shift;
103
    my $line = shift;
104
    my $work = shift; #original text
105
    my $is_cdata = shift;
106
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
107
    push @tokens, $t;  
108
}      
109
110
111
#handle opening html tags
112
sub start{
113
    my $self = shift;
114
    my $line = shift;
115
    my $tag = shift;
116
    my $hash = shift; #hash of attr/value pairs
117
    my $text = shift; #origional text
118
    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename});
119
    my %attr;
120
    # tags seem to be uses in an 'interesting' way elsewhere..
121
    for my $key( %$hash ) {
122
        next unless defined $hash->{$key};
123
        if ($key eq "/"){
124
            $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 1 ];
125
            }
126
        else {
127
        $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
128
            }
129
    }
130
    $t->set_attributes( \%attr );
131
    push @tokens, $t;
132
}
133
134
#handle closing html tags
135
sub end{
136
    my $self = shift;
137
    my $line = shift;
138
    my $tag = shift;
139
    my $hash = shift;
140
    my $text = shift;
141
    # what format should this be in?
142
    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename} );
143
    my %attr;
144
    # tags seem to be uses in an 'interesting' way elsewhere..
145
    for my $key( %$hash ) {
146
        next unless defined $hash->{$key};
147
        $attr{+lc($key)} = [ $key, $hash->{$key}, $key."=".$hash->{$key}, 0 ];
148
    }
149
    $t->set_attributes( \%attr );
150
    push @tokens, $t;
151
}
152
153
1;
(-)a/misc/translator/TmplToken.pm (-158 lines)
Lines 1-158 Link Here
1
package TmplToken;
2
3
use strict;
4
#use warnings; FIXME - Bug 2505
5
use TmplTokenType;
6
require Exporter;
7
8
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
9
10
###############################################################################
11
12
=head1 NAME
13
14
TmplToken.pm - Object representing a scanner token for .tmpl files
15
16
=head1 DESCRIPTION
17
18
This is a class representing a token scanned from an HTML::Template .tmpl file.
19
20
=cut
21
22
###############################################################################
23
24
$VERSION = 0.01;
25
26
@ISA = qw(Exporter);
27
@EXPORT_OK = qw();
28
29
###############################################################################
30
31
sub new {
32
    my $this = shift;
33
    my $class = ref($this) || $this;
34
    my $self = {};
35
    bless $self, $class;
36
    ($self->{'_string'}, $self->{'_type'}, $self->{'_lc'}, $self->{'_path'}) = @_;
37
    return $self;
38
}
39
40
sub string {
41
    my $this = shift;
42
    return $this->{'_string'}
43
}
44
45
sub type {
46
    my $this = shift;
47
    return $this->{'_type'}
48
}
49
50
sub pathname {
51
    my $this = shift;
52
    return $this->{'_path'}
53
}
54
55
sub line_number {
56
    my $this = shift;
57
    return $this->{'_lc'}
58
}
59
60
sub attributes {
61
    my $this = shift;
62
    return $this->{'_attr'};
63
}
64
65
sub set_attributes {
66
    my $this = shift;
67
    $this->{'_attr'} = ref $_[0] eq 'HASH'? $_[0]: \@_;
68
    return $this;
69
}
70
71
# only meaningful for TEXT_PARAMETRIZED tokens
72
sub children {
73
    my $this = shift;
74
    return $this->{'_kids'};
75
}
76
77
# only meaningful for TEXT_PARAMETRIZED tokens
78
sub set_children {
79
    my $this = shift;
80
    $this->{'_kids'} = ref $_[0] eq 'ARRAY'? $_[0]: \@_;
81
    return $this;
82
}
83
84
# only meaningful for TEXT_PARAMETRIZED tokens
85
# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
86
sub parameters_and_fields {
87
    my $this = shift;
88
    return map { $_->type == TmplTokenType::DIRECTIVE? $_:
89
		($_->type == TmplTokenType::TAG
90
			&& $_->string =~ /^<input\b/is)? $_: ()}
91
	    @{$this->{'_kids'}};
92
}
93
94
# only meaningful for TEXT_PARAMETRIZED tokens
95
sub anchors {
96
    my $this = shift;
97
    return map { $_->type == TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
98
}
99
100
# only meaningful for TEXT_PARAMETRIZED tokens
101
sub form {
102
    my $this = shift;
103
    return $this->{'_form'};
104
}
105
106
# only meaningful for TEXT_PARAMETRIZED tokens
107
sub set_form {
108
    my $this = shift;
109
    $this->{'_form'} = $_[0];
110
    return $this;
111
}
112
113
sub has_js_data {
114
    my $this = shift;
115
    return defined $this->{'_js_data'} && ref($this->{'_js_data'}) eq 'ARRAY';
116
}
117
118
sub js_data {
119
    my $this = shift;
120
    return $this->{'_js_data'};
121
}
122
123
sub set_js_data {
124
    my $this = shift;
125
    $this->{'_js_data'} = $_[0];
126
    return $this;
127
}
128
129
# predefined tests
130
131
sub tag_p {
132
    my $this = shift;
133
    return $this->type == TmplTokenType::TAG;
134
}
135
136
sub cdata_p {
137
    my $this = shift;
138
    return $this->type == TmplTokenType::CDATA;
139
}
140
141
sub text_p {
142
    my $this = shift;
143
    return $this->type == TmplTokenType::TEXT;
144
}
145
146
sub text_parametrized_p {
147
    my $this = shift;
148
    return $this->type == TmplTokenType::TEXT_PARAMETRIZED;
149
}
150
151
sub directive_p {
152
    my $this = shift;
153
    return $this->type == TmplTokenType::DIRECTIVE;
154
}
155
156
###############################################################################
157
158
1;
(-)a/misc/translator/TmplTokenType.pm (-129 lines)
Lines 1-129 Link Here
1
package TmplTokenType;
2
3
use strict;
4
#use warnings; FIXME - Bug 2505
5
require Exporter;
6
7
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
8
9
###############################################################################
10
11
=head1 NAME
12
13
TmplTokenType.pm - Types of TmplToken objects
14
15
=head1 DESCRIPTION
16
17
This is a Java-style "safe enum" singleton class for types of TmplToken objects.
18
The predefined constants are
19
20
=cut
21
22
###############################################################################
23
24
$VERSION = 0.01;
25
26
@ISA = qw(Exporter);
27
@EXPORT_OK = qw(
28
    &TEXT
29
    &TEXT_PARAMETRIZED
30
    &CDATA
31
    &TAG
32
    &DECL
33
    &PI
34
    &DIRECTIVE
35
    &COMMENT
36
    &UNKNOWN
37
);
38
39
###############################################################################
40
41
use vars qw( $_text $_text_parametrized $_cdata
42
    $_tag $_decl $_pi $_directive $_comment $_null $_unknown );
43
44
BEGIN {
45
    my $new = sub {
46
	my $this = 'TmplTokenType';#shift;
47
	my $class = ref($this) || $this;
48
	my $self = {};
49
	bless $self, $class;
50
	($self->{'id'}, $self->{'name'}, $self->{'desc'}) = @_;
51
	return $self;
52
    };
53
    $_text		= &$new(0, 'TEXT');
54
    $_text_parametrized	= &$new(8, 'TEXT-PARAMETRIZED');
55
    $_cdata		= &$new(1, 'CDATA');
56
    $_tag		= &$new(2, 'TAG');
57
    $_decl		= &$new(3, 'DECL');
58
    $_pi		= &$new(4, 'PI');
59
    $_directive		= &$new(5, 'DIRECTIVE');
60
    $_comment		= &$new(6, 'COMMENT');
61
    $_unknown		= &$new(7, 'UNKNOWN');
62
}
63
64
sub to_string {
65
    my $this = shift;
66
    return $this->{'name'}
67
}
68
69
sub TEXT		() { $_text }
70
sub TEXT_PARAMETRIZED	() { $_text_parametrized }
71
sub CDATA		() { $_cdata }
72
sub TAG			() { $_tag }
73
sub DECL		() { $_decl }
74
sub PI			() { $_pi }
75
sub DIRECTIVE		() { $_directive }
76
sub COMMENT		() { $_comment }
77
sub UNKNOWN		() { $_unknown }
78
79
###############################################################################
80
81
=over
82
83
=item TEXT
84
85
normal text (#text in the DTD)
86
87
=item TEXT_PARAMETRIZED
88
89
parametrized normal text
90
(result of simple recognition of text interspersed with <TMPL_VAR> directives;
91
this has to be explicitly enabled in the scanner)
92
93
=item CDATA
94
95
normal text (CDATA in the DTD)
96
97
=item TAG
98
99
something that has the form of an HTML tag
100
101
=item DECL
102
103
something that has the form of an SGML declaration
104
105
=item PI
106
107
something that has the form of an SGML processing instruction
108
109
=item DIRECTIVE
110
111
a Template Toolkit directive
112
113
=item COMMENT
114
115
something that has the form of an HTML comment
116
(and is not recognized as an HTML::Template directive)
117
118
=item UNKNOWN
119
120
something that is not recognized at all by the scanner
121
122
=back
123
124
Note that end of file is currently represented by undef,
125
instead of a constant predefined by this module.
126
127
=cut
128
129
1;
(-)a/misc/translator/TmplTokenizer.pm (-16 / +16 lines)
Lines 2-10 package TmplTokenizer; Link Here
2
2
3
use strict;
3
use strict;
4
#use warnings; FIXME - Bug 2505
4
#use warnings; FIXME - Bug 2505
5
use TmplTokenType;
5
use C4::TmplTokenType;
6
use TmplToken;
6
use C4::TmplToken;
7
use TTParser;
7
use C4::TTParser;
8
use VerboseWarnings qw( pedantic_p error_normal warn_normal warn_pedantic );
8
use VerboseWarnings qw( pedantic_p error_normal warn_normal warn_pedantic );
9
require Exporter;
9
require Exporter;
10
10
Lines 68-74 sub new { Link Here
68
    shift;
68
    shift;
69
    my ($filename) = @_;
69
    my ($filename) = @_;
70
    #open my $handle,$filename or die "can't open $filename";
70
    #open my $handle,$filename or die "can't open $filename";
71
    my $parser = TTParser->new;
71
    my $parser = C4::TTParser->new;
72
    $parser->build_tokens( $filename );
72
    $parser->build_tokens( $filename );
73
    bless {
73
    bless {
74
      filename => $filename,
74
      filename => $filename,
Lines 259-269 sub _formalize_string_cformat{ Link Here
259
259
260
sub _formalize{
260
sub _formalize{
261
  my $t = shift;
261
  my $t = shift;
262
  if( $t->type == TmplTokenType::DIRECTIVE ){
262
  if( $t->type == C4::TmplTokenType::DIRECTIVE ){
263
    return '%s';
263
    return '%s';
264
  } elsif( $t->type == TmplTokenType::TEXT ){
264
  } elsif( $t->type == C4::TmplTokenType::TEXT ){
265
    return _formalize_string_cformat( $t->string );
265
    return _formalize_string_cformat( $t->string );
266
  } elsif( $t->type == TmplTokenType::TAG ){
266
  } elsif( $t->type == C4::TmplTokenType::TAG ){
267
    if( $t->string =~ m/^a\b/is ){
267
    if( $t->string =~ m/^a\b/is ){
268
      return '<a>';
268
      return '<a>';
269
    } elsif( $t->string =~ m/^input\b/is ){
269
    } elsif( $t->string =~ m/^input\b/is ){
Lines 281-293 sub _formalize{ Link Here
281
}
281
}
282
282
283
# internal parametization, used within next_token
283
# internal parametization, used within next_token
284
# method that takes in an array of TEXT and DIRECTIVE tokens (DIRECTIVEs must be GET) and return a TmplTokenType::TEXT_PARAMETRIZED
284
# method that takes in an array of TEXT and DIRECTIVE tokens (DIRECTIVEs must be GET) and return a C4::TmplTokenType::TEXT_PARAMETRIZED
285
sub _parametrize_internal{
285
sub _parametrize_internal{
286
    my $this = shift;
286
    my $this = shift;
287
    my @parts = @_;
287
    my @parts = @_;
288
    # my $s = "";
288
    # my $s = "";
289
    # for my $item (@parts){
289
    # for my $item (@parts){
290
    #     if( $item->type == TmplTokenType::TEXT ){
290
    #     if( $item->type == C4::TmplTokenType::TEXT ){
291
    #         $s .= $item->string;
291
    #         $s .= $item->string;
292
    #     } else {
292
    #     } else {
293
    #         #must be a variable directive
293
    #         #must be a variable directive
Lines 297-303 sub _parametrize_internal{ Link Here
297
    my $s = join( "", map { _formalize $_ } @parts );
297
    my $s = join( "", map { _formalize $_ } @parts );
298
    # should both the string and form be $s? maybe only the later? posibly the former....
298
    # should both the string and form be $s? maybe only the later? posibly the former....
299
    # used line number from first token, should suffice
299
    # used line number from first token, should suffice
300
    my $t = TmplToken->new( $s, TmplTokenType::TEXT_PARAMETRIZED, $parts[0]->line_number, $this->filename );
300
    my $t = C4::TmplToken->new( $s, C4::TmplTokenType::TEXT_PARAMETRIZED, $parts[0]->line_number, $this->filename );
301
    $t->set_children(@parts);
301
    $t->set_children(@parts);
302
    $t->set_form($s);
302
    $t->set_form($s);
303
    return $t;
303
    return $t;
Lines 321-334 sub next_token { Link Here
321
        }
321
        }
322
        # if cformat mode is off, dont bother parametrizing, just return them as they come
322
        # if cformat mode is off, dont bother parametrizing, just return them as they come
323
        return $next unless $self->allow_cformat_p;
323
        return $next unless $self->allow_cformat_p;
324
        if( $next->type == TmplTokenType::TEXT ){
324
        if( $next->type == C4::TmplTokenType::TEXT ){
325
            push @parts, $next;
325
            push @parts, $next;
326
        } 
326
        } 
327
#        elsif( $next->type == TmplTokenType::DIRECTIVE && $next->string =~ m/\[%\s*\w+\s*%\]/ ){
327
#        elsif( $next->type == C4::TmplTokenType::DIRECTIVE && $next->string =~ m/\[%\s*\w+\s*%\]/ ){
328
        elsif( $next->type == TmplTokenType::DIRECTIVE ){
328
        elsif( $next->type == C4::TmplTokenType::DIRECTIVE ){
329
            push @parts, $next;
329
            push @parts, $next;
330
        } 
330
        } 
331
        elsif ( $next->type == TmplTokenType::CDATA){
331
        elsif ( $next->type == C4::TmplTokenType::CDATA){
332
            $self->_set_js_mode(1);
332
            $self->_set_js_mode(1);
333
            my $s0 = $next->string;
333
            my $s0 = $next->string;
334
            my @head = ();
334
            my @head = ();
Lines 383-389 sub parametrize ($$$$) { Link Here
383
		    my $param = $params[$i - 1];
383
		    my $param = $params[$i - 1];
384
		    warn_normal "$fmt_0: $&: Expected a TMPL_VAR, but found a "
384
		    warn_normal "$fmt_0: $&: Expected a TMPL_VAR, but found a "
385
			    . $param->type->to_string . "\n", undef
385
			    . $param->type->to_string . "\n", undef
386
			    if $param->type != TmplTokenType::DIRECTIVE;
386
			    if $param->type != C4::TmplTokenType::DIRECTIVE;
387
		    warn_normal "$fmt_0: $&: Unsupported "
387
		    warn_normal "$fmt_0: $&: Unsupported "
388
				. "field width or precision\n", undef
388
				. "field width or precision\n", undef
389
			    if defined $width || defined $prec;
389
			    if defined $width || defined $prec;
Lines 400-406 sub parametrize ($$$$) { Link Here
400
		if (!defined $param) {
400
		if (!defined $param) {
401
		    warn_normal "$fmt_0: $&: Parameter $i not known", undef;
401
		    warn_normal "$fmt_0: $&: Parameter $i not known", undef;
402
		} else {
402
		} else {
403
		    if ($param->type == TmplTokenType::TAG
403
		    if ($param->type == C4::TmplTokenType::TAG
404
			    && $param->string =~ /^<input\b/is) {
404
			    && $param->string =~ /^<input\b/is) {
405
			my $type = defined $param->attributes?
405
			my $type = defined $param->attributes?
406
				lc($param->attributes->{'type'}->[1]): undef;
406
				lc($param->attributes->{'type'}->[1]): undef;
(-)a/misc/translator/tmpl_process3.pl (-4 / +4 lines)
Lines 95-110 sub text_replace (**) { Link Here
95
    my $s = TmplTokenizer::next_token $h;
95
    my $s = TmplTokenizer::next_token $h;
96
    last unless defined $s;
96
    last unless defined $s;
97
    my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
97
    my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
98
    if ($kind eq TmplTokenType::TEXT) {
98
    if ($kind eq C4::TmplTokenType::TEXT) {
99
        print $output find_translation($t);
99
        print $output find_translation($t);
100
    } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
100
    } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
101
        my $fmt = find_translation($s->form);
101
        my $fmt = find_translation($s->form);
102
        print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
102
        print $output TmplTokenizer::parametrize($fmt, 1, $s, sub {
103
        $_ = $_[0];
103
        $_ = $_[0];
104
        my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
104
        my($kind, $t, $attr) = ($_->type, $_->string, $_->attributes);
105
        $kind == TmplTokenType::TAG && %$attr?
105
        $kind == C4::TmplTokenType::TAG && %$attr?
106
            text_replace_tag($t, $attr): $t });
106
            text_replace_tag($t, $attr): $t });
107
    } elsif ($kind eq TmplTokenType::TAG && %$attr) {
107
    } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
108
        print $output text_replace_tag($t, $attr);
108
        print $output text_replace_tag($t, $attr);
109
    } elsif ($s->has_js_data) {
109
    } elsif ($s->has_js_data) {
110
        for my $t (@{$s->js_data}) {
110
        for my $t (@{$s->js_data}) {
(-)a/xt/tt_valid.t (-1 / +82 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright (C) 2011 Tamil s.a.r.l.
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use warnings;
21
use strict;
22
use Test::More tests => 1;
23
use File::Find;
24
use Cwd;
25
use C4::TTParser;
26
27
28
my @files_with_directive_in_tag = do {
29
    my @files;
30
    find( sub {
31
        my $dir = getcwd();
32
        return if $dir =~ /blib/;
33
        return unless /\.(tt)$/;
34
        my $name = $_;
35
        my $parser = C4::TTParser->new;
36
        $parser->build_tokens( $name );  
37
        my @lines;
38
        while ( my $token = $parser->next_token ) {
39
            my $attr = $token->{_attr};
40
            next unless $attr;
41
            push @lines, $token->{_lc} if $attr->{'[%'};
42
        }
43
        ($dir) = $dir =~ /koha-tmpl\/(.*)$/;
44
        push @files, { name => "$dir/$name", lines => \@lines } if @lines;
45
      }, ( "./koha-tmpl/opac-tmpl/prog/en",
46
           "./koha-tmpl/intranet-tmpl/prog/en" )
47
    );
48
    @files;
49
};
50
51
52
ok( !@files_with_directive_in_tag, "TT syntax: not using TT directive within HTML tag" )
53
    or diag( "Files list: \n",
54
        join( "\n", map {$_->{name} . ': ' . join(', ', @{$_->{lines}})
55
            } @files_with_directive_in_tag ) );
56
57
58
59
=head1 NAME
60
61
tt_valid.t
62
63
=head1 DESCRIPTION
64
65
This test validate Template Toolkit (TT) Koha files.
66
67
For the time being an unique validation is done: Test if TT files contain TT
68
directive within HTML tag. For example:
69
70
  <li[% IF
71
72
This kind of constuction MUST be avoided because it break Koha translation
73
process.
74
75
=head1 USAGE
76
77
From Koha root directory:
78
79
prove -v xt/tt_valid.t
80
81
=cut
82

Return to bug 6458