Bug 41216: Restore tt_valid.t

HTML1 is gone. Almost...
The previous rule said that we could not have TT tags within HTML tags
because it caused problems with the translation.
It was incorrect.
Bug 38720 removed that rule, and stated that the only problematic use
was a IF with ">".
It was also incorrect.

This one bug states that we cannot have TT tags to construct HTML tags
IF one of the attribute contains a translatable string.
The list of translatable attributes are listed in tmpl_process3.pl.

This patch restores xt/tt_valid.t (and move it to xt/author) and adjust
slightly the test to take into account this last statement.

Test plan:
0. Apply only this first patch
1. Run xt/author/tt_valid.t
=> It fails on mana-subscription-search-result.inc
2. Update po for your prefered language
=> The string "This resource has been reported more than" is not in the
po files

3. Apply the second patch, repeat 1 and 2
=> It still fails: adding a space between the TT tag and the attribute is not enough here
=> The string is picked now! but... install the template and open the
translated version =>

4. Apply the third patch, repeat 1 and 2
=> The tests pass!
=> The string is still picked, install => The template looks good!
Now if you are familiar with Mana you can try to see the translated
string on the UI

Signed-off-by: Julian Maurice <julian.maurice@biblibre.com>
Signed-off-by: Victor Grousset/tuxayo <victor@tuxayo.net>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>

misc/translator/tmpl_process3.pl

@@ -64,6 +64,8 @@ sub text_replace_tag {
     my $translated_p = 0;
     for my $a ( 'alt', 'content', 'title', 'value', 'label', 'placeholder', 'aria-label' ) {
         if ( $attr->{$a} ) {
+
+            # xt/tt_valid.t must be adjusted if the following conditions are modified
             next if $a eq 'label'   && $tag ne 'optgroup';
             next if $a eq 'content' && $tag ne 'meta';
             next
@@ -140,7 +142,7 @@ sub text_replace {
                     $kind == C4::TmplTokenType::TAG && %$attr ? text_replace_tag( $t, $attr ) : $t;
                 }
             );
-        } elsif ( $kind eq C4::TmplTokenType::TAG && %$attr ) {
+        } elsif ( $kind eq C4::TmplTokenType::TAG && $attr && %$attr ) {
             print $output text_replace_tag( $t, $attr );
         } elsif ( $s->has_js_data ) {
             for my $t ( @{ $s->js_data } ) {
@@ -158,6 +160,8 @@ sub text_replace {
             # Quick fix to bug 4472
             $t = "<!DOCTYPE stylesheet [" if $t =~ /DOCTYPE stylesheet/;
             print $output $t;
+        } elsif ( !$attr ) {
+            warn "Error: file contains incorrect TT structures";
         }
     }
 }

t/db_dependent/misc/translator/tt/en/sample-not-working-2.tt

@@ -0,0 +1,3 @@
+<p>The following line will be translated but broken:</p>
+<span [% IF required %]required="required"[% END %] title="Don't use TT directives if another attribute is translatable"></span>
+<p>Will be translated</p>

t/db_dependent/misc/translator/xgettext.pl.t

@@ -2,16 +2,16 @@
 
 use Modern::Perl;
 
-use File::Slurp;
-use File::Temp qw(tempdir);
-use FindBin    qw($Bin);
+use File::Slurp qw(read_file write_file);
+use File::Temp  qw(tempdir);
+use FindBin     qw($Bin);
 use Locale::PO;
-use Test::More tests => 21;
+use Test::More tests => 25;
 use Test::NoWarnings;
 
 my $tempdir = tempdir( CLEANUP => 1 );
 
-write_file( "$tempdir/files", "$Bin/sample.tt" );
+write_file( "$tempdir/files", "$Bin/tt/en/sample.tt" );
 
 my $xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files";
 
@@ -56,10 +56,36 @@ for ( my $i = 0 ; $i < @expected ; $i++ ) {
 
 is( scalar @$pot, 1 + scalar(@expected) );
 
-write_file( "$tempdir/files", "$Bin/sample-not-working.tt" );
+write_file( "$tempdir/files", "$Bin/tt/en/sample-not-working.tt" );
 
 $xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files 2>/dev/null";
 
 system($xgettext_cmd);
 $pot = Locale::PO->load_file_asarray("$tempdir/Koha.pot");
 is( scalar @$pot, 0, 'xgettext.pl failed to generate a POT file because of incorrect structure' );
+
+write_file( "$tempdir/files", "$Bin/tt/en/sample-not-working-2.tt" );
+
+$xgettext_cmd = "$Bin/../../../../misc/translator/xgettext.pl -o $tempdir/Koha.pot -f $tempdir/files 2>/dev/null";
+
+system($xgettext_cmd);
+$pot = Locale::PO->load_file_asarray("$tempdir/Koha.pot");
+is( scalar @$pot, 4, 'xgettext.pl generated a POT file' );
+
+my $pot_content = read_file("$tempdir/Koha.pot");
+$pot_content =~
+    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;
+$pot_content =~ s|msgid "Will be translated"\nmsgstr ""|msgid "Will be translated"\nmsgstr "Ceci sera traduit"|gms;
+write_file( "$tempdir/Koha.pot", $pot_content );
+
+my $tempdir_fr = tempdir( CLEANUP => 1 );
+my $install_cmd =
+    "$Bin/../../../../misc/translator/tmpl_process3.pl -q install -i $Bin -o $tempdir_fr  -s $tempdir/Koha.pot -r -n marc21 -n unimarc";
+system($install_cmd);
+
+my $content = read_file("$tempdir_fr/tt/en/sample-not-working-2.tt");
+like( $content, qr{Ne pas utiliser TT si un autre attribut est traduisible} );
+like( $content, qr{Ceci sera traduit} );
+
+# So far so good, but #FIXME:
+like( $content, qr{<span %\]="%\]" %\]required="required" \[%="\[%"} );

xt/author/tt_valid.t

@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+
+# 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 3 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, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+use Test::NoWarnings;
+use Test::More;
+use C4::TTParser;
+use Array::Utils qw( array_minus );
+
+use Koha::Devel::Files;
+my $dev_files  = Koha::Devel::Files->new( { context => 'tidy' } );
+my @tt_files   = $dev_files->ls_tt_files;
+my @exclusions = qw(
+    t/db_dependent/misc/translator/tt/en/sample-not-working.tt
+    t/db_dependent/misc/translator/tt/en/sample-not-working-2.tt
+    t/db_dependent/misc/translator/tt/en/sample.tt
+);
+@tt_files = array_minus @tt_files, @exclusions;
+
+plan tests => scalar(@tt_files) + 1;
+
+my @translatable_attributes = qw(alt content title value label placeholder aria-label);
+
+my $checkers = [
+    {
+        description => 'TT syntax: incorrectly uses of TT tags in HTML tags',
+        check       => sub {
+            my ( $self, $name, $token ) = @_;
+            my $attr = $token->{_attr};
+            next unless $attr;
+            my @errors;
+            if ( $attr->{'[%'} or $attr->{'[%-'} ) {
+                for my $attribute (@translatable_attributes) {
+
+                    # The following tests come from tmpl_process3.pl sub text_replace_tag
+                    next if $attribute eq 'label'   && $token->{_string} !~ /^<optgroup/;
+                    next if $attribute eq 'content' && $token->{_string} !~ /^meta/;
+                    next
+                        if $attribute eq 'value'
+                        && ( $token->{_string} !~ /^input/ );    # || additional check on checkbox|hidden|radio needed?
+                    if ( exists $attr->{$attribute} ) {
+                        if ( $attr->{$attribute}->[2] =~ m{$attribute=[^[]} ) {
+                            push @errors, $token->{_lc};
+                        }
+                    } elsif ( exists $attr->{"%]$attribute"} ) {
+                        push @errors, $token->{_lc};
+                    }
+                }
+            }
+            return @errors;
+        },
+    },
+    {
+        description => '<body> tag with id and class attributes',
+        check       => sub {
+            my ( $self, $name, $token ) = @_;
+            return if $name =~ /bodytag\.inc/;
+            my $tag = $token->{_string};
+            return ( $tag =~ /^<body/ && ( $tag !~ /id=".+"/ || $tag !~ /class=".+"/ ) )
+                ? ( $token->{_lc} )
+                : ();
+        },
+    },
+];
+
+for my $filepath (@tt_files) {
+    my $parser = C4::TTParser->new;
+    $parser->build_tokens($filepath);
+    my @errors;
+    while ( my $token = $parser->next_token ) {
+        my $attr = $token->{_attr};
+        next unless $attr;
+
+        for my $checker (@$checkers) {
+            my @e = $checker->{check}->( $checker, $filepath, $token );
+            push @errors, @e if @e;
+        }
+    }
+    is( scalar(@errors), 0 ) or diag( "$filepath: " . join( ', ', @errors ) );
+}
+
+=head1 NAME
+
+xt/author/tt_valid.t
+
+=head1 DESCRIPTION
+
+This test validates .tt files.
+
+For the time being, two validations are done:
+
+[1] Test if TT files contain TT directive within HTML tag. For example:
+
+  <li[% IF
+
+This kind of construction MUST be avoided because it breaks Koha translation
+process.
+
+[2] Test tag <body> tags have both attibutes 'id' and 'class'
+
+=cut