/[pub]/test/html-webhacc/mkdescription.pl
Suika

Contents of /test/html-webhacc/mkdescription.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations) (download)
Sat Aug 16 13:09:08 2008 UTC (16 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.5: +35 -24 lines
File MIME type: text/plain
++ ChangeLog	16 Aug 2008 13:08:56 -0000
	* Makefile: Generate Japanese version of error description document.

	* cc-script.js, cc-style.css: Support for help popup.

	* error-description-source.xml: Descriptions are added
	to the description of WebHACC itself and descriptions
	of error levels.  Old error level table is removed.

	* mkdescription.pl: Assume the second argument is
	the language.  Support for d:cat/d:desc.

2008-08-16  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3     use encoding 'us-ascii', STDOUT => 'utf-8';
4    
5     use lib qw[/home/httpd/html/www/markup/html/whatpm
6 wakaba 1.4 /home/wakaba/work/manakai2/lib];
7 wakaba 1.1
8     my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
9     my $SRC_NS = q<http://suika.fam.cx/~wakaba/archive/2007/wdcc-desc/>;
10     my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
11    
12     require Message::DOM::DOMImplementation;
13 wakaba 1.2 my $dom = Message::DOM::DOMImplementation->new;
14 wakaba 1.1
15     my $doc;
16     {
17     my $source_file_name = shift or die "$0: No source file specified\n";
18     open my $source_file, '<', $source_file_name
19     or die "$0: $source_file_name: $!";
20     require Message::DOM::XMLParserTemp;
21     $doc = Message::DOM::XMLParserTemp->parse_byte_stream
22     ($source_file => $dom, undef, charset => 'utf-8');
23 wakaba 1.2 $doc->manakai_is_html (1);
24 wakaba 1.1 }
25    
26 wakaba 1.6 my $target_lang = shift || 'en';
27    
28 wakaba 1.1 my @node = (@{$doc->child_nodes});
29     while (@node) {
30     my $node = shift @node;
31     if ($node->node_type == $node->ELEMENT_NODE) {
32     if ($node->namespace_uri eq $HTML_NS) {
33     if ($node->manakai_local_name eq 'title') {
34     unless ($node->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
35     $node->parent_node->remove_child ($node);
36     }
37     } else {
38 wakaba 1.2 unshift @node, @{$node->child_nodes};
39 wakaba 1.1 }
40     } elsif ($node->namespace_uri eq $SRC_NS) {
41 wakaba 1.6 my $ln = $node->manakai_local_name;
42     if ($ln eq 'item' or $ln eq 'cat') {
43 wakaba 1.1 my $message;
44     my $desc;
45 wakaba 1.6 my $text;
46 wakaba 1.1 for (@{$node->child_nodes}) {
47     if ($_->node_type == $_->ELEMENT_NODE and
48     $_->namespace_uri eq $SRC_NS) {
49     if ($_->manakai_local_name eq 'desc') {
50     if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
51     $desc = $_;
52     next;
53     } else {
54     $desc ||= $_;
55     }
56     } elsif ($_->manakai_local_name eq 'message') {
57     if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
58     $message = $_;
59     next;
60     } else {
61     $message ||= $_;
62     }
63 wakaba 1.6 } elsif ($_->manakai_local_name eq 'text') {
64     if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
65     $text = $_;
66     next;
67     } else {
68     $text ||= $_;
69     }
70 wakaba 1.1 }
71     }
72     }
73    
74 wakaba 1.6 if ($ln eq 'item' or $desc) {
75     my $name = $node->get_attribute_ns (undef, 'name');
76     $name =~ tr/ /-/;
77    
78     my $section = $doc->create_element_ns ($HTML_NS, 'div');
79     $section->set_attribute_ns (undef, class => 'section');
80     $section->set_attribute_ns (undef, id => $name);
81    
82     my $msg = $section->append_child
83     ($doc->create_element_ns ($HTML_NS, 'h3'));
84     if ($ln eq 'item' and $message) {
85     my @message_child = @{$message->child_nodes};
86     $msg->append_child ($_) for @message_child;
87     } elsif ($ln eq 'cat' and $text) {
88     $msg->append_child ($_) for @{$text->child_nodes};
89     }
90    
91     if ($desc) {
92     my @desc_child = @{$desc->child_nodes};
93     $section->append_child ($_) for @desc_child;
94     }
95    
96     $node->parent_node->insert_before ($section, $node);
97 wakaba 1.2 }
98 wakaba 1.5 $node->parent_node->remove_child ($node);
99 wakaba 1.1 } else {
100     warn "$0: ", $node->manakai_local_name, " is not supported\n";
101     }
102     }
103     }
104     }
105     $doc->document_element->set_attribute_ns (undef, lang => $target_lang);
106    
107 wakaba 1.2 print $doc->inner_html;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24