Bug 30735: Fix filtering by patron attribute with AV in overdues report
[koha.git] / xt / author / show-template-structure.pl
1 #!/usr/bin/perl
2
3 # Copyright (C) 2010 Galen Charlton
4
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
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>.
19
20 use Modern::Perl;
21
22 =head1 NAME
23
24 show-template-structure.pl
25
26 =head1 DESCRIPTION
27
28 This script displays the structure of loops and conditional statements
29 in an L<HTML::Template::Pro> template, and is an aid for debugging errors
30 reported by the xt/author/valid-templates.t test.  It also identifies
31 the following errors:
32
33 =over 2
34
35 =item * TMPL_IF/TMPL_UNLESS/TMPL_LOOP with no closing tag
36
37 =item * TMPL_ELSE with no initial TMPL_IF or TMPL_UNLESS
38
39 =item * extra closing tags
40
41 =item * HTML comment of the form <!-- TMPL_FOO ..., where TMPL_FOO is not a valid L<HTML::Template::Pro> tag
42
43 =back
44
45 =head2 USAGE
46
47 =over 4
48
49 xt/author/show-template-structure.pl path/to/template.tt
50
51 =back
52
53 Output is sent to STDOUT.
54
55 =cut
56
57 scalar(@ARGV) == 1 or die "Usage: $0 template-file\n";
58 my $file = $ARGV[0];
59 open my $fh, '<', $file or die "Failed to open template file $file: $!\n";
60
61 my %valid_tmpl_tags = (
62     tmpl_var     => 1,
63     tmpl_if      => 1,
64     tmpl_unless  => 1,
65     tmpl_else    => 1,
66     tmpl_elsif   => 1,
67     tmpl_include => 1,
68     tmpl_loop    => 1,
69 );
70
71 my %tmpl_structure_tags = (
72     tmpl_if     => 1,    # hash value controls whether to push/pop from the tag stack
73     tmpl_else   => 0,
74     tmpl_elsif  => 0,
75     tmpl_unless => 1,
76     tmpl_loop   => 1,
77 );
78
79 my $lineno = 0;
80
81 my @tag_stack = ();
82
83 sub emit {
84
85     # print message with indentation
86     my $level = scalar(@tag_stack);
87     print "  " x ( $level - 1 ), shift;
88 }
89
90 while (<$fh>) {
91     $lineno++;
92
93     # look for TMPL_IF, TMPL_ELSE, TMPL_UNLESS, and TMPL_LOOPs in HTML comments
94     # this makes the assumption that these control statements are never
95     # spread across multiple lines
96     foreach my $comment (/<!-- (.*?) -->/g) {
97
98         my $norm_comment = lc $comment;
99         $norm_comment =~ s/^\s+//;
100         next unless $norm_comment =~ m!^/{0,1}tmpl_!;
101         my ( $tmpl_tag_close, $tmpl_tag ) = $norm_comment =~ m!^(/{0,1})(tmpl_\S+)!;
102         $tmpl_tag_close = "" unless defined $tmpl_tag_close;
103
104         unless ( exists $valid_tmpl_tags{$tmpl_tag} ) {
105             print "ERROR (line $lineno): $tmpl_tag is not a valid HTML::Template::Pro tag\n";
106         }
107         next unless exists $tmpl_structure_tags{$tmpl_tag};    # only care about tags that affect loop or conditional structure
108         if ( $tmpl_structure_tags{$tmpl_tag} ) {
109
110             # we'll either be pushing or popping the tag stack
111             if ($tmpl_tag_close) {
112
113                 # popping tag
114                 emit "${tmpl_tag_close}${tmpl_tag} (line $lineno)";
115                 if ( scalar(@tag_stack) < 1 ) {
116                     print "\nERROR (line $lineno): $tmpl_tag causes tag stack underflow\n";
117                 } else {
118                     my ( $popped_tag, $target, $popped_lineno ) = @{ pop @tag_stack };
119                     if ( $tmpl_tag ne $popped_tag ) {
120                         print "\nERROR (line $lineno): got /$tmpl_tag but expected /$popped_tag to", 
121                               " match $popped_tag from line $popped_lineno\n";
122                     } else {
123                         print " # $target from $popped_lineno\n";
124                     }
125                 }
126             } elsif ( $tmpl_structure_tags{$tmpl_tag} ) {
127
128                 # pushable tag
129                 my ($target) = $comment =~ /(?:EXPR|NAME)\s*=\s*['"](.*?)['"]/i;
130                 push @tag_stack, [ $tmpl_tag, $target, $lineno ];
131                 emit "${tmpl_tag_close}${tmpl_tag} ($target, line $lineno)\n";
132             }
133         } else {
134
135             # we're either a tmpl_else or tmpl_elsif, so make sure that
136             # top of stack contains a tmpl_if
137             emit "${tmpl_tag_close}${tmpl_tag} (line $lineno)\n";
138             if ( scalar @tag_stack < 1 ) {
139                 print "ERROR: found $tmpl_tag, but tag stack is empty.\n";
140             } else {
141                 my ( $peeked_tag, $target, $peeked_lineno ) = @{ $tag_stack[0] };
142                 if ( $peeked_tag ne "tmpl_if" and $peeked_tag ne "tmpl_unless" ) {
143                     print "ERROR: found $tmpl_tag, but it does not appear to match a tmpl_if.  Top of stack is $peeked_tag.\n";
144                 }
145             }
146         }
147     }
148 }
149
150 close $fh;
151
152 # anything left in the stack?
153 if (scalar @tag_stack > 0) {
154     print "ERROR: tag stack is not empty - the following template structures have not been closed:\n";
155     my $i = 0;
156     while (my $entry = pop @tag_stack) {
157         $i++;
158         my ( $popped_tag, $target, $popped_lineno ) = @{ $entry };
159         print "$i: $popped_tag $target (line $popped_lineno)\n";
160     }
161 }
162
163 exit 0;
164
165 =head1 AUTHOR
166
167 Koha Development Team <http://koha-community.org/>
168
169 Galen Charlton <gmcharlt@gmail.com>
170
171 =cut