Message/DOM/Node.pm

package Message::DOM::Node;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::IF::Node';
require Scalar::Util;

sub ____new ($$) {
  my $self = bless \({}), shift;
  $$self->{owner_document} = shift;
  Scalar::Util::weaken ($$self->{owner_document});
  return $self;
} # ____new

sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  if ({
    ## Read-only attributes (trivial accessors)
    local_name => 1,
    namespace_uri => 1,
    owner_document => 1,
    parent_node => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        if (\@_ > 1) {
          require Carp;
          Carp::croak (qq<Can't modify read-only attribute>);
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } elsif ({
    ## Read-write attributes (DOMString, trivial accessors)
    prefix => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        if (\@_ > 1) {
          \${\$_[0]}->{$method_name} = ''.$_[1];
        }
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD
sub local_name ($);
sub namespace_uri ($);
sub owner_document ($);
sub parent_node ($);
sub prefix ($;$);

## The |Node| interface - attribute

sub is_equal_node ($$) {
  return shift eq shift;
} # is_equal_node

sub manakai_local_name ($) {
  if (@_ > 1) {
    require Carp;
    Carp::croak (qq<Can't modify read-only attribute>);  
  }
  return ${$_[0]}->{local_name};
} # manakai_local_name

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

sub child_nodes ($) {
  ## TODO: NodeList
  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 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 Message::IF::Node;

1;
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
## $Date:$
1	wakaba	1.1	package Message::DOM::Node;
2			use strict;
3			our $VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4			push our @ISA, 'Message::IF::Node';
5			require Scalar::Util;
6
7			sub ____new ($$) {
8			my $self = bless \({}), shift;
9			$$self->{owner_document} = shift;
10			Scalar::Util::weaken ($$self->{owner_document});
11			return $self;
12			} # ____new
13
14			sub AUTOLOAD {
15			my $method_name = our $AUTOLOAD;
16			$method_name =~ s/.*:://;
17			return if $method_name eq 'DESTROY';
18
19			if ({
20			## Read-only attributes (trivial accessors)
21			local_name => 1,
22			namespace_uri => 1,
23			owner_document => 1,
24			parent_node => 1,
25			}->{$method_name}) {
26			no strict 'refs';
27			eval qq{
28			sub $method_name (\$) {
29			if (\@_ > 1) {
30			require Carp;
31			Carp::croak (qq<Can't modify read-only attribute>);
32			}
33			return \${\$_[0]}->{$method_name};
34			}
35			};
36			goto &{ $AUTOLOAD };
37			} elsif ({
38			## Read-write attributes (DOMString, trivial accessors)
39			prefix => 1,
40			}->{$method_name}) {
41			no strict 'refs';
42			eval qq{
43			sub $method_name (\$) {
44			if (\@_ > 1) {
45			\${\$_[0]}->{$method_name} = ''.$_[1];
46			}
47			return \${\$_[0]}->{$method_name};
48			}
49			};
50			goto &{ $AUTOLOAD };
51			} else {
52			require Carp;
53			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
54			}
55			} # AUTOLOAD
56			sub local_name ($);
57			sub namespace_uri ($);
58			sub owner_document ($);
59			sub parent_node ($);
60			sub prefix ($;$);
61
62			## The \|Node\| interface - attribute
63
64			sub is_equal_node ($$) {
65			return shift eq shift;
66			} # is_equal_node
67
68			sub manakai_local_name ($) {
69			if (@_ > 1) {
70			require Carp;
71			Carp::croak (qq<Can't modify read-only attribute>);
72			}
73			return ${$_[0]}->{local_name};
74			} # manakai_local_name
75
76			sub manakai_parent_element ($) {
77			my $self = shift;
78			my $parent = $$self->{parent_node};
79			while (defined $parent) {
80			if ($parent->node_type == 1) { # ELEMENT_NODE
81			return $parent;
82			} else {
83			$parent = $$parent->{parent_node};
84			}
85			}
86			return undef;
87			} # manakai_parent_element
88
89			sub child_nodes ($) {
90			## TODO: NodeList
91			return ${+shift}->{child_nodes} \|\| [];
92			} # child_nodes
93
94			## NOTE: Only applied to Elements and Documents
95			sub append_child ($$) {
96			my ($self, $new_child) = @_;
97			if (defined $$new_child->{parent_node}) {
98			my $parent_list = $$new_child->{parent_node}->{child_nodes};
99			for (0..$#$parent_list) {
100			if ($parent_list->[$_] eq $new_child) {
101			splice @$parent_list, $_, 1;
102			}
103			}
104			}
105			push @{$$self->{child_nodes}}, $new_child;
106			$$new_child->{parent_node} = $self;
107			Scalar::Util::weaken ($$new_child->{parent_node});
108			return $new_child;
109			} # append_child
110
111			## NOTE: Only applied to Elements and Documents
112			sub insert_before ($$;$) {
113			my ($self, $new_child, $ref_child) = @_;
114			if (defined $$new_child->{parent_node}) {
115			my $parent_list = $$new_child->{parent_node}->{child_nodes};
116			for (0..$#$parent_list) {
117			if ($parent_list->[$_] eq $new_child) {
118			splice @$parent_list, $_, 1;
119			}
120			}
121			}
122			my $i = @{$$self->{child_nodes}};
123			if (defined $ref_child) {
124			for (0..$#{$$self->{child_nodes}}) {
125			if ($$self->{child_nodes}->[$_] eq $ref_child) {
126			$i = $_;
127			last;
128			}
129			}
130			}
131			splice @{$$self->{child_nodes}}, $i, 0, $new_child;
132			$$new_child->{parent_node} = $self;
133			Scalar::Util::weaken ($$new_child->{parent_node});
134			return $new_child;
135			} # insert_before
136
137			## NOTE: Only applied to Elements and Documents
138			sub remove_child ($$) {
139			my ($self, $old_child) = @_;
140			my $parent_list = $$self->{child_nodes};
141			for (0..$#$parent_list) {
142			if ($parent_list->[$_] eq $old_child) {
143			splice @$parent_list, $_, 1;
144			}
145			}
146			delete $$old_child->{parent_node};
147			return $old_child;
148			} # remove_child
149
150			## NOTE: Only applied to Elements and Documents
151			sub has_child_nodes ($) {
152			return @{${+shift}->{child_nodes}} > 0;
153			} # has_child_nodes
154
155			## NOTE: Only applied to Elements and Documents
156			sub first_child ($) {
157			my $self = shift;
158			return $$self->{child_nodes}->[0];
159			} # first_child
160
161			## NOTE: Only applied to Elements and Documents
162			sub last_child ($) {
163			my $self = shift;
164			return @{$$self->{child_nodes}} ? $$self->{child_nodes}->[-1] : undef;
165			} # last_child
166
167			## NOTE: Only applied to Elements and Documents
168			sub previous_sibling ($) {
169			my $self = shift;
170			my $parent = $$self->{parent_node};
171			return undef unless defined $parent;
172			my $r;
173			for (@{$$parent->{child_nodes}}) {
174			if ($_ eq $self) {
175			return $r;
176			} else {
177			$r = $_;
178			}
179			}
180			return undef;
181			} # previous_sibling
182
183			sub ELEMENT_NODE () { 1 }
184			sub ATTRIBUTE_NODE () { 2 }
185			sub TEXT_NODE () { 3 }
186			sub CDATA_SECTION_NODE () { 4 }
187			sub ENTITY_REFERENCE_NODE () { 5 }
188			sub ENTITY_NODE () { 6 }
189			sub PROCESSING_INSTRUCTION_NODE () { 7 }
190			sub COMMENT_NODE () { 8 }
191			sub DOCUMENT_NODE () { 9 }
192			sub DOCUMENT_TYPE_NODE () { 10 }
193			sub DOCUMENT_FRAGMENT_NODE () { 11 }
194			sub NOTATION_NODE () { 12 }
195
196			package Message::IF::Node;
197
198			1;
199			## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
200			## $Date:$