XML/Serialize/HTML.pm


=head1 NAME

Message::Markup::XML::Serialize::HTML - HTML Serializer

=head1 DESCRIPTION

C<Message::Markup::XML::Serialize::HTML> provides a function
that serizlizes a node (C<Message::Markup::XML::Node> object)
as a (fragment of) HTML document.

This module is part of manakai.

=cut

package Message::Markup::XML::Serialize::HTML;
use strict;
our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

=head1 METHODS

=over 4

=item $html = Message::Markup::XML::Serizlize::HTML::html_simple ($node, [%option])

Serialize C<$node> as an HTML tree and return it.

This serializer does not check:

=over 2

=item whether element type names, attribute names, attribute values or entity names are valid as HTML

=item XML namespace to which C<$node> belongs

=item whether C<$node> occurs in valid context

=item uniqueness of attribute name

=back

And this serializer does not output processing instructions whose
first three characters is 'xml'.  It neither does output any markup declaration
(except comment declaration), including DOCTYPE declaration.
Marked section is not implemented and its content is barely included
as regular data.

This serializer does not output end tag for some element types,
such as C<link> or C<base>.  Element types C<style> and C<script>
is treated as C<CDATA> content.

=cut

sub html_simple ($;%) {
  my ($node, %opt) = @_;
  my $r = '';
  for my $node_type ($node->node_type) {
    if ($node_type eq '#element') {
      my $element_type = $node->local_name;
      if ({qw/img 1 link 1 base 1 meta 1 area 1 br 1 hr 1
              param 1 input 1 basefont 1 wbr 1 isindex 1 nextid 1
             /}->{$element_type}) {
        $r .= ____start_tag ($node, %opt, local_name => $element_type);
      } elsif ({qw/style 1 script 1/}->{$element_type}) {
        my $content = $node->inner_text;
        $content =~ s!</!&lt;/!g;
        $r .= ____start_tag ($node, %opt, local_name => $element_type)
            . $content
            . '</' . $element_type . '>';
      } else {
        $r .= ____start_tag ($node, %opt, local_name => $element_type);
        for (@{$node->child_nodes}) {
          my $nt = $_->node_type;
          if ($nt eq '#text') {
            $r .= ____escape ($_->value);
          } elsif ($nt ne '#attribute') {
            $r .= html_simple ($_, %opt);
          }
        }
        $r .= '</' . $element_type . '>';
      }
    } elsif ($node_type eq '#text') {
      $r .= ____escape ($node->value);
    } elsif ($node_type eq '#attribute') {
    } elsif ($node_type eq '#comment') {
      my $content = $node->value;
      $content =~ s!--!- - !g;
      $content =~ s!-$!- !;
      $r .= '<!--' . $content . '-->';
    } elsif ($node_type eq '#pi') {
      my $name = $node->local_name;
      unless (substr ($name, 0, 3) eq 'xml') {
        my $content = $node->inner_xml;
        $content =~ s!\?>!?&gt;!g;
        $r .= '<?' . $name . ' ' . $content . '?>';
      }
    } elsif ($node_type eq '#reference') {
      $r .= $node->stringify;
    } elsif ($node_type eq '#declaration') {
    } elsif ($node_type eq '#xml') {
      $r .= $node->outer_xml;
    } else {
      for (@{$node->child_nodes}) {
        $r .= html_simple ($_, %opt) unless $_->node_type eq '#attribute';
      }
    }
  }
  $r;
}

sub ____start_tag ($;%) {
  my ($node, %opt) = @_;
  my $r = '<' . $opt{local_name};
  for (grep {$_->node_type eq '#attribute'} @{$node->child_nodes}) {
    $r .= ' ' . $_->local_name . '="' . ____escape ($_->inner_text) . '"';
  }
  $r . '>';
}

sub ____escape ($;%) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/>/&gt;/g;
  $s =~ s/"/&quot;/g;
  $s;
}

=back

=head1 SEE ALSO

C<Message::Markup::XML::Node>

=head1 LICENSE

Copyright 2004 Wakaba <[email protected]>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2004/06/03 06:41:18 $
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	our $VERSION = do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
19
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 . '-->';
90	} elsif ($node_type eq '#pi') {
91	my $name = $node->local_name;
92	unless (substr ($name, 0, 3) eq 'xml') {
93	my $content = $node->inner_xml;
94	$content =~ s!\?>!?>!g;
95	$r .= '<?' . $name . ' ' . $content . '?>';
96	}
97	} elsif ($node_type eq '#reference') {
98	$r .= $node->stringify;
99	} elsif ($node_type eq '#declaration') {
100	} elsif ($node_type eq '#xml') {
101	$r .= $node->outer_xml;
102	} else {
103	for (@{$node->child_nodes}) {
104	$r .= html_simple ($_, %opt) unless $_->node_type eq '#attribute';
105	}
106	}
107	}
108	$r;
109	}
110
111	sub ____start_tag ($;%) {
112	my ($node, %opt) = @_;
113	my $r = '<' . $opt{local_name};
114	for (grep {$_->node_type eq '#attribute'} @{$node->child_nodes}) {
115	$r .= ' ' . $_->local_name . '="' . ____escape ($_->inner_text) . '"';
116	}
117	$r . '>';
118	}
119
120	sub ____escape ($;%) {
121	my $s = shift;
122	$s =~ s/&/&/g;
123	$s =~ s/</</g;
124	$s =~ s/>/>/g;
125	$s =~ s/"/"/g;
126	$s;
127	}
128
129	=back
130
131	=head1 SEE ALSO
132
133	C<Message::Markup::XML::Node>
134
135	=head1 LICENSE
136
137	Copyright 2004 Wakaba <[email protected]>
138
139	This program is free software; you can redistribute it and/or
140	modify it under the same terms as Perl itself.
141
142	=cut
143
144	1; # $Date: 2004/06/03 06:41:18 $