Whatpm/HTML/Dumper.pm

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

require Exporter;
push our @ISA, 'Exporter';

our @EXPORT = qw(dumptree);

sub dumptree ($) {
  my $node = shift;
  my $r = '';

  my $ns_id = {
    q<http://www.w3.org/1999/xhtml> => 'html',
    q<http://www.w3.org/2000/svg> => 'svg',
    q<http://www.w3.org/1998/Math/MathML> => 'math',
    q<http://www.w3.org/1999/xlink> => 'xlink',
    q<http://www.w3.org/XML/1998/namespace> => 'xml',
    q<http://www.w3.org/2000/xmlns/> => 'xmlns',
  };

  my @node = map { [$_, ''] } @{$node->child_nodes};
  while (@node) {
    my $child = shift @node;
    my $nt = $child->[0]->node_type;
    if ($nt == $child->[0]->ELEMENT_NODE) {
      my $ns = $child->[0]->namespace_uri;
      unless (defined $ns) {
        $ns = '{} ';
      } elsif ($ns eq q<http://www.w3.org/1999/xhtml>) {
        $ns = '';
      } elsif ($ns_id->{$ns}) {
        $ns = $ns_id->{$ns} . ' ';
      } else {
        $ns = '{' . $ns . '} ';
      }
      $r .= $child->[1] . '<' . $ns . $child->[0]->manakai_local_name . ">\x0A";

      for my $attr (sort {$a->[0] cmp $b->[0]} map { [do {
                      my $ns = $_->namespace_uri;
                      unless (defined $ns) {
                        $ns = '';
                      } elsif ($ns_id->{$ns}) {
                        $ns = $ns_id->{$ns} . ' ';
                      } else {
                        $ns = '{' . $ns . '} ';
                      }
                      $ns . $_->manakai_local_name;
                    }, $_->value] }
                    @{$child->[0]->attributes}) {
        $r .= $child->[1] . '  ' . $attr->[0] . '="'; ## ISSUE: case?
        $r .= $attr->[1] . '"' . "\x0A";
      }
      
      unshift @node,
        map { [$_, $child->[1] . '  '] } @{$child->[0]->child_nodes};
    } elsif ($nt == $child->[0]->TEXT_NODE) {
      $r .= $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
    } elsif ($nt == $child->[0]->COMMENT_NODE) {
      $r .= $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";
    } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
      $r .= $child->[1] . '<!DOCTYPE ' . $child->[0]->name;
      my $pubid = $child->[0]->public_id;
      my $sysid = $child->[0]->system_id;
      if (length $pubid or length $sysid) {
        $r .= ' "' . $pubid . '"';
        $r .= ' "' . $sysid . '"';
      }
      $r .= ">\x0A";
      unshift @node,
        map { [$_, $child->[1] . '  '] } @{$child->[0]->child_nodes};
    } elsif ($nt == $child->[0]->PROCESSING_INSTRUCTION_NODE) {
      $r .= $child->[1] . '<?' . $child->[0]->target . ' ';
      $r .= $child->[0]->data . "?>\x0A";
    } else {
      $r .= $child->[1] . $child->[0]->node_type . "\x0A"; # error
    }
  }
  
  return $r;
} # dumptree

## NOTE: Based on <http://wiki.whatwg.org/wiki/Parser_tests>.
## TDOO: Document

1;
## $Date: 2008/10/14 07:49:55 $
1	wakaba	1.1	package Whatpm::HTML::Dumper;
2			use strict;
3	wakaba	1.2	our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.1
5			require Exporter;
6			push our @ISA, 'Exporter';
7
8			our @EXPORT = qw(dumptree);
9
10			sub dumptree ($) {
11			my $node = shift;
12			my $r = '';
13
14			my $ns_id = {
15			q<http://www.w3.org/1999/xhtml> => 'html',
16			q<http://www.w3.org/2000/svg> => 'svg',
17			q<http://www.w3.org/1998/Math/MathML> => 'math',
18			q<http://www.w3.org/1999/xlink> => 'xlink',
19			q<http://www.w3.org/XML/1998/namespace> => 'xml',
20	wakaba	1.2	q<http://www.w3.org/2000/xmlns/> => 'xmlns',
21	wakaba	1.1	};
22
23			my @node = map { [$_, ''] } @{$node->child_nodes};
24			while (@node) {
25			my $child = shift @node;
26			my $nt = $child->[0]->node_type;
27			if ($nt == $child->[0]->ELEMENT_NODE) {
28			my $ns = $child->[0]->namespace_uri;
29			unless (defined $ns) {
30			$ns = '{} ';
31			} elsif ($ns eq q<http://www.w3.org/1999/xhtml>) {
32			$ns = '';
33			} elsif ($ns_id->{$ns}) {
34			$ns = $ns_id->{$ns} . ' ';
35			} else {
36			$ns = '{' . $ns . '} ';
37			}
38			$r .= $child->[1] . '<' . $ns . $child->[0]->manakai_local_name . ">\x0A";
39
40			for my $attr (sort {$a->[0] cmp $b->[0]} map { [do {
41			my $ns = $_->namespace_uri;
42			unless (defined $ns) {
43			$ns = '';
44			} elsif ($ns_id->{$ns}) {
45			$ns = $ns_id->{$ns} . ' ';
46			} else {
47			$ns = '{' . $ns . '} ';
48			}
49			$ns . $_->manakai_local_name;
50			}, $_->value] }
51			@{$child->[0]->attributes}) {
52			$r .= $child->[1] . ' ' . $attr->[0] . '="'; ## ISSUE: case?
53			$r .= $attr->[1] . '"' . "\x0A";
54			}
55
56			unshift @node,
57			map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes};
58			} elsif ($nt == $child->[0]->TEXT_NODE) {
59			$r .= $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
60			} elsif ($nt == $child->[0]->COMMENT_NODE) {
61			$r .= $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";
62			} elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
63			$r .= $child->[1] . '<!DOCTYPE ' . $child->[0]->name;
64			my $pubid = $child->[0]->public_id;
65			my $sysid = $child->[0]->system_id;
66			if (length $pubid or length $sysid) {
67			$r .= ' "' . $pubid . '"';
68			$r .= ' "' . $sysid . '"';
69			}
70			$r .= ">\x0A";
71			unshift @node,
72			map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes};
73			} elsif ($nt == $child->[0]->PROCESSING_INSTRUCTION_NODE) {
74			$r .= $child->[1] . '<?' . $child->[0]->target . ' ';
75			$r .= $child->[0]->data . "?>\x0A";
76			} else {
77			$r .= $child->[1] . $child->[0]->node_type . "\x0A"; # error
78			}
79			}
80
81			return $r;
82			} # dumptree
83
84			## NOTE: Based on <http://wiki.whatwg.org/wiki/Parser_tests>.
85			## TDOO: Document
86
87			1;
88	wakaba	1.2	## $Date: 2008/10/14 07:49:55 $