Message/DOM/Attr.pm

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

sub ____new ($$$$$$) {
  my $self = shift->SUPER::____new (shift);
  ($$self->{owner_element},
   $$self->{namespace_uri},
   $$self->{prefix},
   $$self->{local_name}) = @_;
  Scalar::Util::weaken ($$self->{owner_element});
  $$self->{child_nodes} = [];
  $$self->{specified} = 1;
  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)
    namespace_uri => 1,
    owner_element => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD
sub owner_element ($);

## |Node| attributes

sub base_uri ($) {
  my $self = $_[0];
  local $Error::Depth = $Error::Depth + 1;
  my $oe = $self->owner_element;
  if ($oe) {
    my $ln = $self->local_name;
    my $nsuri = $self->namespace_uri;
    if (($ln eq 'base' and
         defined $nsuri and $nsuri eq 'http://www.w3.org/XML/1998/namespace') or
        ($ln eq 'xml:base' and not defined $nsuri)) {
      my $oep = $oe->parent_node;
      if ($oep) {
        return $oep->base_uri;
      } else {
        return $self->owner_document->base_uri;
      }
    } else {
      return $oe->base_uri;
    }
  } else {
    return $self->owner_document->base_uri;
  }
} # base_uri

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

sub manakai_local_name ($) {
  return ${$_[0]}->{local_name};
} # manakai_local_name

sub namespace_uri ($);

## The name of the attribute [DOM1, DOM2].
## Same as |Attr.name| [DOM3].

*node_name = \&name;

sub node_type () { 2 } # ATTRIBUTE_NODE

## The value of the attribute [DOM1, DOM2].
## Same as |Attr.value| [DOM3].

*node_value = \&value;

sub prefix ($;$) {
  ## NOTE: No check for new value as Firefox doesn't do.
  ## See <http://suika.fam.cx/gate/2005/sw/prefix>.

  ## NOTE: Same as trivial setter except "" -> undef

  ## NOTE: Same as |Element|'s |prefix|.
  
  if (@_ > 1) {
    if (${${$_[0]}->{owner_document}}->{strict_error_checking} and 
        ${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
    if (defined $_[1] and $_[1] ne '') {
      ${$_[0]}->{prefix} = ''.$_[1];
    } else {
      delete ${$_[0]}->{prefix};
    }
  }
  return ${$_[0]}->{prefix}; 
} # prefix

## |Attr| attributes

sub manakai_attribute_type ($;$) {
  my $self = $_[0];
  if (@_ > 1) {
    if (${$$self->{owner_document}}->{strict_error_checking}) {
      if ($$self->{manakai_read_only}) {
        report Message::DOM::DOMException
            -object => $self,
            -type => 'NO_MODIFICATION_ALLOWED_ERR',
            -subtype => 'READ_ONLY_NODE_ERR';
      }
    }
    if ($_[1]) {
      $$self->{manakai_attribute_type} = 0+$_[1];
    } else {
      delete $$self->{manakai_attribute_type};
    }
  }
  
  return $$self->{manakai_attribute_type} || 0;
} # manakai_attribute_type

## 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 specified ($;$) {
  if (@_ > 1) {
    ## NOTE: A manakai extension.
    if (${${$_[0]}->{owner_document}}->{strict_error_checking} and 
        ${$_[0]}->{manakai_read_only}) {
      report Message::DOM::DOMException
          -object => $_[0],
          -type => 'NO_MODIFICATION_ALLOWED_ERR',
          -subtype => 'READ_ONLY_NODE_ERR';
    }
    if ($_[1] or not defined ${$_[0]}->{owner_element}) {
      ${$_[0]}->{specified} = 1;
    } else {
      delete ${$_[0]}->{specified};
    }
  }
  return ${$_[0]}->{specified}; 
} # specified

sub value ($;$) {
  ## TODO:
  shift->text_content (@_);
} # value

package Message::IF::Attr;

package Message::DOM::Document;

sub create_attribute ($$) {
  ## TODO: HTML5
  return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
} # create_attribute

sub create_attribute_ns ($$$) {
  my ($prefix, $lname);
  if (ref $_[2] eq 'ARRAY') {
    ($prefix, $lname) = @{$_[2]};
  } else {
    ($prefix, $lname) = split /:/, $_[2], 2;
    ($prefix, $lname) = (undef, $prefix) unless defined $lname;
  }
  return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
} # create_element_ns

1;
## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
## $Date: 2007/06/16 15:27:45 $
1	package Message::DOM::Attr;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	push our @ISA, 'Message::DOM::Node', 'Message::IF::Attr';
5	require Message::DOM::Node;
6
7	sub ____new ($$$$$$) {
8	my $self = shift->SUPER::____new (shift);
9	($$self->{owner_element},
10	$$self->{namespace_uri},
11	$$self->{prefix},
12	$$self->{local_name}) = @_;
13	Scalar::Util::weaken ($$self->{owner_element});
14	$$self->{child_nodes} = [];
15	$$self->{specified} = 1;
16	return $self;
17	} # ____new
18
19	sub AUTOLOAD {
20	my $method_name = our $AUTOLOAD;
21	$method_name =~ s/.*:://;
22	return if $method_name eq 'DESTROY';
23
24	if ({
25	## Read-only attributes (trivial accessors)
26	namespace_uri => 1,
27	owner_element => 1,
28	}->{$method_name}) {
29	no strict 'refs';
30	eval qq{
31	sub $method_name (\$) {
32	return \${\$_[0]}->{$method_name};
33	}
34	};
35	goto &{ $AUTOLOAD };
36	} else {
37	require Carp;
38	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
39	}
40	} # AUTOLOAD
41	sub owner_element ($);
42
43	## \|Node\| attributes
44
45	sub base_uri ($) {
46	my $self = $_[0];
47	local $Error::Depth = $Error::Depth + 1;
48	my $oe = $self->owner_element;
49	if ($oe) {
50	my $ln = $self->local_name;
51	my $nsuri = $self->namespace_uri;
52	if (($ln eq 'base' and
53	defined $nsuri and $nsuri eq 'http://www.w3.org/XML/1998/namespace') or
54	($ln eq 'xml:base' and not defined $nsuri)) {
55	my $oep = $oe->parent_node;
56	if ($oep) {
57	return $oep->base_uri;
58	} else {
59	return $self->owner_document->base_uri;
60	}
61	} else {
62	return $oe->base_uri;
63	}
64	} else {
65	return $self->owner_document->base_uri;
66	}
67	} # base_uri
68
69	sub local_name ($) {
70	## TODO: HTML5
71	return ${+shift}->{local_name};
72	} # local_name
73
74	sub manakai_local_name ($) {
75	return ${$_[0]}->{local_name};
76	} # manakai_local_name
77
78	sub namespace_uri ($);
79
80	## The name of the attribute [DOM1, DOM2].
81	## Same as \|Attr.name\| [DOM3].
82
83	*node_name = \&name;
84
85	sub node_type () { 2 } # ATTRIBUTE_NODE
86
87	## The value of the attribute [DOM1, DOM2].
88	## Same as \|Attr.value\| [DOM3].
89
90	*node_value = \&value;
91
92	sub prefix ($;$) {
93	## NOTE: No check for new value as Firefox doesn't do.
94	## See <http://suika.fam.cx/gate/2005/sw/prefix>.
95
96	## NOTE: Same as trivial setter except "" -> undef
97
98	## NOTE: Same as \|Element\|'s \|prefix\|.
99
100	if (@_ > 1) {
101	if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
102	${$_[0]}->{manakai_read_only}) {
103	report Message::DOM::DOMException
104	-object => $_[0],
105	-type => 'NO_MODIFICATION_ALLOWED_ERR',
106	-subtype => 'READ_ONLY_NODE_ERR';
107	}
108	if (defined $_[1] and $_[1] ne '') {
109	${$_[0]}->{prefix} = ''.$_[1];
110	} else {
111	delete ${$_[0]}->{prefix};
112	}
113	}
114	return ${$_[0]}->{prefix};
115	} # prefix
116
117	## \|Attr\| attributes
118
119	sub manakai_attribute_type ($;$) {
120	my $self = $_[0];
121	if (@_ > 1) {
122	if (${$$self->{owner_document}}->{strict_error_checking}) {
123	if ($$self->{manakai_read_only}) {
124	report Message::DOM::DOMException
125	-object => $self,
126	-type => 'NO_MODIFICATION_ALLOWED_ERR',
127	-subtype => 'READ_ONLY_NODE_ERR';
128	}
129	}
130	if ($_[1]) {
131	$$self->{manakai_attribute_type} = 0+$_[1];
132	} else {
133	delete $$self->{manakai_attribute_type};
134	}
135	}
136
137	return $$self->{manakai_attribute_type} \|\| 0;
138	} # manakai_attribute_type
139
140	## TODO: HTML5 case stuff?
141	sub name ($) {
142	my $self = shift;
143	if (defined $$self->{prefix}) {
144	return $$self->{prefix} . ':' . $$self->{local_name};
145	} else {
146	return $$self->{local_name};
147	}
148	} # name
149
150	sub specified ($;$) {
151	if (@_ > 1) {
152	## NOTE: A manakai extension.
153	if (${${$_[0]}->{owner_document}}->{strict_error_checking} and
154	${$_[0]}->{manakai_read_only}) {
155	report Message::DOM::DOMException
156	-object => $_[0],
157	-type => 'NO_MODIFICATION_ALLOWED_ERR',
158	-subtype => 'READ_ONLY_NODE_ERR';
159	}
160	if ($_[1] or not defined ${$_[0]}->{owner_element}) {
161	${$_[0]}->{specified} = 1;
162	} else {
163	delete ${$_[0]}->{specified};
164	}
165	}
166	return ${$_[0]}->{specified};
167	} # specified
168
169	sub value ($;$) {
170	## TODO:
171	shift->text_content (@_);
172	} # value
173
174	package Message::IF::Attr;
175
176	package Message::DOM::Document;
177
178	sub create_attribute ($$) {
179	## TODO: HTML5
180	return Message::DOM::Attr->____new ($_[0], undef, undef, undef, $_[1]);
181	} # create_attribute
182
183	sub create_attribute_ns ($$$) {
184	my ($prefix, $lname);
185	if (ref $_[2] eq 'ARRAY') {
186	($prefix, $lname) = @{$_[2]};
187	} else {
188	($prefix, $lname) = split /:/, $_[2], 2;
189	($prefix, $lname) = (undef, $prefix) unless defined $lname;
190	}
191	return Message::DOM::Attr->____new ($_[0], undef, $_[1], $prefix, $lname);
192	} # create_element_ns
193
194	1;
195	## License: <http://suika.fam.cx/~wakaba/archive/2004/8/18/license#Perl+MPL>
196	## $Date: 2007/06/16 15:27:45 $