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 is_equal_node ($$) {
  return shift eq shift;
} # is_equal_node

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

## NOTE: Only applied to Elements and Documents
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 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

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