test/html-webhacc/mkcatalog.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/manakai/lib
           /home/wakaba/public_html/-temp/wiki/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) {
      unshift @node, @{$node->child_nodes};
    } elsif ($node->namespace_uri eq $SRC_NS) {
      if ($node->manakai_local_name eq 'item') {
        my $message;
        for (@{$node->child_nodes}) {
          if ($_->node_type == $_->ELEMENT_NODE and
              $_->namespace_uri eq $SRC_NS) {
            if ($_->manakai_local_name eq 'message') {
              if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
                $message = $_;
                next;
              } else {
                $message ||= $_;
              }
            }
          }
        }

        my $entry = [];
        push @$entry, $node->get_attribute_ns (undef, 'name');
        my $level = $node->get_attribute_ns (undef, 'level');
        $entry->[-1] = $level . ':' . $entry->[-1] if defined $level;
        push @$entry, $node->get_attribute_ns (undef, 'class');
        push @$entry, $message->inner_html;
        s/\s+/ /g for @$entry;
        print join ';', @$entry;
        print "\n";
      } elsif ($node->manakai_local_name eq 'catalog') {
        print $node->text_content, "\n";
      } else {
        warn "$0: ", $node->manakai_local_name, " is not supported\n";
      }
    }
  }
}
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/manakai/lib
7	/home/wakaba/public_html/-temp/wiki/lib];
8
9	my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
10	my $SRC_NS = q<http://suika.fam.cx/~wakaba/archive/2007/wdcc-desc/>;
11	my $XML_NS = q<http://www.w3.org/XML/1998/namespace>;
12
13	require Message::DOM::DOMImplementation;
14	my $dom = Message::DOM::DOMImplementation->new;
15
16	my $doc;
17	{
18	my $source_file_name = shift or die "$0: No source file specified\n";
19	open my $source_file, '<', $source_file_name
20	or die "$0: $source_file_name: $!";
21	require Message::DOM::XMLParserTemp;
22	$doc = Message::DOM::XMLParserTemp->parse_byte_stream
23	($source_file => $dom, undef, charset => 'utf-8');
24	$doc->manakai_is_html (1);
25	}
26
27	my $target_lang = 'en';
28	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	unshift @node, @{$node->child_nodes};
34	} elsif ($node->namespace_uri eq $SRC_NS) {
35	if ($node->manakai_local_name eq 'item') {
36	my $message;
37	for (@{$node->child_nodes}) {
38	if ($_->node_type == $_->ELEMENT_NODE and
39	$_->namespace_uri eq $SRC_NS) {
40	if ($_->manakai_local_name eq 'message') {
41	if ($_->get_attribute_ns ($XML_NS, 'lang') eq $target_lang) {
42	$message = $_;
43	next;
44	} else {
45	$message \|\|= $_;
46	}
47	}
48	}
49	}
50
51	my $entry = [];
52	push @$entry, $node->get_attribute_ns (undef, 'name');
53	my $level = $node->get_attribute_ns (undef, 'level');
54	$entry->[-1] = $level . ':' . $entry->[-1] if defined $level;
55	push @$entry, $node->get_attribute_ns (undef, 'class');
56	push @$entry, $message->inner_html;
57	s/\s+/ /g for @$entry;
58	print join ';', @$entry;
59	print "\n";
60	} elsif ($node->manakai_local_name eq 'catalog') {
61	print $node->text_content, "\n";
62	} else {
63	warn "$0: ", $node->manakai_local_name, " is not supported\n";
64	}
65	}
66	}
67	}