root/htdiff/trunk/htdiff

Revision 611 (checked in by miyagawa, 19 years ago)

--dump option

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