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