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

(-)a/misc/translator/TTParser.pm (-11 / +11 lines)
Lines 1-8 Link Here
1
#!/usr/bin/env perl
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
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;
3
package C4::TTParser;
4
use base qw(HTML::Parser);
4
use base qw(HTML::Parser);
5
use TmplToken;
5
use C4::TmplToken;
6
use strict;
6
use strict;
7
use warnings;
7
use warnings;
8
8
Lines 43-49 sub build_tokens{ Link Here
43
    $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
43
    $self->handler(declaration => "declaration", "self, line, text, is_cdata"); # declaration
44
    $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
44
    $self->handler(comment => "comment", "self, line, text, is_cdata"); # comments
45
#    $self->handler(default => "default", "self, line, text, is_cdata"); # anything else
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
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)
47
    $self->unbroken_text(1); #make contiguous whitespace into a single token (can span multiple lines)
48
    $self->parse_file($filename);
48
    $self->parse_file($filename);
49
    return $self;
49
    return $self;
Lines 60-78 sub text{ Link Here
60
        if( $work =~ m/\[%.*?\]/ ){
60
        if( $work =~ m/\[%.*?\]/ ){
61
            #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
61
            #everything before this tag is text (or possibly CDATA), add a text token to tokens if $`
62
            if( $` ){
62
            if( $` ){
63
                my $t = TmplToken->new( $`, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
63
                my $t = C4::TmplToken->new( $`, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
64
                push @tokens, $t;
64
                push @tokens, $t;
65
            }
65
            }
66
66
67
            #the match itself is a DIRECTIVE $&
67
            #the match itself is a DIRECTIVE $&
68
            my $t = TmplToken->new( $&, TmplTokenType::DIRECTIVE, $line, $self->{filename} );
68
            my $t = C4::TmplToken->new( $&, C4::TmplTokenType::DIRECTIVE, $line, $self->{filename} );
69
            push @tokens, $t;
69
            push @tokens, $t;
70
70
71
            # put work still to do back into work
71
            # put work still to do back into work
72
            $work = $' ? $' : 0;
72
            $work = $' ? $' : 0;
73
        } else {
73
        } else {
74
            # If there is some left over work, treat it as text token
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} );
75
            my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
76
	    
76
	    
77
            push @tokens, $t;
77
            push @tokens, $t;
78
            last;
78
            last;
Lines 85-91 sub declaration { Link Here
85
    my $line = shift;
85
    my $line = shift;
86
    my $work = shift; #original text
86
    my $work = shift; #original text
87
    my $is_cdata = shift;
87
    my $is_cdata = shift;
88
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
88
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
89
    push @tokens, $t;  
89
    push @tokens, $t;  
90
}      
90
}      
91
91
Lines 94-100 sub comment { Link Here
94
    my $line = shift;
94
    my $line = shift;
95
    my $work = shift; #original text
95
    my $work = shift; #original text
96
    my $is_cdata = shift;
96
    my $is_cdata = shift;
97
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
97
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
98
    push @tokens, $t;  
98
    push @tokens, $t;  
99
}      
99
}      
100
100
Lines 103-109 sub default { Link Here
103
    my $line = shift;
103
    my $line = shift;
104
    my $work = shift; #original text
104
    my $work = shift; #original text
105
    my $is_cdata = shift;
105
    my $is_cdata = shift;
106
    my $t = TmplToken->new( $work, ($is_cdata? TmplTokenType::CDATA : TmplTokenType::TEXT), $line, $self->{filename} );
106
    my $t = C4::TmplToken->new( $work, ($is_cdata? C4::TmplTokenType::CDATA : C4::TmplTokenType::TEXT), $line, $self->{filename} );
107
    push @tokens, $t;  
107
    push @tokens, $t;  
108
}      
108
}      
109
109
Lines 115-121 sub start{ Link Here
115
    my $tag = shift;
115
    my $tag = shift;
116
    my $hash = shift; #hash of attr/value pairs
116
    my $hash = shift; #hash of attr/value pairs
117
    my $text = shift; #origional text
117
    my $text = shift; #origional text
118
    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename});
118
    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename});
119
    my %attr;
119
    my %attr;
120
    # tags seem to be uses in an 'interesting' way elsewhere..
120
    # tags seem to be uses in an 'interesting' way elsewhere..
121
    for my $key( %$hash ) {
121
    for my $key( %$hash ) {
Lines 139-145 sub end{ Link Here
139
    my $hash = shift;
139
    my $hash = shift;
140
    my $text = shift;
140
    my $text = shift;
141
    # what format should this be in?
141
    # what format should this be in?
142
    my $t = TmplToken->new( $text, TmplTokenType::TAG, $line, $self->{filename} );
142
    my $t = C4::TmplToken->new( $text, C4::TmplTokenType::TAG, $line, $self->{filename} );
143
    my %attr;
143
    my %attr;
144
    # tags seem to be uses in an 'interesting' way elsewhere..
144
    # tags seem to be uses in an 'interesting' way elsewhere..
145
    for my $key( %$hash ) {
145
    for my $key( %$hash ) {
(-)a/misc/translator/TmplToken.pm (-10 / +10 lines)
Lines 1-8 Link Here
1
package TmplToken;
1
package C4::TmplToken;
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
require Exporter;
6
require Exporter;
7
7
8
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
8
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
Lines 85-92 sub set_children { Link Here
85
# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
85
# FIXME: DIRECTIVE is not necessarily TMPL_VAR !!
86
sub parameters_and_fields {
86
sub parameters_and_fields {
87
    my $this = shift;
87
    my $this = shift;
88
    return map { $_->type == TmplTokenType::DIRECTIVE? $_:
88
    return map { $_->type == C4::TmplTokenType::DIRECTIVE? $_:
89
		($_->type == TmplTokenType::TAG
89
		($_->type == C4::TmplTokenType::TAG
90
			&& $_->string =~ /^<input\b/is)? $_: ()}
90
			&& $_->string =~ /^<input\b/is)? $_: ()}
91
	    @{$this->{'_kids'}};
91
	    @{$this->{'_kids'}};
92
}
92
}
Lines 94-100 sub parameters_and_fields { Link Here
94
# only meaningful for TEXT_PARAMETRIZED tokens
94
# only meaningful for TEXT_PARAMETRIZED tokens
95
sub anchors {
95
sub anchors {
96
    my $this = shift;
96
    my $this = shift;
97
    return map { $_->type == TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
97
    return map { $_->type == C4::TmplTokenType::TAG && $_->string =~ /^<a\b/is? $_: ()} @{$this->{'_kids'}};
98
}
98
}
99
99
100
# only meaningful for TEXT_PARAMETRIZED tokens
100
# only meaningful for TEXT_PARAMETRIZED tokens
Lines 130-156 sub set_js_data { Link Here
130
130
131
sub tag_p {
131
sub tag_p {
132
    my $this = shift;
132
    my $this = shift;
133
    return $this->type == TmplTokenType::TAG;
133
    return $this->type == C4::TmplTokenType::TAG;
134
}
134
}
135
135
136
sub cdata_p {
136
sub cdata_p {
137
    my $this = shift;
137
    my $this = shift;
138
    return $this->type == TmplTokenType::CDATA;
138
    return $this->type == C4::TmplTokenType::CDATA;
139
}
139
}
140
140
141
sub text_p {
141
sub text_p {
142
    my $this = shift;
142
    my $this = shift;
143
    return $this->type == TmplTokenType::TEXT;
143
    return $this->type == C4::TmplTokenType::TEXT;
144
}
144
}
145
145
146
sub text_parametrized_p {
146
sub text_parametrized_p {
147
    my $this = shift;
147
    my $this = shift;
148
    return $this->type == TmplTokenType::TEXT_PARAMETRIZED;
148
    return $this->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
149
}
149
}
150
150
151
sub directive_p {
151
sub directive_p {
152
    my $this = shift;
152
    my $this = shift;
153
    return $this->type == TmplTokenType::DIRECTIVE;
153
    return $this->type == C4::TmplTokenType::DIRECTIVE;
154
}
154
}
155
155
156
###############################################################################
156
###############################################################################
(-)a/misc/translator/TmplTokenType.pm (-3 / +3 lines)
Lines 1-4 Link Here
1
package TmplTokenType;
1
package C4::TmplTokenType;
2
2
3
use strict;
3
use strict;
4
#use warnings; FIXME - Bug 2505
4
#use warnings; FIXME - Bug 2505
Lines 10-16 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); Link Here
10
10
11
=head1 NAME
11
=head1 NAME
12
12
13
TmplTokenType.pm - Types of TmplToken objects
13
C4::TmplTokenType.pm - Types of TmplToken objects
14
14
15
=head1 DESCRIPTION
15
=head1 DESCRIPTION
16
16
Lines 43-49 use vars qw( $_text $_text_parametrized $_cdata Link Here
43
43
44
BEGIN {
44
BEGIN {
45
    my $new = sub {
45
    my $new = sub {
46
	my $this = 'TmplTokenType';#shift;
46
	my $this = 'C4::TmplTokenType';#shift;
47
	my $class = ref($this) || $this;
47
	my $class = ref($this) || $this;
48
	my $self = {};
48
	my $self = {};
49
	bless $self, $class;
49
	bless $self, $class;
(-)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/misc/translator/xgettext.pl (-14 / +14 lines)
Lines 44-55 sub token_negligible_p( $ ) { Link Here
44
    my($x) = @_;
44
    my($x) = @_;
45
    my $t = $x->type;
45
    my $t = $x->type;
46
    return !$extract_all_p && (
46
    return !$extract_all_p && (
47
	    $t == TmplTokenType::TEXT? string_negligible_p( $x->string ):
47
	    $t == C4::TmplTokenType::TEXT? string_negligible_p( $x->string ):
48
	    $t == TmplTokenType::DIRECTIVE? 1:
48
	    $t == C4::TmplTokenType::DIRECTIVE? 1:
49
	    $t == TmplTokenType::TEXT_PARAMETRIZED
49
	    $t == C4::TmplTokenType::TEXT_PARAMETRIZED
50
		&& join( '', map { my $t = $_->type;
50
		&& join( '', map { my $t = $_->type;
51
			$t == TmplTokenType::DIRECTIVE?
51
			$t == C4::TmplTokenType::DIRECTIVE?
52
				'1': $t == TmplTokenType::TAG?
52
				'1': $t == C4::TmplTokenType::TAG?
53
					'': token_negligible_p( $_ )?
53
					'': token_negligible_p( $_ )?
54
					'': '1' } @{$x->children} ) eq '' );
54
					'': '1' } @{$x->children} ) eq '' );
55
}
55
}
Lines 91-105 sub text_extract (*) { Link Here
91
        my $s = TmplTokenizer::next_token $h;
91
        my $s = TmplTokenizer::next_token $h;
92
        last unless defined $s;
92
        last unless defined $s;
93
        my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
93
        my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes);
94
        if ($kind eq TmplTokenType::TEXT) {
94
        if ($kind eq C4::TmplTokenType::TEXT) {
95
	    if ($t =~ /\S/s && $t !~ /<!/){
95
	    if ($t =~ /\S/s && $t !~ /<!/){
96
		remember( $s, $t );
96
		remember( $s, $t );
97
	    }
97
	    }
98
        } elsif ($kind eq TmplTokenType::TEXT_PARAMETRIZED) {
98
        } elsif ($kind eq C4::TmplTokenType::TEXT_PARAMETRIZED) {
99
	    if ($s->form =~ /\S/s && $s->form !~ /<!/){
99
	    if ($s->form =~ /\S/s && $s->form !~ /<!/){
100
		remember( $s, $s->form );
100
		remember( $s, $s->form );
101
	    }
101
	    }
102
        } elsif ($kind eq TmplTokenType::TAG && %$attr) {
102
        } elsif ($kind eq C4::TmplTokenType::TAG && %$attr) {
103
            # value [tag=input], meta
103
            # value [tag=input], meta
104
            my $tag = lc($1) if $t =~ /^<(\S+)/s;
104
            my $tag = lc($1) if $t =~ /^<(\S+)/s;
105
            for my $a ('alt', 'content', 'title', 'value','label') {
105
            for my $a ('alt', 'content', 'title', 'value','label') {
Lines 165-183 msgstr "" Link Here
165
EOF
165
EOF
166
    my $directory_re = quotemeta("$directory/");
166
    my $directory_re = quotemeta("$directory/");
167
    for my $t (string_list) {
167
    for my $t (string_list) {
168
	if ($text{$t}->[0]->type == TmplTokenType::TEXT_PARAMETRIZED) {
168
	if ($text{$t}->[0]->type == C4::TmplTokenType::TEXT_PARAMETRIZED) {
169
	    my($token, $n) = ($text{$t}->[0], 0);
169
	    my($token, $n) = ($text{$t}->[0], 0);
170
	    printf OUTPUT "#. For the first occurrence,\n"
170
	    printf OUTPUT "#. For the first occurrence,\n"
171
		    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
171
		    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
172
	    for my $param ($token->parameters_and_fields) {
172
	    for my $param ($token->parameters_and_fields) {
173
		$n += 1;
173
		$n += 1;
174
		my $type = $param->type;
174
		my $type = $param->type;
175
		my $subtype = ($type == TmplTokenType::TAG
175
		my $subtype = ($type == C4::TmplTokenType::TAG
176
			&& $param->string =~ /^<input\b/is?
176
			&& $param->string =~ /^<input\b/is?
177
				$param->attributes->{'type'}->[1]: undef);
177
				$param->attributes->{'type'}->[1]: undef);
178
		my $fmt = TmplTokenizer::_formalize( $param );
178
		my $fmt = TmplTokenizer::_formalize( $param );
179
		$fmt =~ s/^%/%$n\$/;
179
		$fmt =~ s/^%/%$n\$/;
180
		if ($type == TmplTokenType::DIRECTIVE) {
180
		if ($type == C4::TmplTokenType::DIRECTIVE) {
181
#		    $type = "Template::Toolkit Directive";
181
#		    $type = "Template::Toolkit Directive";
182
		    $type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR';
182
		    $type = $param->string =~ /\[%(.*?)%\]/is? $1: 'ERROR';
183
		    my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is?
183
		    my $name = $param->string =~ /\bname=(["']?)([^\s"']+)\1/is?
Lines 193-199 EOF Link Here
193
			    . (defined $value? " value=$value->[1]": '');
193
			    . (defined $value? " value=$value->[1]": '');
194
		}
194
		}
195
	    }
195
	    }
196
	} elsif ($text{$t}->[0]->type == TmplTokenType::TAG) {
196
	} elsif ($text{$t}->[0]->type == C4::TmplTokenType::TAG) {
197
	    my($token) = ($text{$t}->[0]);
197
	    my($token) = ($text{$t}->[0]);
198
	    printf OUTPUT "#. For the first occurrence,\n"
198
	    printf OUTPUT "#. For the first occurrence,\n"
199
		    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
199
		    if @{$text{$t}} > 1 && $token->parameters_and_fields > 0;
Lines 220-226 EOF Link Here
220
        $pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/;
220
        $pathname =~ s/^.*\/koha-tmpl\/(.*)$/$1/;
221
	    printf OUTPUT "#: %s:%d\n", $pathname, $token->line_number
221
	    printf OUTPUT "#: %s:%d\n", $pathname, $token->line_number
222
		    if defined $pathname && defined $token->line_number;
222
		    if defined $pathname && defined $token->line_number;
223
	    $cformat_p = 1 if $token->type == TmplTokenType::TEXT_PARAMETRIZED;
223
	    $cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED;
224
	}
224
	}
225
	printf OUTPUT "#, c-format\n" if $cformat_p;
225
	printf OUTPUT "#, c-format\n" if $cformat_p;
226
	printf OUTPUT "msgid %s\n", TmplTokenizer::quote_po
226
	printf OUTPUT "msgid %s\n", TmplTokenizer::quote_po
Lines 246-252 sub convert_translation_file () { Link Here
246
	$msgid =~ s/^SELECTED>//;
246
	$msgid =~ s/^SELECTED>//;
247
247
248
	# Create dummy token
248
	# Create dummy token
249
	my $token = TmplToken->new( $msgid, TmplTokenType::UNKNOWN, undef, undef );
249
	my $token = TmplToken->new( $msgid, C4::TmplTokenType::UNKNOWN, undef, undef );
250
	remember( $token, $msgid );
250
	remember( $token, $msgid );
251
	$msgstr =~ s/^(?:LIMIT;|LIMITED;)//g; # unneeded for tmpl_process3
251
	$msgstr =~ s/^(?:LIMIT;|LIMITED;)//g; # unneeded for tmpl_process3
252
	$translation{$msgid} = $msgstr unless $msgstr eq '*****';
252
	$translation{$msgid} = $msgstr unless $msgstr eq '*****';
(-)a/xt/tt_valid.t (-1 / +84 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|inc)$/;
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(
54
          "Files list: \n",
55
          join( "\n", map { $_->{name} . ': ' . join(', ', @{$_->{lines}})
56
              } @files_with_directive_in_tag )
57
       );
58
59
60
61
=head1 NAME
62
63
tt_valid.t
64
65
=head1 DESCRIPTION
66
67
This test validate Template Toolkit (TT) Koha files.
68
69
For the time being an unique validation is done: Test if TT files contain TT
70
directive within HTML tag. For example:
71
72
  <li[% IF
73
74
This kind of constuction MUST be avoided because it break Koha translation
75
process.
76
77
=head1 USAGE
78
79
From Koha root directory:
80
81
prove -v xt/tt_valid.t
82
83
=cut
84

Return to bug 6458