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.6 $=~/\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') {
    } 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/02/14 11:08:14 $
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			our $VERSION = do{my @r=(q$Revision: 1.6 $=~/\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			} else {
101			for (@{$node->child_nodes}) {
102			$r .= html_simple ($_, %opt) unless $_->node_type eq '#attribute';
103			}
104			}
105			}
106			$r;
107			}
108
109			sub ____start_tag ($;%) {
110			my ($node, %opt) = @_;
111			my $r = '<' . $opt{local_name};
112			for (grep {$_->node_type eq '#attribute'} @{$node->child_nodes}) {
113			$r .= ' ' . $_->local_name . '="' . ____escape ($_->inner_text) . '"';
114			}
115			$r . '>';
116			}
117
118			sub ____escape ($;%) {
119			my $s = shift;
120			$s =~ s/&/&/g;
121			$s =~ s/</</g;
122			$s =~ s/>/>/g;
123			$s =~ s/"/"/g;
124			$s;
125			}
126
127			=back
128
129			=head1 SEE ALSO
130
131			C<Message::Markup::XML::Node>
132
133			=head1 LICENSE
134
135			Copyright 2004 Wakaba <[email protected]>
136
137			This program is free software; you can redistribute it and/or
138			modify it under the same terms as Perl itself.
139
140			=cut
141
142			1; # $Date: 2004/02/14 11:08:14 $