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

(-)a/misc/translator/tmpl_process3.pl (-1 / +5 lines)
Lines 64-69 sub text_replace_tag { Link Here
64
    my $translated_p = 0;
64
    my $translated_p = 0;
65
    for my $a ( 'alt', 'content', 'title', 'value', 'label', 'placeholder', 'aria-label' ) {
65
    for my $a ( 'alt', 'content', 'title', 'value', 'label', 'placeholder', 'aria-label' ) {
66
        if ( $attr->{$a} ) {
66
        if ( $attr->{$a} ) {
67
68
            # xt/tt_valid.t must be adjusted if the following conditions are modified
67
            next if $a eq 'label'   && $tag ne 'optgroup';
69
            next if $a eq 'label'   && $tag ne 'optgroup';
68
            next if $a eq 'content' && $tag ne 'meta';
70
            next if $a eq 'content' && $tag ne 'meta';
69
            next
71
            next
Lines 140-146 sub text_replace { Link Here
140
                    $kind == C4::TmplTokenType::TAG && %$attr ? text_replace_tag( $t, $attr ) : $t;
142
                    $kind == C4::TmplTokenType::TAG && %$attr ? text_replace_tag( $t, $attr ) : $t;
141
                }
143
                }
142
            );
144
            );
143
        } elsif ( $kind eq C4::TmplTokenType::TAG && %$attr ) {
145
        } elsif ( $kind eq C4::TmplTokenType::TAG && $attr && %$attr ) {
144
            print $output text_replace_tag( $t, $attr );
146
            print $output text_replace_tag( $t, $attr );
145
        } elsif ( $s->has_js_data ) {
147
        } elsif ( $s->has_js_data ) {
146
            for my $t ( @{ $s->js_data } ) {
148
            for my $t ( @{ $s->js_data } ) {
Lines 158-163 sub text_replace { Link Here
158
            # Quick fix to bug 4472
160
            # Quick fix to bug 4472
159
            $t = "<!DOCTYPE stylesheet [" if $t =~ /DOCTYPE stylesheet/;
161
            $t = "<!DOCTYPE stylesheet [" if $t =~ /DOCTYPE stylesheet/;
160
            print $output $t;
162
            print $output $t;
163
        } elsif ( !$attr ) {
164
            warn "Error: file contains incorrect TT structures";
161
        }
165
        }
162
    }
166
    }
163
}
167
}
(-)a/t/db_dependent/misc/translator/tt/en/sample-not-working-2.tt (+3 lines)
Line 0 Link Here
1
<p>The following line will be translated but broken:</p>
2
<span [% IF required %]required="required"[% END %] title="Don't use TT directives if another attribute is translatable"></span>
3
<p>Will be translated</p>
(-)a/t/db_dependent/misc/translator/xgettext.pl.t (-6 / +32 lines)
Lines 2-17 Link Here
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
4
5
use File::Slurp;
5
use File::Slurp qw(read_file write_file);
6
use File::Temp qw(tempdir);
6
use File::Temp  qw(tempdir);
7
use FindBin    qw($Bin);
7
use FindBin     qw($Bin);
8
use Locale::PO;
8
use Locale::PO;
9
use Test::More tests => 21;
9
use Test::More tests => 25;
10
use Test::NoWarnings;
10
use Test::NoWarnings;
11
11
12
my $tempdir = tempdir( CLEANUP => 1 );
12
my $tempdir = tempdir( CLEANUP => 1 );
13
13
14
write_file( "$tempdir/files", "$Bin/sample.tt" );
14
write_file( "$tempdir/files", "$Bin/tt/en/sample.tt" );
15
15
16
my $xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files";
16
my $xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files";
17
17
Lines 56-65 for ( my $i = 0 ; $i < @expected ; $i++ ) { Link Here
56
56
57
is( scalar @$pot, 1 + scalar(@expected) );
57
is( scalar @$pot, 1 + scalar(@expected) );
58
58
59
write_file( "$tempdir/files", "$Bin/sample-not-working.tt" );
59
write_file( "$tempdir/files", "$Bin/tt/en/sample-not-working.tt" );
60
60
61
$xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files 2>/dev/null";
61
$xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files 2>/dev/null";
62
62
63
system($xgettext_cmd);
63
system($xgettext_cmd);
64
$pot = Locale::PO->load_file_asarray("$tempdir/Koha.pot");
64
$pot = Locale::PO->load_file_asarray("$tempdir/Koha.pot");
65
is( scalar @$pot, 0, 'xgettext.pl failed to generate a POT file because of incorrect structure' );
65
is( scalar @$pot, 0, 'xgettext.pl failed to generate a POT file because of incorrect structure' );
66
67
write_file( "$tempdir/files", "$Bin/tt/en/sample-not-working-2.tt" );
68
69
$xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files 2>/dev/null";
70
71
system($xgettext_cmd);
72
$pot = Locale::PO->load_file_asarray("$tempdir/Koha.pot");
73
is( scalar @$pot, 4, 'xgettext.pl generated a POT file' );
74
75
my $pot_content = read_file("$tempdir/Koha.pot");
76
$pot_content =~
77
    s|msgid "Don't use TT directives if another attribute is translatable"\nmsgstr ""|msgid "Don't use TT directives if another attribute is translatable"\nmsgstr "Ne pas utiliser TT si un autre attribut est traduisible"|gms;
78
$pot_content =~ s|msgid "Will be translated"\nmsgstr ""|msgid "Will be translated"\nmsgstr "Ceci sera traduit"|gms;
79
write_file( "$tempdir/Koha.pot", $pot_content );
80
81
my $tempdir_fr = tempdir( CLEANUP => 1 );
82
my $install_cmd =
83
    "$Bin/../../../../misc/translator/tmpl_process3.pl -q install -i $Bin -o $tempdir_fr  -s $tempdir/Koha.pot -r -n marc21 -n unimarc";
84
system($install_cmd);
85
86
my $content = read_file("$tempdir_fr/tt/en/sample-not-working-2.tt");
87
like( $content, qr{Ne pas utiliser TT si un autre attribut est traduisible} );
88
like( $content, qr{Ceci sera traduit} );
89
90
# So far so good, but #FIXME:
91
like( $content, qr{<span %\]="%\]" %\]required="required" \[%="\[%"} );
(-)a/xt/author/tt_valid.t (-1 / +115 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
use Test::NoWarnings;
20
use Test::More;
21
use C4::TTParser;
22
use Array::Utils qw( array_minus );
23
24
use Koha::Devel::Files;
25
my $dev_files  = Koha::Devel::Files->new( { context => 'tidy' } );
26
my @tt_files   = $dev_files->ls_tt_files;
27
my @exclusions = qw(
28
    t/db_dependent/misc/translator/tt/en/sample-not-working.tt
29
    t/db_dependent/misc/translator/tt/en/sample-not-working-2.tt
30
    t/db_dependent/misc/translator/tt/en/sample.tt
31
);
32
@tt_files = array_minus @tt_files, @exclusions;
33
34
plan tests => scalar(@tt_files) + 1;
35
36
my @translatable_attributes = qw(alt content title value label placeholder aria-label);
37
38
my $checkers = [
39
    {
40
        description => 'TT syntax: incorrectly uses of TT tags in HTML tags',
41
        check       => sub {
42
            my ( $self, $name, $token ) = @_;
43
            my $attr = $token->{_attr};
44
            next unless $attr;
45
            my @errors;
46
            if ( $attr->{'[%'} or $attr->{'[%-'} ) {
47
                for my $attribute (@translatable_attributes) {
48
49
                    # The following tests come from tmpl_process3.pl sub text_replace_tag
50
                    next if $attribute eq 'label'   && $token->{_string} !~ /^<optgroup/;
51
                    next if $attribute eq 'content' && $token->{_string} !~ /^meta/;
52
                    next
53
                        if $attribute eq 'value'
54
                        && ( $token->{_string} !~ /^input/ );    # || additional check on checkbox|hidden|radio needed?
55
                    if ( exists $attr->{$attribute} ) {
56
                        if ( $attr->{$attribute}->[2] =~ m{$attribute=[^[]} ) {
57
                            push @errors, $token->{_lc};
58
                        }
59
                    } elsif ( exists $attr->{"%]$attribute"} ) {
60
                        push @errors, $token->{_lc};
61
                    }
62
                }
63
            }
64
            return @errors;
65
        },
66
    },
67
    {
68
        description => '<body> tag with id and class attributes',
69
        check       => sub {
70
            my ( $self, $name, $token ) = @_;
71
            return if $name =~ /bodytag\.inc/;
72
            my $tag = $token->{_string};
73
            return ( $tag =~ /^<body/ && ( $tag !~ /id=".+"/ || $tag !~ /class=".+"/ ) )
74
                ? ( $token->{_lc} )
75
                : ();
76
        },
77
    },
78
];
79
80
for my $filepath (@tt_files) {
81
    my $parser = C4::TTParser->new;
82
    $parser->build_tokens($filepath);
83
    my @errors;
84
    while ( my $token = $parser->next_token ) {
85
        my $attr = $token->{_attr};
86
        next unless $attr;
87
88
        for my $checker (@$checkers) {
89
            my @e = $checker->{check}->( $checker, $filepath, $token );
90
            push @errors, @e if @e;
91
        }
92
    }
93
    is( scalar(@errors), 0 ) or diag( "$filepath: " . join( ', ', @errors ) );
94
}
95
96
=head1 NAME
97
98
xt/author/tt_valid.t
99
100
=head1 DESCRIPTION
101
102
This test validates .tt files.
103
104
For the time being, two validations are done:
105
106
[1] Test if TT files contain TT directive within HTML tag. For example:
107
108
  <li[% IF
109
110
This kind of construction MUST be avoided because it breaks Koha translation
111
process.
112
113
[2] Test tag <body> tags have both attibutes 'id' and 'class'
114
115
=cut

Return to bug 41216