SWE/Lang/XML2HTML.pm

package SWE::Lang::XML2HTML;
use strict;

our $ConverterVersion = 2;

sub AA_NS () { q<http://pc5.2ch.net/test/read.cgi/hp/1096723178/aavocab#> }
sub HTML_NS () { q<http://www.w3.org/1999/xhtml> }
sub SW09_NS () { q<urn:x-suika-fam-cx:markup:suikawiki:0:9:> }
sub SW10_NS () { q<urn:x-suika-fam-cx:markup:suikawiki:0:10:> }
sub XML_NS () { q<http://www.w3.org/XML/1998/namespace> }

my $templates = {};

$templates->{''}->{''} = sub {
  my ($items, $item) = @_;

  if ($item->{node}->node_type == $item->{node}->ELEMENT_NODE) {
    unshift @$items,
        map {{%$item, node => $_, parent => $item->{parent}}}
        @{$item->{node}->child_nodes};
  } else {
    $item->{parent}->manakai_append_text ($item->{node}->node_value);
  }
};

$templates->{(HTML_NS)}->{head} = sub { };

$templates->{(HTML_NS)}->{section} = sub {
  my ($items, $item) = @_;

  my $section_el = $item->{doc}->create_element_ns (HTML_NS, 'div');
  $section_el->set_attribute (class => 'section sw-section');
  $item->{parent}->append_child ($section_el);

  unshift @$items,
      map {{%$item, node => $_, parent => $section_el,
            heading_level => $item->{heading_level} + 1}}
      @{$item->{node}->child_nodes};
};

$templates->{(HTML_NS)}->{h1} = sub {
  my ($items, $item) = @_;

  my $h_el = $item->{doc}->create_element_ns
      (HTML_NS,
       'h' . ($item->{heading_level} > 6 ? '6' : $item->{heading_level}));
  $item->{parent}->append_child ($h_el);

  unshift @$items,
      map {{%$item, node => $_, parent => $h_el}}
      @{$item->{node}->child_nodes};
};

$templates->{(HTML_NS)}->{p} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns
      (HTML_NS, $item->{node}->manakai_local_name);
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $el->set_attribute (class => $class) if defined $class;

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  my $colspan = $item->{node}->get_attribute ('colspan');
  $el->set_attribute (colspan => $colspan) if defined $colspan;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};
$templates->{(HTML_NS)}->{$_} = $templates->{(HTML_NS)}->{p}
    for qw/
      ul ol dl li dt dd table tbody tr td blockquote pre
      abbr cite code dfn kbd ruby samp span sub sup time var em strong
    /;

$templates->{(HTML_NS)}->{rt} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'rp');
  $el->text_content (' (');
  $item->{parent}->append_child ($el);

  $el = $item->{doc}->create_element_ns
      (HTML_NS, $item->{node}->manakai_local_name);
  $item->{parent}->append_child ($el);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};

  $el = $item->{doc}->create_element_ns (HTML_NS, 'rp');
  $el->text_content (') ');
  $item->{parent}->append_child ($el);
};

$templates->{(SW09_NS)}->{insert} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'ins');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $el->set_attribute (class => $class) if defined $class;

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{delete} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'del');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $el->set_attribute (class => $class) if defined $class;

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{'comment-p'} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-comment-p');

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{ed} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-ed');

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(AA_NS)}->{aa} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'span');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-aa';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{csection} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'cite');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-csection';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{key} = sub {
  my ($items, $item) = @_;

  my $el0 = $item->{doc}->create_element_ns (HTML_NS, 'kbd');
  $item->{parent}->append_child ($el0);

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'kbd');
  $el0->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $el->set_attribute (class => $class) if defined $class;

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{qn} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'code');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-qn';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{src} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'cite');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-src';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{weak} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'small');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-weak';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW10_NS)}->{title} = sub {
  my ($items, $item) = @_;

  unless ($item->{parent}->has_attribute ('title')) {
    $item->{parent}->set_attribute (title => $item->{node}->text_content);
  }
};

$templates->{(SW10_NS)}->{nsuri} = sub {
  my ($items, $item) = @_;

  unless ($item->{parent}->has_attribute ('title')) {
    $item->{parent}->set_attribute
        (title => '<' . $item->{node}->text_content . '>');
  }
};

$templates->{(HTML_NS)}->{q} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns
      (HTML_NS, $item->{node}->manakai_local_name);
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $el->set_attribute (class => $class) if defined $class;

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  if ($item->{node}->has_attribute_ns (SW09_NS, 'resScheme')) {
    ## TODO: ...
  }

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};
$templates->{(HTML_NS)}->{del} = $templates->{(HTML_NS)}->{q};
$templates->{(HTML_NS)}->{ins} = $templates->{(HTML_NS)}->{q};

$templates->{(SW09_NS)}->{rubyb} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'ruby');
  $item->{parent}->append_child ($el);

  my $class = $item->{node}->get_attribute ('class');
  $class //= '';
  $class .= ' sw-rubyb';
  $el->set_attribute (class => $class);

  my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
  $el->set_attribute (lang => $lang) if defined $lang;

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{anchor} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-anchor');
  
  my $name = $item->{node}->text_content;
  if ($name eq '//') {
    $name = 'HomePage'; ## Don't use $homepage_name - this is not configurable
  } elsif ($name =~ s!^\.//!!) {
    $name = $item->{name} . '//' . $name;
  } elsif ($name =~ s!^\.\.//!!) {
    my $pname = $item->{name};
    $pname =~ s<//(?:(?!//).)+$><>;
    $name = $pname . '//' . $name;
  }

  $name =~ s/\s+/ /g;
  $name =~ s/^ //;
  $name =~ s/ $//;
  $name = 'HomePage' unless length $name;

  my $url = $item->{name_to_url}->($name, $item->{name});

  my $anchor = $item->{node}->get_attribute_ns (SW09_NS, 'anchor');
  if (defined $anchor) {
    $url .= '#anchor-' . $anchor;
    my $t = $item->{doc}->create_text_node (' (>>' . $anchor . ')');
    unshift @$items, {%$item, node => $t, parent => $el};
  }
  
  $el->set_attribute (href => $url);

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{'anchor-internal'} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-anchor-internal');

  my $id = $item->{node}->get_attribute_ns (SW09_NS, 'anchor') + 0;
  $el->set_attribute (href => '#anchor-' . $id);

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{'anchor-end'} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-anchor-end');

  my $id = $item->{node}->get_attribute_ns (SW09_NS, 'anchor') + 0;
  $el->set_attribute (id => 'anchor-' . $id);

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{'anchor-external'} = sub {
  my ($items, $item) = @_;

  $item->{parent}->manakai_append_text ('<');

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
  $item->{parent}->append_child ($el);
  $el->set_attribute (class => 'sw-anchor-external');

  $item->{parent}->manakai_append_text ('>');

  my $scheme = $item->{node}->get_attribute_ns (SW09_NS, 'resScheme');
  if ($scheme eq 'URI' or $scheme eq 'URL') {
    $el->set_attribute
        (href => $item->{node}->get_attribute_ns (SW09_NS, 'resParameter'));
  } else {
    ## TODO: ...
  }

  unshift @$items,
      map {{%$item, node => $_, parent => $el}}
      @{$item->{node}->child_nodes};
};

$templates->{(SW09_NS)}->{image} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
  $el->set_attribute (class => 'article sw-image');
  $item->{parent}->append_child ($el);

  my $type;
  my $alt;
  my $head_el = $item->{node}->owner_document->manakai_head;
  if ($head_el) {
    for (@{$head_el->child_nodes}) {
      next if $_->node_type != $_->ELEMENT_NODE;
      next if ($_->namespace_uri // '') ne SW09_NS;
      next if $_->manakai_local_name ne 'parameter';
      my $name = $_->get_attribute ('name');
      if ($name eq 'image-type' or $name eq 'image-alt') {
        for (@{$_->child_nodes}) {
          next if $_->node_type != $_->ELEMENT_NODE;
          next if ($_->namespace_uri // '') ne SW09_NS;
          next if $_->manakai_local_name ne 'value';
          if ($name eq 'image-type') {
            $type //= $_->text_content;
          } elsif ($name eq 'image-alt') {
            $alt //= $_->text_content;
          }
          last;
        }
        last if defined $type and defined $alt;
      }
    }
  }
  $type //= 'application/octet-stream';
  $type =~ tr{a-zA-Z0-9.+-_/-}{}cd;
      ## NOTE: '!', '#', '$', '&', '^' are also allowed according to RFC 4288.

  my $data = $item->{node}->text_content;
  $data =~ s/\s+//g;

  my $img_el = $item->{doc}->create_element_ns (HTML_NS, 'img');
  $img_el->set_attribute (alt => $alt // '');
  $img_el->set_attribute (src => 'data:' . $type . ';base64,' . $data);
  $el->append_child ($img_el);
};

$templates->{(SW09_NS)}->{replace} = sub {
  my ($items, $item) = @_;

  my $el = $item->{doc}->create_element_ns (HTML_NS, 'span');
  $el->set_attribute (class => 'sw-replace');
  $el->text_content ($item->{node}->get_attribute ('by') // '');
  $item->{parent}->append_child ($el);
};

sub convert ($$$$$) {
  shift;
  my $name = shift;
  my $swml = shift;
  my $doc = shift;
  my $name_to_url = shift;

  my $article_el = $doc->create_element_ns (HTML_NS, 'div');
  $article_el->set_attribute (class => 'article');

  my @items = map {{doc => $doc,
                    name_to_url => $name_to_url,
                    heading_level => 1, name => $name,
                    node => $_, parent => $article_el}} @{$swml->child_nodes};
  while (@items) {
    my $item = shift @items;
    my $nsuri = $item->{node}->namespace_uri // '';
    my $ln = $item->{node}->manakai_local_name // '';
    my $template = $templates->{$nsuri}->{$ln} || $templates->{''}->{''};
    $template->(\@items, $item);
  }

  return $article_el;
} # convert_swml_to_html

1;
1	wakaba	1.1	package SWE::Lang::XML2HTML;
2			use strict;
3
4			our $ConverterVersion = 2;
5
6			sub AA_NS () { q<http://pc5.2ch.net/test/read.cgi/hp/1096723178/aavocab#> }
7			sub HTML_NS () { q<http://www.w3.org/1999/xhtml> }
8			sub SW09_NS () { q<urn:x-suika-fam-cx:markup:suikawiki:0:9:> }
9			sub SW10_NS () { q<urn:x-suika-fam-cx:markup:suikawiki:0:10:> }
10			sub XML_NS () { q<http://www.w3.org/XML/1998/namespace> }
11
12			my $templates = {};
13
14			$templates->{''}->{''} = sub {
15			my ($items, $item) = @_;
16
17			if ($item->{node}->node_type == $item->{node}->ELEMENT_NODE) {
18			unshift @$items,
19			map {{%$item, node => $_, parent => $item->{parent}}}
20			@{$item->{node}->child_nodes};
21			} else {
22			$item->{parent}->manakai_append_text ($item->{node}->node_value);
23			}
24			};
25
26			$templates->{(HTML_NS)}->{head} = sub { };
27
28			$templates->{(HTML_NS)}->{section} = sub {
29			my ($items, $item) = @_;
30
31			my $section_el = $item->{doc}->create_element_ns (HTML_NS, 'div');
32			$section_el->set_attribute (class => 'section sw-section');
33			$item->{parent}->append_child ($section_el);
34
35			unshift @$items,
36			map {{%$item, node => $_, parent => $section_el,
37			heading_level => $item->{heading_level} + 1}}
38			@{$item->{node}->child_nodes};
39			};
40
41			$templates->{(HTML_NS)}->{h1} = sub {
42			my ($items, $item) = @_;
43
44			my $h_el = $item->{doc}->create_element_ns
45			(HTML_NS,
46			'h' . ($item->{heading_level} > 6 ? '6' : $item->{heading_level}));
47			$item->{parent}->append_child ($h_el);
48
49			unshift @$items,
50			map {{%$item, node => $_, parent => $h_el}}
51			@{$item->{node}->child_nodes};
52			};
53
54			$templates->{(HTML_NS)}->{p} = sub {
55			my ($items, $item) = @_;
56
57			my $el = $item->{doc}->create_element_ns
58			(HTML_NS, $item->{node}->manakai_local_name);
59			$item->{parent}->append_child ($el);
60
61			my $class = $item->{node}->get_attribute ('class');
62			$el->set_attribute (class => $class) if defined $class;
63
64			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
65			$el->set_attribute (lang => $lang) if defined $lang;
66
67			my $colspan = $item->{node}->get_attribute ('colspan');
68			$el->set_attribute (colspan => $colspan) if defined $colspan;
69
70			unshift @$items,
71			map {{%$item, node => $_, parent => $el}}
72			@{$item->{node}->child_nodes};
73			};
74			$templates->{(HTML_NS)}->{$_} = $templates->{(HTML_NS)}->{p}
75			for qw/
76			ul ol dl li dt dd table tbody tr td blockquote pre
77			abbr cite code dfn kbd ruby samp span sub sup time var em strong
78			/;
79
80			$templates->{(HTML_NS)}->{rt} = sub {
81			my ($items, $item) = @_;
82
83			my $el = $item->{doc}->create_element_ns (HTML_NS, 'rp');
84			$el->text_content (' (');
85			$item->{parent}->append_child ($el);
86
87			$el = $item->{doc}->create_element_ns
88			(HTML_NS, $item->{node}->manakai_local_name);
89			$item->{parent}->append_child ($el);
90
91			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
92			$el->set_attribute (lang => $lang) if defined $lang;
93
94			unshift @$items,
95			map {{%$item, node => $_, parent => $el}}
96			@{$item->{node}->child_nodes};
97
98			$el = $item->{doc}->create_element_ns (HTML_NS, 'rp');
99			$el->text_content (') ');
100			$item->{parent}->append_child ($el);
101			};
102
103			$templates->{(SW09_NS)}->{insert} = sub {
104			my ($items, $item) = @_;
105
106			my $el = $item->{doc}->create_element_ns (HTML_NS, 'ins');
107			$item->{parent}->append_child ($el);
108
109			my $class = $item->{node}->get_attribute ('class');
110			$el->set_attribute (class => $class) if defined $class;
111
112			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
113			$el->set_attribute (lang => $lang) if defined $lang;
114
115			unshift @$items,
116			map {{%$item, node => $_, parent => $el}}
117			@{$item->{node}->child_nodes};
118			};
119
120			$templates->{(SW09_NS)}->{delete} = sub {
121			my ($items, $item) = @_;
122
123			my $el = $item->{doc}->create_element_ns (HTML_NS, 'del');
124			$item->{parent}->append_child ($el);
125
126			my $class = $item->{node}->get_attribute ('class');
127			$el->set_attribute (class => $class) if defined $class;
128
129			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
130			$el->set_attribute (lang => $lang) if defined $lang;
131
132			unshift @$items,
133			map {{%$item, node => $_, parent => $el}}
134			@{$item->{node}->child_nodes};
135			};
136
137			$templates->{(SW10_NS)}->{'comment-p'} = sub {
138			my ($items, $item) = @_;
139
140			my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
141			$item->{parent}->append_child ($el);
142			$el->set_attribute (class => 'sw-comment-p');
143
144			unshift @$items,
145			map {{%$item, node => $_, parent => $el}}
146			@{$item->{node}->child_nodes};
147			};
148
149			$templates->{(SW10_NS)}->{ed} = sub {
150			my ($items, $item) = @_;
151
152			my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
153			$item->{parent}->append_child ($el);
154			$el->set_attribute (class => 'sw-ed');
155
156			unshift @$items,
157			map {{%$item, node => $_, parent => $el}}
158			@{$item->{node}->child_nodes};
159			};
160
161			$templates->{(AA_NS)}->{aa} = sub {
162			my ($items, $item) = @_;
163
164			my $el = $item->{doc}->create_element_ns (HTML_NS, 'span');
165			$item->{parent}->append_child ($el);
166
167			my $class = $item->{node}->get_attribute ('class');
168			$class //= '';
169			$class .= ' sw-aa';
170			$el->set_attribute (class => $class);
171
172			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
173			$el->set_attribute (lang => $lang) if defined $lang;
174
175			unshift @$items,
176			map {{%$item, node => $_, parent => $el}}
177			@{$item->{node}->child_nodes};
178			};
179
180			$templates->{(SW10_NS)}->{csection} = sub {
181			my ($items, $item) = @_;
182
183			my $el = $item->{doc}->create_element_ns (HTML_NS, 'cite');
184			$item->{parent}->append_child ($el);
185
186			my $class = $item->{node}->get_attribute ('class');
187			$class //= '';
188			$class .= ' sw-csection';
189			$el->set_attribute (class => $class);
190
191			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
192			$el->set_attribute (lang => $lang) if defined $lang;
193
194			unshift @$items,
195			map {{%$item, node => $_, parent => $el}}
196			@{$item->{node}->child_nodes};
197			};
198
199			$templates->{(SW10_NS)}->{key} = sub {
200			my ($items, $item) = @_;
201
202			my $el0 = $item->{doc}->create_element_ns (HTML_NS, 'kbd');
203			$item->{parent}->append_child ($el0);
204
205			my $el = $item->{doc}->create_element_ns (HTML_NS, 'kbd');
206			$el0->append_child ($el);
207
208			my $class = $item->{node}->get_attribute ('class');
209			$el->set_attribute (class => $class) if defined $class;
210
211			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
212			$el->set_attribute (lang => $lang) if defined $lang;
213
214			unshift @$items,
215			map {{%$item, node => $_, parent => $el}}
216			@{$item->{node}->child_nodes};
217			};
218
219			$templates->{(SW10_NS)}->{qn} = sub {
220			my ($items, $item) = @_;
221
222			my $el = $item->{doc}->create_element_ns (HTML_NS, 'code');
223			$item->{parent}->append_child ($el);
224
225			my $class = $item->{node}->get_attribute ('class');
226			$class //= '';
227			$class .= ' sw-qn';
228			$el->set_attribute (class => $class);
229
230			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
231			$el->set_attribute (lang => $lang) if defined $lang;
232
233			unshift @$items,
234			map {{%$item, node => $_, parent => $el}}
235			@{$item->{node}->child_nodes};
236			};
237
238			$templates->{(SW10_NS)}->{src} = sub {
239			my ($items, $item) = @_;
240
241			my $el = $item->{doc}->create_element_ns (HTML_NS, 'cite');
242			$item->{parent}->append_child ($el);
243
244			my $class = $item->{node}->get_attribute ('class');
245			$class //= '';
246			$class .= ' sw-src';
247			$el->set_attribute (class => $class);
248
249			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
250			$el->set_attribute (lang => $lang) if defined $lang;
251
252			unshift @$items,
253			map {{%$item, node => $_, parent => $el}}
254			@{$item->{node}->child_nodes};
255			};
256
257			$templates->{(SW09_NS)}->{weak} = sub {
258			my ($items, $item) = @_;
259
260			my $el = $item->{doc}->create_element_ns (HTML_NS, 'small');
261			$item->{parent}->append_child ($el);
262
263			my $class = $item->{node}->get_attribute ('class');
264			$class //= '';
265			$class .= ' sw-weak';
266			$el->set_attribute (class => $class);
267
268			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
269			$el->set_attribute (lang => $lang) if defined $lang;
270
271			unshift @$items,
272			map {{%$item, node => $_, parent => $el}}
273			@{$item->{node}->child_nodes};
274			};
275
276			$templates->{(SW10_NS)}->{title} = sub {
277			my ($items, $item) = @_;
278
279			unless ($item->{parent}->has_attribute ('title')) {
280			$item->{parent}->set_attribute (title => $item->{node}->text_content);
281			}
282			};
283
284			$templates->{(SW10_NS)}->{nsuri} = sub {
285			my ($items, $item) = @_;
286
287			unless ($item->{parent}->has_attribute ('title')) {
288			$item->{parent}->set_attribute
289			(title => '<' . $item->{node}->text_content . '>');
290			}
291			};
292
293			$templates->{(HTML_NS)}->{q} = sub {
294			my ($items, $item) = @_;
295
296			my $el = $item->{doc}->create_element_ns
297			(HTML_NS, $item->{node}->manakai_local_name);
298			$item->{parent}->append_child ($el);
299
300			my $class = $item->{node}->get_attribute ('class');
301			$el->set_attribute (class => $class) if defined $class;
302
303			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
304			$el->set_attribute (lang => $lang) if defined $lang;
305
306			if ($item->{node}->has_attribute_ns (SW09_NS, 'resScheme')) {
307			## TODO: ...
308			}
309
310			unshift @$items,
311			map {{%$item, node => $_, parent => $el}}
312			@{$item->{node}->child_nodes};
313			};
314			$templates->{(HTML_NS)}->{del} = $templates->{(HTML_NS)}->{q};
315			$templates->{(HTML_NS)}->{ins} = $templates->{(HTML_NS)}->{q};
316
317			$templates->{(SW09_NS)}->{rubyb} = sub {
318			my ($items, $item) = @_;
319
320			my $el = $item->{doc}->create_element_ns (HTML_NS, 'ruby');
321			$item->{parent}->append_child ($el);
322
323			my $class = $item->{node}->get_attribute ('class');
324			$class //= '';
325			$class .= ' sw-rubyb';
326			$el->set_attribute (class => $class);
327
328			my $lang = $item->{node}->get_attribute_ns (XML_NS, 'lang');
329			$el->set_attribute (lang => $lang) if defined $lang;
330
331			unshift @$items,
332			map {{%$item, node => $_, parent => $el}}
333			@{$item->{node}->child_nodes};
334			};
335
336			$templates->{(SW09_NS)}->{anchor} = sub {
337			my ($items, $item) = @_;
338
339			my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
340			$item->{parent}->append_child ($el);
341			$el->set_attribute (class => 'sw-anchor');
342
343			my $name = $item->{node}->text_content;
344			if ($name eq '//') {
345			$name = 'HomePage'; ## Don't use $homepage_name - this is not configurable
346			} elsif ($name =~ s!^\.//!!) {
347			$name = $item->{name} . '//' . $name;
348			} elsif ($name =~ s!^\.\.//!!) {
349			my $pname = $item->{name};
350			$pname =~ s<//(?:(?!//).)+$><>;
351			$name = $pname . '//' . $name;
352			}
353
354			$name =~ s/\s+/ /g;
355			$name =~ s/^ //;
356			$name =~ s/ $//;
357			$name = 'HomePage' unless length $name;
358
359			my $url = $item->{name_to_url}->($name, $item->{name});
360
361			my $anchor = $item->{node}->get_attribute_ns (SW09_NS, 'anchor');
362			if (defined $anchor) {
363			$url .= '#anchor-' . $anchor;
364			my $t = $item->{doc}->create_text_node (' (>>' . $anchor . ')');
365			unshift @$items, {%$item, node => $t, parent => $el};
366			}
367
368			$el->set_attribute (href => $url);
369
370			unshift @$items,
371			map {{%$item, node => $_, parent => $el}}
372			@{$item->{node}->child_nodes};
373			};
374
375			$templates->{(SW09_NS)}->{'anchor-internal'} = sub {
376			my ($items, $item) = @_;
377
378			my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
379			$item->{parent}->append_child ($el);
380			$el->set_attribute (class => 'sw-anchor-internal');
381
382			my $id = $item->{node}->get_attribute_ns (SW09_NS, 'anchor') + 0;
383			$el->set_attribute (href => '#anchor-' . $id);
384
385			unshift @$items,
386			map {{%$item, node => $_, parent => $el}}
387			@{$item->{node}->child_nodes};
388			};
389
390			$templates->{(SW09_NS)}->{'anchor-end'} = sub {
391			my ($items, $item) = @_;
392
393			my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
394			$item->{parent}->append_child ($el);
395			$el->set_attribute (class => 'sw-anchor-end');
396
397			my $id = $item->{node}->get_attribute_ns (SW09_NS, 'anchor') + 0;
398			$el->set_attribute (id => 'anchor-' . $id);
399
400			unshift @$items,
401			map {{%$item, node => $_, parent => $el}}
402			@{$item->{node}->child_nodes};
403			};
404
405			$templates->{(SW09_NS)}->{'anchor-external'} = sub {
406			my ($items, $item) = @_;
407
408			$item->{parent}->manakai_append_text ('<');
409
410			my $el = $item->{doc}->create_element_ns (HTML_NS, 'a');
411			$item->{parent}->append_child ($el);
412			$el->set_attribute (class => 'sw-anchor-external');
413
414			$item->{parent}->manakai_append_text ('>');
415
416			my $scheme = $item->{node}->get_attribute_ns (SW09_NS, 'resScheme');
417			if ($scheme eq 'URI' or $scheme eq 'URL') {
418			$el->set_attribute
419			(href => $item->{node}->get_attribute_ns (SW09_NS, 'resParameter'));
420			} else {
421			## TODO: ...
422			}
423
424			unshift @$items,
425			map {{%$item, node => $_, parent => $el}}
426			@{$item->{node}->child_nodes};
427			};
428
429	wakaba	1.2	$templates->{(SW09_NS)}->{image} = sub {
430			my ($items, $item) = @_;
431
432			my $el = $item->{doc}->create_element_ns (HTML_NS, 'div');
433			$el->set_attribute (class => 'article sw-image');
434			$item->{parent}->append_child ($el);
435
436			my $type;
437			my $alt;
438			my $head_el = $item->{node}->owner_document->manakai_head;
439			if ($head_el) {
440			for (@{$head_el->child_nodes}) {
441			next if $_->node_type != $_->ELEMENT_NODE;
442			next if ($_->namespace_uri // '') ne SW09_NS;
443			next if $_->manakai_local_name ne 'parameter';
444			my $name = $_->get_attribute ('name');
445			if ($name eq 'image-type' or $name eq 'image-alt') {
446			for (@{$_->child_nodes}) {
447			next if $_->node_type != $_->ELEMENT_NODE;
448			next if ($_->namespace_uri // '') ne SW09_NS;
449			next if $_->manakai_local_name ne 'value';
450			if ($name eq 'image-type') {
451			$type //= $_->text_content;
452			} elsif ($name eq 'image-alt') {
453			$alt //= $_->text_content;
454			}
455			last;
456			}
457			last if defined $type and defined $alt;
458			}
459			}
460			}
461			$type //= 'application/octet-stream';
462			$type =~ tr{a-zA-Z0-9.+-_/-}{}cd;
463			## NOTE: '!', '#', '$', '&', '^' are also allowed according to RFC 4288.
464
465			my $data = $item->{node}->text_content;
466			$data =~ s/\s+//g;
467
468			my $img_el = $item->{doc}->create_element_ns (HTML_NS, 'img');
469			$img_el->set_attribute (alt => $alt // '');
470			$img_el->set_attribute (src => 'data:' . $type . ';base64,' . $data);
471			$el->append_child ($img_el);
472			};
473
474	wakaba	1.3	$templates->{(SW09_NS)}->{replace} = sub {
475			my ($items, $item) = @_;
476
477			my $el = $item->{doc}->create_element_ns (HTML_NS, 'span');
478			$el->set_attribute (class => 'sw-replace');
479			$el->text_content ($item->{node}->get_attribute ('by') // '');
480			$item->{parent}->append_child ($el);
481			};
482
483	wakaba	1.1	sub convert ($$$$$) {
484			shift;
485			my $name = shift;
486			my $swml = shift;
487			my $doc = shift;
488			my $name_to_url = shift;
489
490			my $article_el = $doc->create_element_ns (HTML_NS, 'div');
491			$article_el->set_attribute (class => 'article');
492
493			my @items = map {{doc => $doc,
494			name_to_url => $name_to_url,
495			heading_level => 1, name => $name,
496			node => $_, parent => $article_el}} @{$swml->child_nodes};
497			while (@items) {
498			my $item = shift @items;
499			my $nsuri = $item->{node}->namespace_uri // '';
500			my $ln = $item->{node}->manakai_local_name // '';
501			my $template = $templates->{$nsuri}->{$ln} \|\| $templates->{''}->{''};
502			$template->(\@items, $item);
503			}
504
505			return $article_el;
506			} # convert_swml_to_html
507
508			1;