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 = '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) {
      if ($node->manakai_local_name eq 'item') {
        my $message;
        my $desc;
        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 ||= $_;
              }
            }
          }
        }

        my $name = $node->get_attribute_ns (undef, 'name');
        $name =~ tr/ /-/;
        my $level = $node->get_attribute_ns (undef, 'level');
        $name = $level . ':' . $name if defined $level;
        my $section = $doc->create_element_ns ($HTML_NS, 'div');
        $section->set_attribute_ns
            (undef, class => 'section ' .
                 $node->get_attribute_ns (undef, 'class'));
        $section->set_attribute_ns (undef, id => $name);

        my @message_child = @{$message->child_nodes};
        my $msg = $section->append_child
            ($doc->create_element_ns ($HTML_NS, 'h3'));
        $msg->append_child ($_) for @message_child;

        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); ## TODO: replace_child is not yet implemented
      } elsif ($node->manakai_local_name eq 'cat') {
        $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	#!/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	/home/wakaba/work/manakai2/lib];
7
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	my $dom = Message::DOM::DOMImplementation->new;
14
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	$doc->manakai_is_html (1);
24	}
25
26	my $target_lang = 'en';
27	my @node = (@{$doc->child_nodes});
28	while (@node) {
29	my $node = shift @node;
30	if ($node->node_type == $node->ELEMENT_NODE) {
31	if ($node->namespace_uri eq $HTML_NS) {
32	if ($node->manakai_local_name eq 'title') {
33	unless ($node->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
34	$node->parent_node->remove_child ($node);
35	}
36	} else {
37	unshift @node, @{$node->child_nodes};
38	}
39	} elsif ($node->namespace_uri eq $SRC_NS) {
40	if ($node->manakai_local_name eq 'item') {
41	my $message;
42	my $desc;
43	for (@{$node->child_nodes}) {
44	if ($_->node_type == $_->ELEMENT_NODE and
45	$_->namespace_uri eq $SRC_NS) {
46	if ($_->manakai_local_name eq 'desc') {
47	if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
48	$desc = $_;
49	next;
50	} else {
51	$desc \|\|= $_;
52	}
53	} elsif ($_->manakai_local_name eq 'message') {
54	if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
55	$message = $_;
56	next;
57	} else {
58	$message \|\|= $_;
59	}
60	}
61	}
62	}
63
64	my $name = $node->get_attribute_ns (undef, 'name');
65	$name =~ tr/ /-/;
66	my $level = $node->get_attribute_ns (undef, 'level');
67	$name = $level . ':' . $name if defined $level;
68	my $section = $doc->create_element_ns ($HTML_NS, 'div');
69	$section->set_attribute_ns
70	(undef, class => 'section ' .
71	$node->get_attribute_ns (undef, 'class'));
72	$section->set_attribute_ns (undef, id => $name);
73
74	my @message_child = @{$message->child_nodes};
75	my $msg = $section->append_child
76	($doc->create_element_ns ($HTML_NS, 'h3'));
77	$msg->append_child ($_) for @message_child;
78
79	if ($desc) {
80	my @desc_child = @{$desc->child_nodes};
81	$section->append_child ($_) for @desc_child;
82	}
83
84	$node->parent_node->insert_before ($section, $node);
85	$node->parent_node->remove_child ($node); ## TODO: replace_child is not yet implemented
86	} elsif ($node->manakai_local_name eq 'cat') {
87	$node->parent_node->remove_child ($node);
88	} else {
89	warn "$0: ", $node->manakai_local_name, " is not supported\n";
90	}
91	}
92	}
93	}
94	$doc->document_element->set_attribute_ns (undef, lang => $target_lang);
95
96	print $doc->inner_html;