test/html-webhacc/mkdescription.pl

#!/usr/bin/perl
use strict;
use encoding 'us-ascii', STDOUT => 'utf-8';

use lib qw[/home/httpd/html/www/markup/html/whatpm
           /home/wakaba/work/manakai2/lib];

my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
my $SRC_NS = q<http://suika.fam.cx/~wakaba/archive/2007/wdcc-desc/>;
my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;

require Message::DOM::DOMImplementation;
my $dom = Message::DOM::DOMImplementation->new;

my $doc;
{
  my $source_file_name = shift or die "$0: No source file specified\n";
  open my $source_file, '<', $source_file_name
      or die "$0: $source_file_name: $!";
  require Message::DOM::XMLParserTemp;
  $doc = Message::DOM::XMLParserTemp->parse_byte_stream
      ($source_file => $dom, undef, charset => 'utf-8');
  $doc->manakai_is_html (1);
}

my $target_lang = shift || 'en';

my @node = (@{$doc->child_nodes});
while (@node) {
  my $node = shift @node;
  if ($node->node_type == $node->ELEMENT_NODE) {
    if ($node->namespace_uri eq $HTML_NS) {
      if ($node->manakai_local_name eq 'title') {
        unless ($node->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
          $node->parent_node->remove_child ($node);
        }
      } else {
        unshift @node, @{$node->child_nodes};
      }
    } elsif ($node->namespace_uri eq $SRC_NS) {
      my $ln = $node->manakai_local_name;
      if ($ln eq 'item' or $ln eq 'cat') {
        my $message;
        my $desc;
        my $text;
        for (@{$node->child_nodes}) {
          if ($_->node_type == $_->ELEMENT_NODE and
              $_->namespace_uri eq $SRC_NS) {
            if ($_->manakai_local_name eq 'desc') {
              if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
                $desc = $_;
                next;
              } else {
                $desc ||= $_;
              }
            } elsif ($_->manakai_local_name eq 'message') {
              if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
                $message = $_;
                next;
              } else {
                $message ||= $_;
              }
            } elsif ($_->manakai_local_name eq 'text') {
              if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
                $text = $_;
                next;
              } else {
                $text ||= $_;
              }
            }
          }
        }

        if ($ln eq 'item' or $desc) {
          my $name = $node->get_attribute_ns (undef, 'name');
          $name =~ tr/ /-/;
          
          my $section = $doc->create_element_ns ($HTML_NS, 'div');
          $section->set_attribute_ns (undef, class => 'section');
          $section->set_attribute_ns (undef, id => $name);
          
          my $msg = $section->append_child
              ($doc->create_element_ns ($HTML_NS, 'h3'));
          if ($ln eq 'item' and $message) {
            my @message_child = @{$message->child_nodes};
            $msg->append_child ($_) for @message_child;
          } elsif ($ln eq 'cat' and $text) {
            $msg->append_child ($_) for @{$text->child_nodes};
          }
          
          if ($desc) {
            my @desc_child = @{$desc->child_nodes};
            $section->append_child ($_) for @desc_child;
          }
          
          $node->parent_node->insert_before ($section, $node);
        }
        $node->parent_node->remove_child ($node);
      } else {
        warn "$0: ", $node->manakai_local_name, " is not supported\n";
      }
    }
  }
}
$doc->document_element->set_attribute_ns (undef, lang => $target_lang);

print $doc->inner_html;
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;