root/htdiff/trunk/htdiff

Revision 605 (checked in by miyagawa, 17 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1 #!/usr/local/bin/perl
2 use strict;
3 use vars qw($VERSION);
4 $VERSION = 0.01;
5
6 =head1 NAME
7
8 htdiff - find difference between structures of two HTML templates
9
10 =head1 SYNOPSIS
11
12   htdiff file1 file2
13
14 =head1 DESCRIPTION
15
16 C<htdiff> is a command line tool to find structured difference between
17 two HTML::Template templates. It may be quite useful for checking
18 before your co-working designer fixes up your bare-bone template into
19 production ready design. What you should check is just run C<htdiff>
20 against your template and the final template to see any typos or
21 losing in migration are there.
22
23 =head1 PREREQUISTICS
24
25 =over 4
26
27 =item *
28
29 HTML::Template 2.5
30
31 =item *
32
33 Text::Diff 0.32
34
35 =back
36
37 =head1 AUTHOR
38
39 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
40
41 This library is free software; you can redistribute it and/or modify
42 it under the same terms as Perl itself.
43
44 =head1 SEE ALSO
45
46 L<HTML::Template>, L<Text::Diff>
47
48 =cut
49
50 package HtdiffApp;
51 use IO::File;
52 use HTML::Template;
53 use Text::Diff;
54
55 sub new {
56     my($class, @files) = @_;
57     bless { files => \@files }, $class;
58 }
59
60 sub run {
61     my $self = shift;
62     my @tokens = map $self->make_tokens($_), @{$self->{files}};
63     $self->check_directives(@tokens);
64 }
65
66 sub make_tokens {
67     my($self, $file) = @_;
68     my $text = $self->slurp($file);
69     return $self->parse($text);
70 }
71
72 sub slurp {
73     my($self, $file) = @_;
74     my $io   = IO::File->new($file) or die "$file: $!";
75     local $/;
76     return <$io>;
77 }
78
79 sub parse {
80     my($self, $text) = @_;
81     my @chunks = split /(?=<)/, $text;
82
83     my $re = $self->regex;
84     my $doc;
85     for my $chunk (@chunks) {
86         if ($chunk =~ /$re/g) {
87             # strip $post
88             my $match = $&;
89             $match =~ s/\Q$9\E$// if defined $9;
90             $doc .= "$match\n";
91         }
92     }
93     return $doc;
94 }
95
96 sub check_directives {
97     my($self, @tokens) = @_;
98     my $diff = diff \$tokens[0], \$tokens[1];
99     print $diff if $diff;
100 }
101
102 sub regex {
103     # cut-n-pasted from HTML::Template
104     return qr/^<
105                     (?:!--\s*)?
106                     (
107                       \/?[Tt][Mm][Pp][Ll]_
108                       (?:
109                          (?:[Vv][Aa][Rr])
110                          |
111                          (?:[Ll][Oo][Oo][Pp])
112                          |
113                          (?:[Ii][Ff])
114                          |
115                          (?:[Ee][Ll][Ss][Ee])
116                          |
117                          (?:[Uu][Nn][Ll][Ee][Ss][Ss])
118                          |
119                          (?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee])
120                       )
121                     ) # $1 => $which - start of the tag
122
123                     \s*
124
125                     # ESCAPE attribute
126                     (?:
127                       [Ee][Ss][Cc][Aa][Pp][Ee]
128                       \s*=\s*
129                       (?:
130                          ( 0 | (?:"0") | (?:'0') ) # $2 => ESCAPE off
131                          |
132                          ( 1 | (?:"1") | (?:'1') |
133                            (?:[Hh][Tt][Mm][Ll]) |
134                            (?:"[Hh][Tt][Mm][Ll]") |
135                            (?:'[Hh][Tt][Mm][Ll]') |
136                            (?:[Uu][Rr][Ll]) |
137                            (?:"[Uu][Rr][Ll]") |
138                            (?:'[Uu][Rr][Ll]') |
139                          )                         # $3 => ESCAPE on
140                        )
141                     )* # allow multiple ESCAPEs
142
143                     \s*
144
145                     # NAME attribute
146                     (?:
147                       (?:
148                         [Nn][Aa][Mm][Ee]
149                         \s*=\s*
150                       )?
151                       (?:
152                         "([^">]*)" # $4 => double-quoted NAME value "
153                         |
154                         '([^'>]*)' # $5 => single-quoted NAME value
155                         |
156                         ([^\s=>]*)  # $6 => unquoted NAME value
157                       )
158                     )?
159                     \s*
160
161                     # ESCAPE attribute
162                     (?:
163                       [Ee][Ss][Cc][Aa][Pp][Ee]
164                       \s*=\s*
165                       (?:
166                          ( 0 | (?:"0") | (?:'0') ) # $7 => ESCAPE off
167                          |
168                          ( 1 | (?:"1") | (?:'1') |
169                            (?:[Hh][Tt][Mm][Ll]) |
170                            (?:"[Hh][Tt][Mm][Ll]") |
171                            (?:'[Hh][Tt][Mm][Ll]') |
172                            (?:[Uu][Rr][Ll]) |
173                            (?:"[Uu][Rr][Ll]") |
174                            (?:'[Uu][Rr][Ll]') |
175                          )                         # $8 => ESCAPE on
176                        )
177                     )* # allow multiple ESCAPEs
178
179                     \s*
180
181                     (?:--)?>
182                     (.*) # $9 => $post - text that comes after the tag
183               $/sx;
184 }
185
186 package main;
187
188 sub usage {
189     (my $me = $0) =~ s@.*/@@;
190     warn "Usage: $me file1 file2\n";
191 }
192
193 @ARGV == 2 or usage(), exit;
194
195 my $app = HtdiffApp->new(@ARGV);
196 $app->run;
Note: See TracBrowser for help on using the browser.