whatpm/Whatpm/NanoDOM.pm

=head1 NAME

Whatpm::NanoDOM - A Non-Conforming Implementation of DOM Subset

=head1 DESCRIPTION

The C<Whatpm::NanoDOM> module contains a non-conforming implementation
of a subset of DOM.  It is the intention that this module is
used only for the purpose of testing the C<Whatpm::HTML> module.

See source code if you would like to know what it does.

=cut

package Whatpm::NanoDOM;
use strict;

require Scalar::Util;

package Whatpm::NanoDOM::DOMImplementation;

sub create_document ($) {
  return Whatpm::NanoDOM::Document->new;
} # create_document

package Whatpm::NanoDOM::Node;

sub new ($) {
  my $class = shift;
  my $self = bless {}, $class;
  return $self;
} # new

sub parent_node ($) {
  return shift->{parent_node};
} # parent_node

sub manakai_parent_element ($) {
  my $self = shift;
  my $parent = $self->{parent_node};
  while (defined $parent) {
    if ($parent->node_type == 1) {
      return $parent;
    } else {
      $parent = $parent->{parent_node};
    }
  }
  return undef;
} # manakai_parent_element

sub child_nodes ($) {
  return shift->{child_nodes} || [];
} # child_nodes

## NOTE: Only applied to Elements and Documents
sub append_child ($$) {
  my ($self, $new_child) = @_;
  if (defined $new_child->{parent_node}) {
    my $parent_list = $new_child->{parent_node}->{child_nodes};
    for (0..$#$parent_list) {
      if ($parent_list->[$_] eq $new_child) {
        splice @$parent_list, $_, 1;
      }
    }
  }
  push @{$self->{child_nodes}}, $new_child;
  $new_child->{parent_node} = $self;
  Scalar::Util::weaken ($new_child->{parent_node});
  return $new_child;
} # append_child

## NOTE: Only applied to Elements and Documents
sub insert_before ($$;$) {
  my ($self, $new_child, $ref_child) = @_;
  if (defined $new_child->{parent_node}) {
    my $parent_list = $new_child->{parent_node}->{child_nodes};
    for (0..$#$parent_list) {
      if ($parent_list->[$_] eq $new_child) {
        splice @$parent_list, $_, 1;
      }
    }
  }
  my $i = @{$self->{child_nodes}};
  if (defined $ref_child) {
    for (0..$#{$self->{child_nodes}}) {
      if ($self->{child_nodes}->[$_] eq $ref_child) {
        $i = $_;
        last;
      }
    }
  }
  splice @{$self->{child_nodes}}, $i, 0, $new_child;
  $new_child->{parent_node} = $self;
  Scalar::Util::weaken ($new_child->{parent_node});
  return $new_child;
} # insert_before

## NOTE: Only applied to Elements and Documents
sub remove_child ($$) {
  my ($self, $old_child) = @_;
  my $parent_list = $self->{child_nodes};
  for (0..$#$parent_list) {
    if ($parent_list->[$_] eq $old_child) {
      splice @$parent_list, $_, 1;
    }
  }
  delete $old_child->{parent_node};
  return $old_child;
} # remove_child

## NOTE: Only applied to Elements and Documents
sub has_child_nodes ($) {
  return @{shift->{child_nodes}} > 0;
} # has_child_nodes

## NOTE: Only applied to Elements and Documents
sub first_child ($) {
  my $self = shift;
  return $self->{child_nodes}->[0];
} # first_child

## NOTE: Only applied to Elements and Documents
sub last_child ($) {
  my $self = shift;
  return @{$self->{child_nodes}} ? $self->{child_nodes}->[-1] : undef;
} # last_child

## NOTE: Only applied to Elements and Documents
sub previous_sibling ($) {
  my $self = shift;
  my $parent = $self->{parent_node};
  return undef unless defined $parent;
  my $r;
  for (@{$parent->{child_nodes}}) {
    if ($_ eq $self) {
      return $r;
    } else {
      $r = $_;
    }
  }
  return undef;
} # previous_sibling

sub prefix ($;$) {
  my $self = shift;
  if (@_) {
    $self->{prefix} = shift;
  }
  return $self->{prefix};
} # prefix

sub ELEMENT_NODE () { 1 }
sub ATTRIBUTE_NODE () { 2 }
sub TEXT_NODE () { 3 }
sub CDATA_SECTION_NODE () { 4 }
sub ENTITY_REFERENCE_NODE () { 5 }
sub ENTITY_NODE () { 6 }
sub PROCESSING_INSTRUCTION_NODE () { 7 }
sub COMMENT_NODE () { 8 }
sub DOCUMENT_NODE () { 9 }
sub DOCUMENT_TYPE_NODE () { 10 }
sub DOCUMENT_FRAGMENT_NODE () { 11 }
sub NOTATION_NODE () { 12 }

package Whatpm::NanoDOM::Document;
push our @ISA, 'Whatpm::NanoDOM::Node';

sub new ($) {
  my $self = shift->SUPER::new;
  $self->{child_nodes} = [];
  return $self;
} # new

## A manakai extension
sub manakai_append_text ($$) {
  my $self = shift;
  if (@{$self->{child_nodes}} and
      $self->{child_nodes}->[-1]->node_type == 3) {
    $self->{child_nodes}->[-1]->manakai_append_text (shift);
  } else {
    my $text = $self->create_text_node (shift);
    $self->append_child ($text);
  }
} # manakai_append_text

sub node_type () { 9 }

sub strict_error_checking {
  return 0;
} # strict_error_checking

sub create_text_node ($$) {
  shift;
  return Whatpm::NanoDOM::Text->new (shift);
} # create_text_node

sub create_comment ($$) {
  shift;
  return Whatpm::NanoDOM::Comment->new (shift);
} # create_comment

## The second parameter only supports manakai extended way
## to specify qualified name - "[$prefix, $local_name]"
sub create_element_ns ($$$) {
  my ($self, $nsuri, $qn) = @_;
  return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]);
} # create_element_ns

## A manakai extension
sub create_document_type_definition ($$) {
  shift;
  return Whatpm::NanoDOM::DocumentType->new (shift);
} # create_document_type_definition

sub implementation ($) {
  return 'Whatpm::NanoDOM::DOMImplementation';
} # implementation

sub document_element ($) {
  my $self = shift;
  for (@{$self->child_nodes}) {
    if ($_->node_type == 1) {
      return $_;
    }
  }
  return undef;
} # document_element

sub adopt_node ($$) {
  my @node = ($_[1]);
  while (@node) {
    my $node = shift @node;
    $node->{owner_document} = $_[0];
    Scalar::Util::weaken ($node->{owner_document});
    push @node, @{$node->child_nodes};
    push @node, @{$node->attributes or []} if $node->can ('attributes');
  }
  return $_[1];
} # adopt_node

sub manakai_is_html ($;$) {
  if (@_ > 1) {
    if ($_[1]) {
      $_[0]->{manakai_is_html} = 1;
    } else {
      delete $_[0]->{manakai_compat_mode};
    }
  }
  return $_[0]->{manakai_is_html};
} # manakai_is_html

sub compat_mode ($) {
  if ($_[0]->{manakai_is_html}) {
    if ($_[0]->{manakai_compat_mode} eq 'quirks') {
      return 'BackCompat';
    }
  }
  return 'CSS1Compat';
} # compat_mode

sub manakai_compat_mode ($;$) {
  if ($_[0]->{manakai_is_html}) {
    if (@_ > 1 and defined $_[1] and
        {'no quirks' => 1, 'limited quirks' => 1, 'quirks' => 1}->{$_[1]}) {
      $_[0]->{manakai_compat_mode} = $_[1];
    }
    return $_[0]->{manakai_compat_mode} || 'no quirks';
  } else {
    return 'no quirks';
  }
} # manakai_compat_mode

package Whatpm::NanoDOM::Element;
push our @ISA, 'Whatpm::NanoDOM::Node';

sub new ($$$$$) {
  my $self = shift->SUPER::new;
  $self->{owner_document} = shift;
  Scalar::Util::weaken ($self->{owner_document});
  $self->{namespace_uri} = shift;
  $self->{prefix} = shift;
  $self->{local_name} = shift;
  $self->{attributes} = {};
  $self->{child_nodes} = [];
  return $self;
} # new

sub owner_document ($) {
  return shift->{owner_document};
} # owner_document

sub clone_node ($$) {
  my ($self, $deep) = @_; ## NOTE: Deep cloning is not supported
  my $clone = bless {
    namespace_uri => $self->{namespace_uri},
    prefix => $self->{prefix},
    local_name => $self->{local_name},      
    child_nodes => [],
  }, ref $self;
  for my $ns (keys %{$self->{attributes}}) {
    for my $ln (keys %{$self->{attributes}->{$ns}}) {
      my $attr = $self->{attributes}->{$ns}->{$ln};
      $clone->{attributes}->{$ns}->{$ln} = bless {
        namespace_uri => $attr->{namespace_uri},
        prefix => $attr->{prefix},
        local_name => $attr->{local_name},
        value => $attr->{value},
      }, ref $self->{attributes}->{$ns}->{$ln};
    }
  }
  return $clone;
} # clone

## A manakai extension
sub manakai_append_text ($$) {
  my $self = shift;
  if (@{$self->{child_nodes}} and
      $self->{child_nodes}->[-1]->node_type == 3) {
    $self->{child_nodes}->[-1]->manakai_append_text (shift);
  } else {
    my $text = Whatpm::NanoDOM::Text->new (shift);
    $self->append_child ($text);
  }
} # manakai_append_text

sub text_content ($) {
  my $self = shift;
  my $r = '';
  for my $child (@{$self->child_nodes}) {
    if ($child->can ('data')) {
      $r .= $child->data;
    } else {
      $r .= $child->text_content;
    }
  }
  return $r;
} # text_content

sub attributes ($) {
  my $self = shift;
  my $r = [];
  ## Order MUST be stable
  for my $ns (sort {$a cmp $b} keys %{$self->{attributes}}) {
    for my $ln (sort {$a cmp $b} keys %{$self->{attributes}->{$ns}}) {
      push @$r, $self->{attributes}->{$ns}->{$ln}
        if defined $self->{attributes}->{$ns}->{$ln};
    }
  }
  return $r;
} # attributes

sub local_name ($) { # TODO: HTML5 case
  return shift->{local_name};
} # local_name

sub manakai_local_name ($) {
  return shift->{local_name}; # no case fixing for HTML5
} # manakai_local_name

sub namespace_uri ($) {
  return shift->{namespace_uri};
} # namespace_uri

sub manakai_element_type_match ($$$) {
  my ($self, $nsuri, $ln) = @_;
  if (defined $nsuri) {
    if (defined $self->{namespace_uri} and $nsuri eq $self->{namespace_uri}) {
      return ($ln eq $self->{local_name});
    } else {
      return 0;
    }
  } else {
    if (not defined $self->{namespace_uri}) {
      return ($ln eq $self->{local_name});
    } else {
      return 0;
    }
  }
} # manakai_element_type_match

sub node_type { 1 }

## TODO: HTML5 capitalization
sub tag_name ($) {
  my $self = shift;
  if (defined $self->{prefix}) {
    return $self->{prefix} . ':' . $self->{local_name};
  } else {
    return $self->{local_name};
  }
} # tag_name

sub get_attribute_ns ($$$) {
  my ($self, $nsuri, $ln) = @_;
  $nsuri = '' unless defined $nsuri;
  return defined $self->{attributes}->{$nsuri}->{$ln}
    ? $self->{attributes}->{$nsuri}->{$ln}->value : undef;
} # get_attribute_ns

sub get_attribute_node_ns ($$$) {
  my ($self, $nsuri, $ln) = @_;
  $nsuri = '' unless defined $nsuri;
  return $self->{attributes}->{$nsuri}->{$ln};
} # get_attribute_node_ns

sub has_attribute_ns ($$$) {
  my ($self, $nsuri, $ln) = @_;
  $nsuri = '' unless defined $nsuri;
  return defined $self->{attributes}->{$nsuri}->{$ln};
} # has_attribute_ns

## The second parameter only supports manakai extended way
## to specify qualified name - "[$prefix, $local_name]"
sub set_attribute_ns ($$$$) {
  my ($self, $nsuri, $qn, $value) = @_;
  $self->{attributes}->{$nsuri}->{$qn->[1]}
    = Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value);
} # set_attribute_ns

package Whatpm::NanoDOM::Attr;
push our @ISA, 'Whatpm::NanoDOM::Node';

sub new ($$$$$$) {
  my $self = shift->SUPER::new;
  $self->{owner_element} = shift;
  Scalar::Util::weaken ($self->{owner_element});
  $self->{namespace_uri} = shift;
  $self->{prefix} = shift;
  $self->{local_name} = shift;
  $self->{value} = shift;
  return $self;
} # new

sub namespace_uri ($) {
  return shift->{namespace_uri};
} # namespace_uri

sub manakai_local_name ($) {
  return shift->{local_name};
} # manakai_local_name

sub node_type { 2 }

## TODO: HTML5 case stuff?
sub name ($) {
  my $self = shift;
  if (defined $self->{prefix}) {
    return $self->{prefix} . ':' . $self->{local_name};
  } else {
    return $self->{local_name};
  }
} # name

sub value ($) {
  return shift->{value};
} # value

sub owner_element ($) {
  return shift->{owner_element};
} # owner_element

package Whatpm::NanoDOM::CharacterData;
push our @ISA, 'Whatpm::NanoDOM::Node';

sub new ($$) {
  my $self = shift->SUPER::new;
  $self->{data} = shift;
  return $self;
} # new

## A manakai extension
sub manakai_append_text ($$) {
  my ($self, $s) = @_;
  $self->{data} .= $s;
} # manakai_append_text

sub data ($) {
  return shift->{data};
} # data

package Whatpm::NanoDOM::Text;
push our @ISA, 'Whatpm::NanoDOM::CharacterData';

sub node_type () { 3 }

package Whatpm::NanoDOM::Comment;
push our @ISA, 'Whatpm::NanoDOM::CharacterData';

sub node_type () { 8 }

package Whatpm::NanoDOM::DocumentType;
push our @ISA, 'Whatpm::NanoDOM::Node';

sub new ($$) {
  my $self = shift->SUPER::new;
  $self->{name} = shift;
  return $self;
} # new

sub node_type () { 10 }

sub name ($) {
  return shift->{name};
} # name

=head1 SEE ALSO

L<Whatpm::HTML>

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

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

=cut

1;
# $Date: 2007/06/23 06:38:12 $
1	=head1 NAME
2
3	Whatpm::NanoDOM - A Non-Conforming Implementation of DOM Subset
4
5	=head1 DESCRIPTION
6
7	The C<Whatpm::NanoDOM> module contains a non-conforming implementation
8	of a subset of DOM. It is the intention that this module is
9	used only for the purpose of testing the C<Whatpm::HTML> module.
10
11	See source code if you would like to know what it does.
12
13	=cut
14
15	package Whatpm::NanoDOM;
16	use strict;
17
18	require Scalar::Util;
19
20	package Whatpm::NanoDOM::DOMImplementation;
21
22	sub create_document ($) {
23	return Whatpm::NanoDOM::Document->new;
24	} # create_document
25
26	package Whatpm::NanoDOM::Node;
27
28	sub new ($) {
29	my $class = shift;
30	my $self = bless {}, $class;
31	return $self;
32	} # new
33
34	sub parent_node ($) {
35	return shift->{parent_node};
36	} # parent_node
37
38	sub manakai_parent_element ($) {
39	my $self = shift;
40	my $parent = $self->{parent_node};
41	while (defined $parent) {
42	if ($parent->node_type == 1) {
43	return $parent;
44	} else {
45	$parent = $parent->{parent_node};
46	}
47	}
48	return undef;
49	} # manakai_parent_element
50
51	sub child_nodes ($) {
52	return shift->{child_nodes} \|\| [];
53	} # child_nodes
54
55	## NOTE: Only applied to Elements and Documents
56	sub append_child ($$) {
57	my ($self, $new_child) = @_;
58	if (defined $new_child->{parent_node}) {
59	my $parent_list = $new_child->{parent_node}->{child_nodes};
60	for (0..$#$parent_list) {
61	if ($parent_list->[$_] eq $new_child) {
62	splice @$parent_list, $_, 1;
63	}
64	}
65	}
66	push @{$self->{child_nodes}}, $new_child;
67	$new_child->{parent_node} = $self;
68	Scalar::Util::weaken ($new_child->{parent_node});
69	return $new_child;
70	} # append_child
71
72	## NOTE: Only applied to Elements and Documents
73	sub insert_before ($$;$) {
74	my ($self, $new_child, $ref_child) = @_;
75	if (defined $new_child->{parent_node}) {
76	my $parent_list = $new_child->{parent_node}->{child_nodes};
77	for (0..$#$parent_list) {
78	if ($parent_list->[$_] eq $new_child) {
79	splice @$parent_list, $_, 1;
80	}
81	}
82	}
83	my $i = @{$self->{child_nodes}};
84	if (defined $ref_child) {
85	for (0..$#{$self->{child_nodes}}) {
86	if ($self->{child_nodes}->[$_] eq $ref_child) {
87	$i = $_;
88	last;
89	}
90	}
91	}
92	splice @{$self->{child_nodes}}, $i, 0, $new_child;
93	$new_child->{parent_node} = $self;
94	Scalar::Util::weaken ($new_child->{parent_node});
95	return $new_child;
96	} # insert_before
97
98	## NOTE: Only applied to Elements and Documents
99	sub remove_child ($$) {
100	my ($self, $old_child) = @_;
101	my $parent_list = $self->{child_nodes};
102	for (0..$#$parent_list) {
103	if ($parent_list->[$_] eq $old_child) {
104	splice @$parent_list, $_, 1;
105	}
106	}
107	delete $old_child->{parent_node};
108	return $old_child;
109	} # remove_child
110
111	## NOTE: Only applied to Elements and Documents
112	sub has_child_nodes ($) {
113	return @{shift->{child_nodes}} > 0;
114	} # has_child_nodes
115
116	## NOTE: Only applied to Elements and Documents
117	sub first_child ($) {
118	my $self = shift;
119	return $self->{child_nodes}->[0];
120	} # first_child
121
122	## NOTE: Only applied to Elements and Documents
123	sub last_child ($) {
124	my $self = shift;
125	return @{$self->{child_nodes}} ? $self->{child_nodes}->[-1] : undef;
126	} # last_child
127
128	## NOTE: Only applied to Elements and Documents
129	sub previous_sibling ($) {
130	my $self = shift;
131	my $parent = $self->{parent_node};
132	return undef unless defined $parent;
133	my $r;
134	for (@{$parent->{child_nodes}}) {
135	if ($_ eq $self) {
136	return $r;
137	} else {
138	$r = $_;
139	}
140	}
141	return undef;
142	} # previous_sibling
143
144	sub prefix ($;$) {
145	my $self = shift;
146	if (@_) {
147	$self->{prefix} = shift;
148	}
149	return $self->{prefix};
150	} # prefix
151
152	sub ELEMENT_NODE () { 1 }
153	sub ATTRIBUTE_NODE () { 2 }
154	sub TEXT_NODE () { 3 }
155	sub CDATA_SECTION_NODE () { 4 }
156	sub ENTITY_REFERENCE_NODE () { 5 }
157	sub ENTITY_NODE () { 6 }
158	sub PROCESSING_INSTRUCTION_NODE () { 7 }
159	sub COMMENT_NODE () { 8 }
160	sub DOCUMENT_NODE () { 9 }
161	sub DOCUMENT_TYPE_NODE () { 10 }
162	sub DOCUMENT_FRAGMENT_NODE () { 11 }
163	sub NOTATION_NODE () { 12 }
164
165	package Whatpm::NanoDOM::Document;
166	push our @ISA, 'Whatpm::NanoDOM::Node';
167
168	sub new ($) {
169	my $self = shift->SUPER::new;
170	$self->{child_nodes} = [];
171	return $self;
172	} # new
173
174	## A manakai extension
175	sub manakai_append_text ($$) {
176	my $self = shift;
177	if (@{$self->{child_nodes}} and
178	$self->{child_nodes}->[-1]->node_type == 3) {
179	$self->{child_nodes}->[-1]->manakai_append_text (shift);
180	} else {
181	my $text = $self->create_text_node (shift);
182	$self->append_child ($text);
183	}
184	} # manakai_append_text
185
186	sub node_type () { 9 }
187
188	sub strict_error_checking {
189	return 0;
190	} # strict_error_checking
191
192	sub create_text_node ($$) {
193	shift;
194	return Whatpm::NanoDOM::Text->new (shift);
195	} # create_text_node
196
197	sub create_comment ($$) {
198	shift;
199	return Whatpm::NanoDOM::Comment->new (shift);
200	} # create_comment
201
202	## The second parameter only supports manakai extended way
203	## to specify qualified name - "[$prefix, $local_name]"
204	sub create_element_ns ($$$) {
205	my ($self, $nsuri, $qn) = @_;
206	return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]);
207	} # create_element_ns
208
209	## A manakai extension
210	sub create_document_type_definition ($$) {
211	shift;
212	return Whatpm::NanoDOM::DocumentType->new (shift);
213	} # create_document_type_definition
214
215	sub implementation ($) {
216	return 'Whatpm::NanoDOM::DOMImplementation';
217	} # implementation
218
219	sub document_element ($) {
220	my $self = shift;
221	for (@{$self->child_nodes}) {
222	if ($_->node_type == 1) {
223	return $_;
224	}
225	}
226	return undef;
227	} # document_element
228
229	sub adopt_node ($$) {
230	my @node = ($_[1]);
231	while (@node) {
232	my $node = shift @node;
233	$node->{owner_document} = $_[0];
234	Scalar::Util::weaken ($node->{owner_document});
235	push @node, @{$node->child_nodes};
236	push @node, @{$node->attributes or []} if $node->can ('attributes');
237	}
238	return $_[1];
239	} # adopt_node
240
241	sub manakai_is_html ($;$) {
242	if (@_ > 1) {
243	if ($_[1]) {
244	$_[0]->{manakai_is_html} = 1;
245	} else {
246	delete $_[0]->{manakai_compat_mode};
247	}
248	}
249	return $_[0]->{manakai_is_html};
250	} # manakai_is_html
251
252	sub compat_mode ($) {
253	if ($_[0]->{manakai_is_html}) {
254	if ($_[0]->{manakai_compat_mode} eq 'quirks') {
255	return 'BackCompat';
256	}
257	}
258	return 'CSS1Compat';
259	} # compat_mode
260
261	sub manakai_compat_mode ($;$) {
262	if ($_[0]->{manakai_is_html}) {
263	if (@_ > 1 and defined $_[1] and
264	{'no quirks' => 1, 'limited quirks' => 1, 'quirks' => 1}->{$_[1]}) {
265	$_[0]->{manakai_compat_mode} = $_[1];
266	}
267	return $_[0]->{manakai_compat_mode} \|\| 'no quirks';
268	} else {
269	return 'no quirks';
270	}
271	} # manakai_compat_mode
272
273	package Whatpm::NanoDOM::Element;
274	push our @ISA, 'Whatpm::NanoDOM::Node';
275
276	sub new ($$$$$) {
277	my $self = shift->SUPER::new;
278	$self->{owner_document} = shift;
279	Scalar::Util::weaken ($self->{owner_document});
280	$self->{namespace_uri} = shift;
281	$self->{prefix} = shift;
282	$self->{local_name} = shift;
283	$self->{attributes} = {};
284	$self->{child_nodes} = [];
285	return $self;
286	} # new
287
288	sub owner_document ($) {
289	return shift->{owner_document};
290	} # owner_document
291
292	sub clone_node ($$) {
293	my ($self, $deep) = @_; ## NOTE: Deep cloning is not supported
294	my $clone = bless {
295	namespace_uri => $self->{namespace_uri},
296	prefix => $self->{prefix},
297	local_name => $self->{local_name},
298	child_nodes => [],
299	}, ref $self;
300	for my $ns (keys %{$self->{attributes}}) {
301	for my $ln (keys %{$self->{attributes}->{$ns}}) {
302	my $attr = $self->{attributes}->{$ns}->{$ln};
303	$clone->{attributes}->{$ns}->{$ln} = bless {
304	namespace_uri => $attr->{namespace_uri},
305	prefix => $attr->{prefix},
306	local_name => $attr->{local_name},
307	value => $attr->{value},
308	}, ref $self->{attributes}->{$ns}->{$ln};
309	}
310	}
311	return $clone;
312	} # clone
313
314	## A manakai extension
315	sub manakai_append_text ($$) {
316	my $self = shift;
317	if (@{$self->{child_nodes}} and
318	$self->{child_nodes}->[-1]->node_type == 3) {
319	$self->{child_nodes}->[-1]->manakai_append_text (shift);
320	} else {
321	my $text = Whatpm::NanoDOM::Text->new (shift);
322	$self->append_child ($text);
323	}
324	} # manakai_append_text
325
326	sub text_content ($) {
327	my $self = shift;
328	my $r = '';
329	for my $child (@{$self->child_nodes}) {
330	if ($child->can ('data')) {
331	$r .= $child->data;
332	} else {
333	$r .= $child->text_content;
334	}
335	}
336	return $r;
337	} # text_content
338
339	sub attributes ($) {
340	my $self = shift;
341	my $r = [];
342	## Order MUST be stable
343	for my $ns (sort {$a cmp $b} keys %{$self->{attributes}}) {
344	for my $ln (sort {$a cmp $b} keys %{$self->{attributes}->{$ns}}) {
345	push @$r, $self->{attributes}->{$ns}->{$ln}
346	if defined $self->{attributes}->{$ns}->{$ln};
347	}
348	}
349	return $r;
350	} # attributes
351
352	sub local_name ($) { # TODO: HTML5 case
353	return shift->{local_name};
354	} # local_name
355
356	sub manakai_local_name ($) {
357	return shift->{local_name}; # no case fixing for HTML5
358	} # manakai_local_name
359
360	sub namespace_uri ($) {
361	return shift->{namespace_uri};
362	} # namespace_uri
363
364	sub manakai_element_type_match ($$$) {
365	my ($self, $nsuri, $ln) = @_;
366	if (defined $nsuri) {
367	if (defined $self->{namespace_uri} and $nsuri eq $self->{namespace_uri}) {
368	return ($ln eq $self->{local_name});
369	} else {
370	return 0;
371	}
372	} else {
373	if (not defined $self->{namespace_uri}) {
374	return ($ln eq $self->{local_name});
375	} else {
376	return 0;
377	}
378	}
379	} # manakai_element_type_match
380
381	sub node_type { 1 }
382
383	## TODO: HTML5 capitalization
384	sub tag_name ($) {
385	my $self = shift;
386	if (defined $self->{prefix}) {
387	return $self->{prefix} . ':' . $self->{local_name};
388	} else {
389	return $self->{local_name};
390	}
391	} # tag_name
392
393	sub get_attribute_ns ($$$) {
394	my ($self, $nsuri, $ln) = @_;
395	$nsuri = '' unless defined $nsuri;
396	return defined $self->{attributes}->{$nsuri}->{$ln}
397	? $self->{attributes}->{$nsuri}->{$ln}->value : undef;
398	} # get_attribute_ns
399
400	sub get_attribute_node_ns ($$$) {
401	my ($self, $nsuri, $ln) = @_;
402	$nsuri = '' unless defined $nsuri;
403	return $self->{attributes}->{$nsuri}->{$ln};
404	} # get_attribute_node_ns
405
406	sub has_attribute_ns ($$$) {
407	my ($self, $nsuri, $ln) = @_;
408	$nsuri = '' unless defined $nsuri;
409	return defined $self->{attributes}->{$nsuri}->{$ln};
410	} # has_attribute_ns
411
412	## The second parameter only supports manakai extended way
413	## to specify qualified name - "[$prefix, $local_name]"
414	sub set_attribute_ns ($$$$) {
415	my ($self, $nsuri, $qn, $value) = @_;
416	$self->{attributes}->{$nsuri}->{$qn->[1]}
417	= Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value);
418	} # set_attribute_ns
419
420	package Whatpm::NanoDOM::Attr;
421	push our @ISA, 'Whatpm::NanoDOM::Node';
422
423	sub new ($$$$$$) {
424	my $self = shift->SUPER::new;
425	$self->{owner_element} = shift;
426	Scalar::Util::weaken ($self->{owner_element});
427	$self->{namespace_uri} = shift;
428	$self->{prefix} = shift;
429	$self->{local_name} = shift;
430	$self->{value} = shift;
431	return $self;
432	} # new
433
434	sub namespace_uri ($) {
435	return shift->{namespace_uri};
436	} # namespace_uri
437
438	sub manakai_local_name ($) {
439	return shift->{local_name};
440	} # manakai_local_name
441
442	sub node_type { 2 }
443
444	## TODO: HTML5 case stuff?
445	sub name ($) {
446	my $self = shift;
447	if (defined $self->{prefix}) {
448	return $self->{prefix} . ':' . $self->{local_name};
449	} else {
450	return $self->{local_name};
451	}
452	} # name
453
454	sub value ($) {
455	return shift->{value};
456	} # value
457
458	sub owner_element ($) {
459	return shift->{owner_element};
460	} # owner_element
461
462	package Whatpm::NanoDOM::CharacterData;
463	push our @ISA, 'Whatpm::NanoDOM::Node';
464
465	sub new ($$) {
466	my $self = shift->SUPER::new;
467	$self->{data} = shift;
468	return $self;
469	} # new
470
471	## A manakai extension
472	sub manakai_append_text ($$) {
473	my ($self, $s) = @_;
474	$self->{data} .= $s;
475	} # manakai_append_text
476
477	sub data ($) {
478	return shift->{data};
479	} # data
480
481	package Whatpm::NanoDOM::Text;
482	push our @ISA, 'Whatpm::NanoDOM::CharacterData';
483
484	sub node_type () { 3 }
485
486	package Whatpm::NanoDOM::Comment;
487	push our @ISA, 'Whatpm::NanoDOM::CharacterData';
488
489	sub node_type () { 8 }
490
491	package Whatpm::NanoDOM::DocumentType;
492	push our @ISA, 'Whatpm::NanoDOM::Node';
493
494	sub new ($$) {
495	my $self = shift->SUPER::new;
496	$self->{name} = shift;
497	return $self;
498	} # new
499
500	sub node_type () { 10 }
501
502	sub name ($) {
503	return shift->{name};
504	} # name
505
506	=head1 SEE ALSO
507
508	L<Whatpm::HTML>
509
510	=head1 AUTHOR
511
512	Wakaba <w@suika.fam.cx>.
513
514	=head1 LICENSE
515
516	Copyright 2007 Wakaba <w@suika.fam.cx>
517
518	This library is free software; you can redistribute it
519	and/or modify it under the same terms as Perl itself.
520
521	=cut
522
523	1;
524	# $Date: 2007/06/23 06:38:12 $