Parent Directory
| 
Revision Log
#xml node supported
| 1 | wakaba | 1.1 | |
| 2 | =head1 NAME | ||
| 3 | |||
| 4 | Message::Markup::XML::Serialize::HTML - HTML Serializer | ||
| 5 | |||
| 6 | =head1 DESCRIPTION | ||
| 7 | |||
| 8 | C<Message::Markup::XML::Serialize::HTML> provides a function | ||
| 9 | that serizlizes a node (C<Message::Markup::XML::Node> object) | ||
| 10 | as a (fragment of) HTML document. | ||
| 11 | |||
| 12 | This module is part of manakai. | ||
| 13 | |||
| 14 | =cut | ||
| 15 | |||
| 16 | package Message::Markup::XML::Serialize::HTML; | ||
| 17 | use strict; | ||
| 18 | wakaba | 1.2 | our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
| 19 | wakaba | 1.1 | |
| 20 | =head1 METHODS | ||
| 21 | |||
| 22 | =over 4 | ||
| 23 | |||
| 24 | =item $html = Message::Markup::XML::Serizlize::HTML::html_simple ($node, [%option]) | ||
| 25 | |||
| 26 | Serialize C<$node> as an HTML tree and return it. | ||
| 27 | |||
| 28 | This serializer does not check: | ||
| 29 | |||
| 30 | =over 2 | ||
| 31 | |||
| 32 | =item whether element type names, attribute names, attribute values or entity names are valid as HTML | ||
| 33 | |||
| 34 | =item XML namespace to which C<$node> belongs | ||
| 35 | |||
| 36 | =item whether C<$node> occurs in valid context | ||
| 37 | |||
| 38 | =item uniqueness of attribute name | ||
| 39 | |||
| 40 | =back | ||
| 41 | |||
| 42 | And this serializer does not output processing instructions whose | ||
| 43 | first three characters is 'xml'. It neither does output any markup declaration | ||
| 44 | (except comment declaration), including DOCTYPE declaration. | ||
| 45 | Marked section is not implemented and its content is barely included | ||
| 46 | as regular data. | ||
| 47 | |||
| 48 | This serializer does not output end tag for some element types, | ||
| 49 | such as C<link> or C<base>. Element types C<style> and C<script> | ||
| 50 | is treated as C<CDATA> content. | ||
| 51 | |||
| 52 | =cut | ||
| 53 | |||
| 54 | sub html_simple ($;%) { | ||
| 55 | my ($node, %opt) = @_; | ||
| 56 | my $r = ''; | ||
| 57 | for my $node_type ($node->node_type) { | ||
| 58 | if ($node_type eq '#element') { | ||
| 59 | my $element_type = $node->local_name; | ||
| 60 | if ({qw/img 1 link 1 base 1 meta 1 area 1 br 1 hr 1 | ||
| 61 | param 1 input 1 basefont 1 wbr 1 isindex 1 nextid 1 | ||
| 62 | /}->{$element_type}) { | ||
| 63 | $r .= ____start_tag ($node, %opt, local_name => $element_type); | ||
| 64 | } elsif ({qw/style 1 script 1/}->{$element_type}) { | ||
| 65 | my $content = $node->inner_text; | ||
| 66 | $content =~ s!</!</!g; | ||
| 67 | $r .= ____start_tag ($node, %opt, local_name => $element_type) | ||
| 68 | . $content | ||
| 69 | . '</' . $element_type . '>'; | ||
| 70 | } else { | ||
| 71 | $r .= ____start_tag ($node, %opt, local_name => $element_type); | ||
| 72 | for (@{$node->child_nodes}) { | ||
| 73 | my $nt = $_->node_type; | ||
| 74 | if ($nt eq '#text') { | ||
| 75 | $r .= ____escape ($_->value); | ||
| 76 | } elsif ($nt ne '#attribute') { | ||
| 77 | $r .= html_simple ($_, %opt); | ||
| 78 | } | ||
| 79 | } | ||
| 80 | $r .= '</' . $element_type . '>'; | ||
| 81 | } | ||
| 82 | } elsif ($node_type eq '#text') { | ||
| 83 | $r .= ____escape ($node->value); | ||
| 84 | } elsif ($node_type eq '#attribute') { | ||
| 85 | } elsif ($node_type eq '#comment') { | ||
| 86 | my $content = $node->value; | ||
| 87 | $content =~ s!--!- - !g; | ||
| 88 | $content =~ s!-$!- !; | ||
| 89 | $r .= '<!--' . $content . '-->'; | ||