Attachment #37824 for bug #13941

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




# 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::More tests => 3;
use Test::More tests => 2;
use File::Find;
use Cwd;
use C4::TTParser;

}
close $dh;

my $checkers = [
    {
        description => 'TT syntax: not using TT directive within HTML tag',
        check => sub {
            my ($self, $name, $token) = @_;
        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 @{$self->{errors}->{$name}}, $token->{_lc} if $attr->{'[%'} or $attr->{'[%-'};
        },
        errors => {},
    },
    {
        description => '<body> tag with id and class attributes',
        check => sub {
            my ($self, $name, $token) = @_;
            return if $name =~ /bodytag\.inc/;
            my $tag = $token->{_string};
            push @{$self->{errors}->{$name}}, $token->{_lc}
              if $tag =~ /^<body/ &&
                 ($tag !~ /id=".+"/ || $tag !~ /class=".+"/);
        },
        errors => {},
    },
];
find( sub {
    my $dir = getcwd();
    return if $dir =~ /blib/;
    return unless /\.(tt|inc)$/;
    ($dir) = $dir =~ /koha-tmpl\/(.*)$/;
    my $name = $_;
    my $parser = C4::TTParser->new;
    $parser->build_tokens( $name );
    while ( my $token = $parser->next_token ) {
        my $attr = $token->{_attr};
        next unless $attr;
        for my $checker (@$checkers) {
            $checker->{check}->($checker, "$dir/$name", $token);
        }
    }
  }, @themes
);

for my $check (@$checkers) {
  my @files = sort keys %{$check->{errors}};
  ok( !@files, $check->{description} )
      or diag(
            "Files list: \n",
            join( "\n", map { "$_: " . join(', ', @{$check->{errors}->{$_}})
                } @files )
         );
}
       );

my $testtoken = 0;
my $ttparser = C4::TTParser->new();


This test validate Template Toolkit (TT) Koha 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 constuction MUST be avoided because it break Koha translation
process.

[2] Test tag <body> tags have both attibutes 'id' and 'class'

=head1 USAGE

From Koha root directory:
- 

Return to bug 13941

Lines 17-25 Link Here

(-)a/xt/tt_valid.t (-32 / +55 lines)
17	# You should have received a copy of the GNU General Public License	17	# You should have received a copy of the GNU General Public License
18	# along with Koha; if not, see <http://www.gnu.org/licenses>.	18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
19		19
20	use warnings;	20	use Modern::Perl;
21	use strict;	21	use Test::More tests => 3;
22	use Test::More tests => 2;
23	use File::Find;	22	use File::Find;
24	use Cwd;	23	use Cwd;
25	use C4::TTParser;	24	use C4::TTParser;
Lines 42-76 for my $theme ( grep { not /^\.\|lib\|js/ } readdir($dh) ) { Link Here
42	}	41	}
43	close $dh;	42	close $dh;
44		43
45	my @files_with_directive_in_tag = do {	44	my $checkers = [
46	my @files;	45	{
47	find( sub {	46	description => 'TT syntax: not using TT directive within HTML tag',
48	my $dir = getcwd();	47	check => sub {
49	return if $dir =~ /blib/;	48	my ($self, $name, $token) = @_;
50	return unless /\.(tt\|inc)$/;
51	my $name = $_;
52	my $parser = C4::TTParser->new;
53	$parser->build_tokens( $name );
54	my @lines;
55	while ( my $token = $parser->next_token ) {
56	my $attr = $token->{_attr};	49	my $attr = $token->{_attr};
57	next unless $attr;	50	next unless $attr;
58	push @lines, $token->{_lc} if $attr->{'[%'} or $attr->{'[%-'};	51	push @{$self->{errors}->{$name}}, $token->{_lc} if $attr->{'[%'} or $attr->{'[%-'};
		52	},
		53	errors => {},
		54	},
		55	{
		56	description => '<body> tag with id and class attributes',
		57	check => sub {
		58	my ($self, $name, $token) = @_;
		59	return if $name =~ /bodytag\.inc/;
		60	my $tag = $token->{_string};
		61	push @{$self->{errors}->{$name}}, $token->{_lc}
		62	if $tag =~ /^<body/ &&
		63	($tag !~ /id=".+"/ \|\| $tag !~ /class=".+"/);
		64	},
		65	errors => {},
		66	},
		67	];
		68	find( sub {
		69	my $dir = getcwd();
		70	return if $dir =~ /blib/;
		71	return unless /\.(tt\|inc)$/;
		72	($dir) = $dir =~ /koha-tmpl\/(.*)$/;
		73	my $name = $_;
		74	my $parser = C4::TTParser->new;
		75	$parser->build_tokens( $name );
		76	while ( my $token = $parser->next_token ) {
		77	my $attr = $token->{_attr};
		78	next unless $attr;
		79	for my $checker (@$checkers) {
		80	$checker->{check}->($checker, "$dir/$name", $token);
59	}	81	}
60	($dir) = $dir =~ /koha-tmpl\/(.*)$/;	82	}
61	push @files, { name => "$dir/$name", lines => \@lines } if @lines;	83	}, @themes
62	}, @themes	84	);
63	);	85
64	@files;	86	for my $check (@$checkers) {
65	};	87	my @files = sort keys %{$check->{errors}};
66		88	ok( !@files, $check->{description} )
67		89	or diag(
68	ok( !@files_with_directive_in_tag, "TT syntax: not using TT directive within HTML tag" )	90	"Files list: \n",
69	or diag(	91	join( "\n", map { "$_: " . join(', ', @{$check->{errors}->{$_}})
70	"Files list: \n",	92	} @files )
71	join( "\n", map { $_->{name} . ': ' . join(', ', @{$_->{lines}})	93	);
72	} @files_with_directive_in_tag )	94	}
73	);
74		95
75	my $testtoken = 0;	96	my $testtoken = 0;
76	my $ttparser = C4::TTParser->new();	97	my $ttparser = C4::TTParser->new();
Lines 87-100 tt_valid.t Link Here
87		108
88	This test validate Template Toolkit (TT) Koha files.	109	This test validate Template Toolkit (TT) Koha files.
89		110
90	For the time being an unique validation is done: Test if TT files contain TT	111	For the time being, two validations are done:
91	directive within HTML tag. For example:	112
		113	[1] Test if TT files contain TT directive within HTML tag. For example:
92		114
93	<li[% IF	115	<li[% IF
94		116
95	This kind of constuction MUST be avoided because it break Koha translation	117	This kind of constuction MUST be avoided because it break Koha translation
96	process.	118	process.
97		119
		120	[2] Test tag <body> tags have both attibutes 'id' and 'class'
		121
98	=head1 USAGE	122	=head1 USAGE
99		123
100	From Koha root directory:	124	From Koha root directory:
101	-