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	package Whatpm::HTML::Dumper;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4
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	q<http://www.w3.org/2000/xmlns/> => 'xmlns',
21	};
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	## $Date: 2008/10/14 07:49:55 $