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	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 . '-->';
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	wakaba	1.2	} elsif ($node_type eq '#xml') {
101			$r .= $node->outer_xml;
102	wakaba	1.1	} 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	wakaba	1.2	1; # $Date: 2004/06/03 06:41:18 $