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

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 02:26:51 $
1	wakaba	1.1	=head1 NAME
2
3	wakaba	1.2	Whatpm::NanoDOM - A Non-Conforming Implementation of DOM Subset
4	wakaba	1.1
5			=head1 DESCRIPTION
6
7	wakaba	1.2	The C<Whatpm::NanoDOM> module contains a non-conforming implementation
8	wakaba	1.1	of a subset of DOM. It is the intention that this module is
9	wakaba	1.2	used only for the purpose of testing the C<Whatpm::HTML> module.
10	wakaba	1.1
11			See source code if you would like to know what it does.
12
13			=cut
14
15	wakaba	1.2	package Whatpm::NanoDOM;
16	wakaba	1.1	use strict;
17
18	wakaba	1.3	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	wakaba	1.2	package Whatpm::NanoDOM::Node;
27	wakaba	1.1
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	wakaba	1.4	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	wakaba	1.1	sub child_nodes ($) {
52	wakaba	1.7	return shift->{child_nodes} \|\| [];
53	wakaba	1.1	} # 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	wakaba	1.3	$new_child->{parent_node} = $self;
68			Scalar::Util::weaken ($new_child->{parent_node});
69	wakaba	1.1	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	wakaba	1.5	$new_child->{parent_node} = $self;
94			Scalar::Util::weaken ($new_child->{parent_node});
95	wakaba	1.1	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	wakaba	1.8	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	wakaba	1.1	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	wakaba	1.6	sub prefix ($;$) {
145			my $self = shift;
146			if (@_) {
147			$self->{prefix} = shift;
148			}
149			return $self->{prefix};
150			} # prefix
151
152	wakaba	1.1	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	wakaba	1.2	package Whatpm::NanoDOM::Document;
166			push our @ISA, 'Whatpm::NanoDOM::Node';
167	wakaba	1.1
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	wakaba	1.2	return Whatpm::NanoDOM::Text->new (shift);
195	wakaba	1.1	} # create_text_node
196
197			sub create_comment ($$) {
198			shift;
199	wakaba	1.2	return Whatpm::NanoDOM::Comment->new (shift);
200	wakaba	1.1	} # 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	wakaba	1.3	return Whatpm::NanoDOM::Element->new ($self, $nsuri, $qn->[0], $qn->[1]);
207	wakaba	1.1	} # create_element_ns
208
209			## A manakai extension
210			sub create_document_type_definition ($$) {
211			shift;
212	wakaba	1.2	return Whatpm::NanoDOM::DocumentType->new (shift);
213	wakaba	1.1	} # create_document_type_definition
214
215	wakaba	1.3	sub implementation ($) {
216			return 'Whatpm::NanoDOM::DOMImplementation';
217			} # implementation
218
219	wakaba	1.4	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	wakaba	1.11	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	wakaba	1.2	package Whatpm::NanoDOM::Element;
242			push our @ISA, 'Whatpm::NanoDOM::Node';
243	wakaba	1.1
244	wakaba	1.3	sub new ($$$$$) {
245	wakaba	1.1	my $self = shift->SUPER::new;
246	wakaba	1.3	$self->{owner_document} = shift;
247			Scalar::Util::weaken ($self->{owner_document});
248	wakaba	1.1	$self->{namespace_uri} = shift;
249			$self->{prefix} = shift;
250			$self->{local_name} = shift;
251			$self->{attributes} = {};
252			$self->{child_nodes} = [];
253			return $self;
254			} # new
255
256	wakaba	1.3	sub owner_document ($) {
257			return shift->{owner_document};
258			} # owner_document
259
260	wakaba	1.1	sub clone_node ($$) {
261			my ($self, $deep) = @_; ## NOTE: Deep cloning is not supported
262			my $clone = bless {
263			namespace_uri => $self->{namespace_uri},
264			prefix => $self->{prefix},
265			local_name => $self->{local_name},
266			child_nodes => [],
267			}, ref $self;
268			for my $ns (keys %{$self->{attributes}}) {
269			for my $ln (keys %{$self->{attributes}->{$ns}}) {
270			my $attr = $self->{attributes}->{$ns}->{$ln};
271			$clone->{attributes}->{$ns}->{$ln} = bless {
272			namespace_uri => $attr->{namespace_uri},
273			prefix => $attr->{prefix},
274			local_name => $attr->{local_name},
275			value => $attr->{value},
276			}, ref $self->{attributes}->{$ns}->{$ln};
277			}
278			}
279			return $clone;
280			} # clone
281
282			## A manakai extension
283			sub manakai_append_text ($$) {
284			my $self = shift;
285			if (@{$self->{child_nodes}} and
286			$self->{child_nodes}->[-1]->node_type == 3) {
287			$self->{child_nodes}->[-1]->manakai_append_text (shift);
288			} else {
289	wakaba	1.2	my $text = Whatpm::NanoDOM::Text->new (shift);
290	wakaba	1.1	$self->append_child ($text);
291			}
292			} # manakai_append_text
293
294	wakaba	1.7	sub text_content ($) {
295			my $self = shift;
296			my $r = '';
297			for my $child (@{$self->child_nodes}) {
298			if ($child->can ('data')) {
299			$r .= $child->data;
300			} else {
301			$r .= $child->text_content;
302			}
303			}
304			return $r;
305			} # text_content
306
307	wakaba	1.1	sub attributes ($) {
308			my $self = shift;
309			my $r = [];
310			## Order MUST be stable
311			for my $ns (sort {$a cmp $b} keys %{$self->{attributes}}) {
312			for my $ln (sort {$a cmp $b} keys %{$self->{attributes}->{$ns}}) {
313			push @$r, $self->{attributes}->{$ns}->{$ln}
314			if defined $self->{attributes}->{$ns}->{$ln};
315			}
316			}
317			return $r;
318			} # attributes
319
320	wakaba	1.3	sub local_name ($) { # TODO: HTML5 case
321			return shift->{local_name};
322			} # local_name
323
324	wakaba	1.4	sub manakai_local_name ($) {
325			return shift->{local_name}; # no case fixing for HTML5
326			} # manakai_local_name
327
328	wakaba	1.3	sub namespace_uri ($) {
329			return shift->{namespace_uri};
330			} # namespace_uri
331
332	wakaba	1.4	sub manakai_element_type_match ($$$) {
333			my ($self, $nsuri, $ln) = @_;
334			if (defined $nsuri) {
335			if (defined $self->{namespace_uri} and $nsuri eq $self->{namespace_uri}) {
336			return ($ln eq $self->{local_name});
337			} else {
338			return 0;
339			}
340			} else {
341			if (not defined $self->{namespace_uri}) {
342			return ($ln eq $self->{local_name});
343			} else {
344			return 0;
345			}
346			}
347			} # manakai_element_type_match
348
349	wakaba	1.1	sub node_type { 1 }
350
351			## TODO: HTML5 capitalization
352			sub tag_name ($) {
353			my $self = shift;
354			if (defined $self->{prefix}) {
355			return $self->{prefix} . ':' . $self->{local_name};
356			} else {
357			return $self->{local_name};
358			}
359			} # tag_name
360
361	wakaba	1.8	sub get_attribute_ns ($$$) {
362			my ($self, $nsuri, $ln) = @_;
363			$nsuri = '' unless defined $nsuri;
364			return defined $self->{attributes}->{$nsuri}->{$ln}
365			? $self->{attributes}->{$nsuri}->{$ln}->value : undef;
366			} # get_attribute_ns
367
368	wakaba	1.9	sub get_attribute_node_ns ($$$) {
369			my ($self, $nsuri, $ln) = @_;
370			$nsuri = '' unless defined $nsuri;
371			return $self->{attributes}->{$nsuri}->{$ln};
372			} # get_attribute_node_ns
373
374	wakaba	1.1	sub has_attribute_ns ($$$) {
375			my ($self, $nsuri, $ln) = @_;
376	wakaba	1.8	$nsuri = '' unless defined $nsuri;
377	wakaba	1.1	return defined $self->{attributes}->{$nsuri}->{$ln};
378			} # has_attribute_ns
379
380			## The second parameter only supports manakai extended way
381			## to specify qualified name - "[$prefix, $local_name]"
382			sub set_attribute_ns ($$$$) {
383			my ($self, $nsuri, $qn, $value) = @_;
384			$self->{attributes}->{$nsuri}->{$qn->[1]}
385	wakaba	1.5	= Whatpm::NanoDOM::Attr->new ($self, $nsuri, $qn->[0], $qn->[1], $value);
386	wakaba	1.1	} # set_attribute_ns
387
388	wakaba	1.2	package Whatpm::NanoDOM::Attr;
389			push our @ISA, 'Whatpm::NanoDOM::Node';
390	wakaba	1.1
391	wakaba	1.5	sub new ($$$$$$) {
392	wakaba	1.1	my $self = shift->SUPER::new;
393	wakaba	1.5	$self->{owner_element} = shift;
394			Scalar::Util::weaken ($self->{owner_element});
395	wakaba	1.1	$self->{namespace_uri} = shift;
396			$self->{prefix} = shift;
397			$self->{local_name} = shift;
398			$self->{value} = shift;
399			return $self;
400			} # new
401
402	wakaba	1.5	sub namespace_uri ($) {
403			return shift->{namespace_uri};
404			} # namespace_uri
405
406			sub manakai_local_name ($) {
407			return shift->{local_name};
408			} # manakai_local_name
409
410	wakaba	1.1	sub node_type { 2 }
411
412			## TODO: HTML5 case stuff?
413			sub name ($) {
414			my $self = shift;
415			if (defined $self->{prefix}) {
416			return $self->{prefix} . ':' . $self->{local_name};
417			} else {
418			return $self->{local_name};
419			}
420			} # name
421
422			sub value ($) {
423			return shift->{value};
424			} # value
425
426	wakaba	1.5	sub owner_element ($) {
427			return shift->{owner_element};
428			} # owner_element
429
430	wakaba	1.2	package Whatpm::NanoDOM::CharacterData;
431			push our @ISA, 'Whatpm::NanoDOM::Node';
432	wakaba	1.1
433			sub new ($$) {
434			my $self = shift->SUPER::new;
435			$self->{data} = shift;
436			return $self;
437			} # new
438
439			## A manakai extension
440			sub manakai_append_text ($$) {
441			my ($self, $s) = @_;
442			$self->{data} .= $s;
443			} # manakai_append_text
444
445			sub data ($) {
446			return shift->{data};
447			} # data
448
449	wakaba	1.2	package Whatpm::NanoDOM::Text;
450			push our @ISA, 'Whatpm::NanoDOM::CharacterData';
451	wakaba	1.1
452			sub node_type () { 3 }
453
454	wakaba	1.2	package Whatpm::NanoDOM::Comment;
455			push our @ISA, 'Whatpm::NanoDOM::CharacterData';
456	wakaba	1.1
457			sub node_type () { 8 }
458
459	wakaba	1.2	package Whatpm::NanoDOM::DocumentType;
460			push our @ISA, 'Whatpm::NanoDOM::Node';
461	wakaba	1.1
462			sub new ($$) {
463			my $self = shift->SUPER::new;
464			$self->{name} = shift;
465			return $self;
466			} # new
467
468			sub node_type () { 10 }
469
470			sub name ($) {
471			return shift->{name};
472			} # name
473
474			=head1 SEE ALSO
475
476	wakaba	1.2	L<Whatpm::HTML>
477	wakaba	1.1
478			=head1 AUTHOR
479
480			Wakaba <w@suika.fam.cx>.
481
482			=head1 LICENSE
483
484			Copyright 2007 Wakaba <w@suika.fam.cx>
485
486			This library is free software; you can redistribute it
487			and/or modify it under the same terms as Perl itself.
488
489			=cut
490
491			1;
492	wakaba	1.11	# $Date: 2007/06/23 02:26:51 $