root/trunk/YamlReference/yeast2html

Revision 9, 15.6 KB (checked in by oren, 7 months ago)

May 11, 2008 spec
Line 
1#!/usr/bin/perl -w
2
3# Modules.
4use strict;
5use English;
6use Pod::Usage;
7use Getopt::Long;
8use IO::File;
9
10# YEAST byte codes.
11my $code2class = {
12    U   => { code => 'U', type => 'bom',   title => "Byte order mark" },
13    T   => { code => 'T', type => 'text',  title => "Content text" },
14    t   => { code => 't', type => 'text',  title => "Non-content text" },
15    B   => { code => 'B', type => 'line',  title => "Content line break" },
16    b   => { code => 'b', type => 'line',  title => "Non-content line break" },
17    L   => { code => 'L', type => 'line',  title => "Line break normalized to line feed" },
18    l   => { code => 'l', type => 'line',  title => "Line break folded to space" },
19    I   => { code => 'I', type => 'text',  title => "Indicator character" },
20    w   => { code => 'w', type => 'text',  title => "Non-content white space" },
21    i   => { code => 'i', type => 'text',  title => "Indentation white space" },
22    K   => { code => 'K', type => 'text',  title => "Document start marker" },
23    k   => { code => 'k', type => 'text',  title => "Document end marker" },
24    E   => { code => 'E', type => 'begin', title => "Escape sequence" },
25    e   => { code => 'e', type => 'end',   title => "Escape sequence" },
26    C   => { code => 'C', type => 'begin', title => "Comment" },
27    c   => { code => 'c', type => 'end',   title => "Comment" },
28    D   => { code => 'D', type => 'begin', title => "Directive" },
29    d   => { code => 'd', type => 'end',   title => "Directive" },
30    G   => { code => 'G', type => 'begin', title => "Tag" },
31    g   => { code => 'g', type => 'end',   title => "Tag" },
32    H   => { code => 'H', type => 'begin', title => "Handle" },
33    h   => { code => 'h', type => 'end',   title => "Handle" },
34    A   => { code => 'A', type => 'begin', title => "Anchor" },
35    a   => { code => 'a', type => 'end',   title => "Anchor" },
36    P   => { code => 'P', type => 'begin', title => "Properties" },
37    p   => { code => 'p', type => 'end',   title => "Properties" },
38    R   => { code => 'R', type => 'begin', title => "Alias" },
39    r   => { code => 'r', type => 'end',   title => "Alias" },
40    S   => { code => 'S', type => 'begin', title => "Scalar" },
41    s   => { code => 's', type => 'end',   title => "Scalar" },
42    Q   => { code => 'Q', type => 'begin', title => "Sequence" },
43    q   => { code => 'q', type => 'end',   title => "Sequence" },
44    M   => { code => 'M', type => 'begin', title => "Mapping" },
45    m   => { code => 'm', type => 'end',   title => "Mapping" },
46    N   => { code => 'N', type => 'begin', title => "Node" },
47    n   => { code => 'n', type => 'end',   title => "Node" },
48    X   => { code => 'X', type => 'begin', title => "Key:value pair" },
49    x   => { code => 'x', type => 'end',   title => "Key:value pair" },
50    O   => { code => 'O', type => 'begin', title => "Document" },
51    o   => { code => 'o', type => 'end',   title => "Document" },
52    Y   => { code => 'Y', type => 'begin', title => "Stream" },
53    y   => { code => 'y', type => 'end',   title => "Stream" },
54    '!' => { code => '!', type => 'error', title => "Error" },
55    '-' => { code => '-', type => 'text',  title => "Unparsed" },
56    '~' => { code => '~', type => 'text',  title => "Empty" }
57};
58
59# Command line arguments.
60my $output_file = '';
61my $css_file = '';
62my $link_css = '';
63my $output = *STDOUT{IO};
64my $tree_title = 'Syntax Tree';
65my $text_title = 'YAML Text';
66
67# Loaded byte codes.
68my $data = [];
69
70# Tree printing.
71my $next_id;
72
73# Main program.
74parse_argv();
75load_input();
76print_output();
77
78# Functions.
79
80sub parse_argv {
81    my $do_help = "";
82    my $do_man = "";
83    GetOptions("help|h" => \$do_help,
84               "man|m" => \$do_man,
85               "output|o=s" => \$output_file,
86               "css|c=s" => \$css_file,
87               "tree-title|r=s" => \$tree_title,
88               "text-title|x=s" => \$text_title,
89               "link-css|l" => \$link_css)
90        || pod2usage(-verbose => 0);
91    pod2usage(-verbose => 1) if $do_help;
92    pod2usage(-verbose => 2) if $do_man;
93    die("Only one input file, please\n") if @ARGV > 1;
94    die("No CSS file specified to link to\n") if $link_css && !$css_file;
95    if ($output_file) {
96        open ($output, ">$output_file") || die("open(>$output_file): $!");
97    }
98}
99
100sub load_input {
101    my $stack = [];
102    my $has_content = [];
103    my $num = 0;
104    while (my $line = <>) {
105        $num++;
106        chomp($line);
107        die("Line $num is not a byte code line\n")
108            unless $line =~ /^(.)(.*)$/;
109        my $code = $1;
110        my $text = $2;
111        my $class = $code2class->{$code};
112        die("Line $num contains unknown code \"$code\"\n")
113            unless $class;
114        die("Oops!") unless $class->{code} eq $code;
115        if ($class->{type} eq 'bom') {
116            $text = "$code$text";
117        } else {
118            $text =~ s:\\x0[dD]:&crarr;:g;
119            $text =~ s:\\x0[aA]:&darr;:g;
120            $text =~ s:\\x85:&dArr;:g;
121            $text =~ s:\\u2028:&sect;:g;
122            $text =~ s:\\u2029:&para;:g;
123            $text =~ s:\\x09:&rarr;:g;
124            $text =~ s:\t:&rarr;:g;
125            $text =~ s: :&middot;:g;
126            $text =~ s:\\u202F:&diams;:g;
127        }
128        if ($class->{type} eq 'begin') {
129            push(@$stack, [ $num, $class ]);
130            push(@$has_content, 0);
131        } elsif ($class->{type} eq 'end') {
132            my $title = $class->{title};
133            my $had_content = pop(@$has_content);
134            push(@$data, [ $code2class->{'~'}, '&deg;' ]) unless $had_content;
135            for (my $i = 0; $i < @$has_content; $i++) {
136                $has_content->[$i] = 1;
137            }
138            my ($begin_num, $begin_class) = @{pop(@$stack)};
139            my $begin_code = $begin_class->{code};
140            my $begin_title = $begin_class->{title};
141            die("Line $num ($code/$title) "
142              . "ends line $begin_num ($begin_code/$begin_title)\n")
143                if $title ne $begin_title;
144        }
145        push(@$data, [ $class, $text ]);
146        if ($text ne '') {
147            for (my $i = 0; $i < @$has_content; $i++) {
148                $has_content->[$i] = 1;
149            }
150        }
151    }
152    #die("Unterminated groups\n") if @$stack;
153}
154
155sub print_output {
156    print $output <<"EOF";
157<?xml version="1.0" encoding="ISO-8859-1"?>
158<!DOCTYPE html PUBLIC
159 "-//W3C//DTD XHTML 1.0 Transitional//EN"
160 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
161<html xmlns="http://www.w3.org/1999/xhtml">
162<head>
163<title>YEAST2HTML</title>
164<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
165<meta name="generator" content="yeast2html" />
166EOF
167    print_css();
168    print_script();
169    print $output <<"EOF";
170</head>
171<body>
172EOF
173    print_text();
174    print_tree();
175    print $output <<"EOF";
176</body>
177</html>
178EOF
179}
180
181sub print_css {
182    if ($link_css) {
183        print $output "<link rel=\"stylesheet\" href=\"$css_file\" type=\"text/css\" />\n";
184        return;
185    }
186    print $output "<style type=\"text/css\">\n";
187    if ($css_file) {
188        open(CSS, "$css_file") || die("open($css_file): $!\n");
189        while (my $line = <CSS>) {
190            print $output $line;
191        }
192        close(CSS) || die("close($css_file): $!\n");
193    } else {
194        print $output <<"EOF";
195div.tree_div {
196    position: absolute;
197    left: 0%;
198    top: 0%;
199    width: 50%;
200    height: 100%;
201    overflow: scroll;
202}
203div.text_div {
204    position: absolute;
205    left: 50%;
206    top: 0%;
207    width: 50%;
208    height: 100%;
209    overflow: scroll;
210}
211span.highlight {
212    background-color: yellow;
213}
214span.text {
215    font-family: monospace;
216}
217EOF
218    }
219    print $output "</style>\n";
220}
221
222sub print_script {
223    print $output <<"EOF";
224<script language="JavaScript">
225function toggle(id) {
226    var nest_style = document.getElementById("tree_nest_" + id).style;
227    var glyph = document.getElementById("tree_glyph_" + id);
228    if (nest_style.display == "none") {
229        nest_style.display = "block";
230        glyph.innerHTML = "&mdash;";
231    } else {
232        nest_style.display = "none";
233        glyph.innerHTML = "+";
234    }
235}
236var highlighted = 0;
237function highlight(id) {
238    if (highlighted == 0) {
239        var text = document.getElementById("text_" + id);
240        var tree = document.getElementById("tree_text_" + id);
241        text.className = "text highlight";
242        tree.className = "tree_text highlight";
243        highlighted = id;
244    } else if (highlighted == id) {
245        var text = document.getElementById("text_" + id);
246        var tree = document.getElementById("tree_text_" + id);
247        text.className = "text";
248        tree.className = "tree_text";
249        highlighted = 0;
250        return;
251    } else {
252        var old_text = document.getElementById("text_" + highlighted);
253        var old_tree = document.getElementById("tree_text_" + highlighted);
254        var new_text = document.getElementById("text_" + id);
255        var new_tree = document.getElementById("tree_text_" + id);
256        old_text.className = "text";
257        old_tree.className = "tree_text";
258        new_text.className = "text highlight";
259        new_tree.className = "tree_text highlight";
260        highlighted = id;
261    }
262}
263</script>
264EOF
265}
266
267sub print_tree {
268    print $output "<div id=\"tree_div\" class=\"tree_div\">\n";
269    print $output "<h1 id=\"tree_title\" class=\"tree_title\">$tree_title</h1>";
270    $next_id = 0;
271    start_tree_node(0, "Legend");
272    print_legend();
273    end_tree_node();
274    my $depth = 0;
275    for my $entry (@$data) {
276        my ($class, $text) = @$entry;
277        if ($class->{type} eq 'begin') {
278            start_tree_node($depth++, $class->{title});
279        } elsif ($class->{type} eq 'end') {
280            end_tree_node();
281            $depth--;
282        } else {
283            my $label = $class->{title};
284            $label .= " ($text)" if $class->{type} eq 'bom';
285            tree_leaf($depth, $label);
286        }
287    }
288    print $output "</div>\n";
289}
290
291sub start_tree_node {
292    my $depth = shift;
293    my $text = shift;
294    print $output "<div id=\"tree_line_$next_id\" class=\"tree_node parent_node\">\n";
295    for (my $i = 1; $i <= $depth; $i++) {
296        print $output "<span class=\"tree_space parent_node space_$i depth_$depth\">&nbsp;</span>"
297    }
298    print $output "<span id=\"tree_glyph_$next_id\" class=\"tree_glyph parent_node\" onclick=\"toggle($next_id)\">&mdash;</span>";
299    print $output "<span id=\"tree_text_$next_id\" class=\"tree_text parent_node"
300                . ($next_id > 0 ? "" : " legend_node")
301                . "\" onclick=\"highlight($next_id)\">$text</span>\n";
302    print $output "<div id=\"tree_nest_$next_id\" class=\"tree_nest\">\n";
303    $next_id++;
304}
305
306sub end_tree_node {
307    print $output "</div></div>\n";
308}
309
310sub tree_leaf {
311    my $depth = shift;
312    my $text = shift;
313    print $output "<div id=\"tree_line_$next_id\" class=\"tree_node leaf_node\">\n";
314    for (my $i = 1; $i <= $depth; $i++) {
315        print $output "<span class=\"tree_space leaf_node space_$i depth_$depth\">&nbsp;</span>"
316    }
317    print $output "<span id=\"tree_glyph_$next_id\" class=\"tree_glyph leaf_node\">&middot;</span>";
318    print $output "<span id=\"tree_text_$next_id\" class=\"tree_text leaf_node\" onclick=\"highlight($next_id)\">$text</span>\n";
319    print $output "</div>\n";
320    $next_id++;
321}
322
323sub print_legend {
324    print <<"EOF";
325<table id="legend_table" class="legend_table">
326<tr>
327<td class="legend_space">&nbsp;</td>
328<td class="legend_glyph">&crarr;</td>
329<td class="legend_text">Carriage Return</td>
330</tr>
331<tr>
332<td class="legend_space">&nbsp;</td>
333<td class="legend_glyph">&darr;</td>
334<td class="legend_text">Line Feed</td>
335</tr>
336<tr>
337<td class="legend_space">&nbsp;</td>
338<td class="legend_glyph">&dArr;</td>
339<td class="legend_text">Next Line</td>
340</tr>
341<tr>
342<td class="legend_space">&nbsp;</td>
343<td class="legend_glyph">&sect;</td>
344<td class="legend_text">Line separator</td>
345</tr>
346<tr>
347<td class="legend_space">&nbsp;</td>
348<td class="legend_glyph">&para;</td>
349<td class="legend_text">Paragraph separator</td>
350</tr>
351<tr>
352<td class="legend_space">&nbsp;</td>
353<td class="legend_glyph">&rarr;</td>
354<td class="legend_text">Tab</td>
355</tr>
356<tr>
357<td class="legend_space">&nbsp;</td>
358<td class="legend_glyph">&diams;</td>
359<td class="legend_text">Non-breaking space</td>
360</tr>
361<tr>
362<td class="legend_space">&nbsp;</td>
363<td class="legend_glyph">&middot;</td>
364<td class="legend_text">Space</td>
365</tr>
366<tr>
367<td class="legend_space">&nbsp;</td>
368<td class="legend_glyph">&deg;</td>
369<td class="legend_text">Empty</td>
370</tr>
371<tr>
372<td class="legend_space">&nbsp;</td>
373<td class="legend_glyph">&hArr;</td>
374<td class="legend_text">Byte order mark</td>
375</tr>
376</table>
377EOF
378}
379
380sub print_text {
381    print $output "<div id=\"text_div\" class=\"text_div\">\n";
382    print $output "<h1 id=\"text_title\" class=\"text_title\">$text_title</h1>";
383    $next_id = 1;
384    my $pending_break = 0;
385    for my $entry (@$data) {
386        my ($class, $text) = @$entry;
387        if ($class->{type} eq 'end') {
388            print $output "</span>";
389            next;
390        }
391        if ($pending_break) {
392            print $output "<br/>\n";
393            $pending_break = 0;
394        }
395        print $output "<span id=\"text_$next_id\" class=\"text\"";
396        print " onclick=\"highlight($next_id)\"" unless $class->{type} eq 'begin';
397        print ">";
398        $next_id++;
399        next if $class->{type} eq 'begin';
400        if ($class->{type} eq 'bom') {
401            print $output "&hArr;</span>";
402        } else {
403            print $output "$text</span>";
404        }
405        $pending_break = $class->{type} eq 'line';
406    }
407    print $output "\n</div>\n";
408}
409
410__END__
411
412=head1 NAME
413
414yeast2html - Convert YEAST byte codes to viewable HTML
415
416=head1 SYNOPSIS
417
418yeast2html [options] [yeast-file]
419
420=head1 DESCRIPTION
421
422This Perl script is designed to allow exploring the syntactical structure of
423YAML files in an interactive way. The input file is a sequence of YEAST byte
424codes that describe the YAML text. The output is an XHTML file that allows
425viewing the YAML syntax tree together with the original (reconstructed) YAML
426text.
427
428=head1 COMMAND LINE OPTIONS
429
430=over 4
431
432=item B<--output|-o> I<output-file>
433
434Redirect the output XHTML to the specified I<output-file>. By default the XHTML
435is written to standard output.
436
437=item B<--css|-c> I<css-file>
438
439Use the specified I<css-file> to control the style of the generated XHTML. By
440default, a minimal set of CSS rules is used, which doesn't look very pretty.
441
442=item B<--link-css|-l>
443
444By default, the content of the I<css-file> is embedded in the header of the
445generated XHTML. If this flag is given, this is replaced by a link to the
446I<css-file>. Note that in this case the I<css-file> path must be relative to
447the URL used for the XHTML file.
448
449=item B<--tree-title|-r> I<title>
450
451The title for the tree part of the display. By default, it says "Syntax Tree".
452
453=item B<--text-title|-x> I<title>
454
455The title for the text part of the display. By default, it says "YAML Text".
456
457=item B<--help|-h>
458
459Print short usage message and exit.
460
461=item B<--man|-m>
462
463Print this man page and exit.
464
465=back
466
467=head1 SEE ALSO
468
469L<yaml2yeast>
470
471=head1 AUTHOR
472
473Oren Ben-Kiki <oren@ben-kiki.org>
474
475=head1 COPYRIGHT
476
477Copyright (c) 2007, Oren Ben-Kiki
478
479This program is free software; you can redistribute it and/or modify it under
480the terms of the GNU Lesser General Public License as published by the Free
481Software Foundation; either version 2.1 of the License, or (at your option) any
482later version.
483
484This library is distributed in the hope that it will be useful, but WITHOUT ANY
485WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
486PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more
487details.
488
489You should have received a copy of the GNU Lesser General Public License along
490with this library; if not, write to the Free Software Foundation, Inc.,
49151 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
Note: See TracBrowser for help on using the browser.