HTML::DOM::Attr - A Perl class for representing attribute nodes in an HTML DOM tree

  use HTML::DOM;
  $doc = HTML::DOM->new;
  $attr = $doc->createAttribute('href');
  $attr->nodeValue('http://localhost/');
  $elem = $doc->createElement('a');
  $elem->setAttributeNode($attr);

  $attr->nodeName;  # href
  $attr->nodeValue; # http://...

  $attr->firstChild; # a text node

  $attr->ownerElement; # returns $elem

package HTML::DOM::Attr;

use warnings;

# attribute constants (array elems)
BEGIN{
 my $x;
 %constants
  = map +($_=>$x++), qw[
     _doc _elem _name _val _list _styl
    ]
}
use constant 1.03 \%constants;
# after compilation:
delete @{__PACKAGE__."::"}{ keys %constants, 'constants' };

use strict;

# The internal fields are:
#  _doc   # owner document
#  _elem  # owner element
#  _name
#  _val   # actually contains an array with one element, so
#  _list  # node list  # that nodelists can work efficiently
#  _styl  # style obj


use overload fallback => 1,
	'""' => sub { shift->value },
	'bool' => sub{1};

use HTML::DOM::Exception qw'NOT_FOUND_ERR NO_MODIFICATION_ALLOWED_ERR
                            HIERARCHY_REQUEST_ERR ';
use HTML::DOM::Node 'ATTRIBUTE_NODE';
use Scalar::Util qw'weaken blessed refaddr';

require HTML::DOM::EventTarget;
require HTML::DOM::NodeList;

our @ISA = 'HTML::DOM::EventTarget';

our $VERSION = '0.048';

# -------- NON-DOM AND PRIVATE METHODS -------- #

sub new { # @_[1..2] contains the nayme & vallew
# ~~~ INVALID_CHARACTER_ERR is meant to be raised if the specified name contains an invalid character.
	my @self;
	@self[_name,_val] = ($_[1],[defined$_[2]?$_[2]:'']);
	                        # value should be an empty
	bless \@self, shift;         # string, not undef
}



sub _set_ownerDocument {
	weaken ($_[0][_doc] = $_[1]);
}

sub _element { # This is like ownerElement, except that it lets you set it.
	if(@_ > 1) {
		my $old = $_[0][_elem];
		weaken ($_[0][_elem] = $_[1]);
		return $old
	}
	$_[0][_elem];
}

sub DOES {
	return !0 if $_[1] eq 'HTML::DOM::Node';
	eval { shift->SUPER::DOES(@_) } || !1
}

sub _value { # returns the value as it is, whether it is a node or scalar
	$_[0][_val][0];
}

sub _val_as_node { # turns the attribute's value into a text node if it is
                   # not one already and returns it
	my $val = $_[0][_val][0];
	defined blessed $val && $val->isa('HTML::DOM::Text')
	    ? $val
	    : do {
	        my $val = $_[0][_val][0] =
	          $_[0]->ownerDocument->createTextNode(
		    $_[0][_styl] ? $_[0][_styl]->cssText : $val
		  );
	        weaken($val->{_parent}=($_[0]));
	        $val
	      }
}

# ~~~ Should I make this public? This actually allows a style object to be
#     attached to any attr node, not just a style attr. Is this useful?
#     (Actually, it would be problematic for event attributes, unless some-
#     one really wants to run css code :-)
sub style {
	my $self = shift;
	$self->[_styl] ||= do{
		require CSS::DOM::Style,
		my $ret = CSS::DOM::Style::parse(my $val = $self->value);
		$ret->modification_handler(my $cref = sub {
			if(ref(my $text = $self->_value)) {
				# We can’t use ->data here because it will
				# trigger chardatamodified  (see sub new),
				# which sets cssText, which calls this.
				$text->attr('text', shift->cssText)
			}
			$self->_modified;
		});
		weaken $self;
		my $css_code = $ret->cssText;
		if($val ne $css_code) { &$cref($ret) }
		$ret;
	};
}

sub _modified {
	my $self = shift;
	my ($old_val,$new) = @_;
	my $element = $self->[_elem] || return;
	defined $new or $new = value $self;
	if ($self->[_name] =~ /^on(.*)/is
	    and my $listener_maker = $self->ownerDocument
			->event_attr_handler
	) {
		my $eavesdropper = &$listener_maker(
			$element, my $evt_name = lc $1, $new
		);
		defined $eavesdropper
			and $element->event_handler(
				$evt_name, $eavesdropper
			);
	}

	$element->trigger_event(
		DOMAttrModified =>
		attr_name => $self->[_name],
		attr_change_type => 1,
		prev_value => defined $old_val?$old_val:$new,
		new_value  => $new,
		rel_node => $self,
	)
}

sub _text_node_modified {
	my $self = shift;
	if($$self[_styl]) {
		$$self[_styl]->cssText(shift->newValue)
	}
	else {
		$self->_modified($_[0]->prevValue,$_[0]->newValue);
	}
}


# ----------- ATTR-ONLY METHODS ---------- #

sub name {
	$_[0][_name];
}

sub value {
	if(my $style = $_[0][_styl]) {
		shift;
		return $style->cssText(@_);
	}
	if(@_ > 1){
		my $old = $_[0][_val][0];
		if(ref $old) {
			$old = $old->data;
			$_[0][_val][0]->data($_[1]);
			# ~~~ Can we combine these two statements by using data’s retval?
		}
		elsif((my $new_val = $_[0][_val][0] = "$_[1]") ne $old) {
			if($_[0]->get_event_listeners(	
				'DOMCharacterDataModified'
			)) {
				$_[0]->firstChild->trigger_event(
					'DOMCharacterDataModified',
					prev_value => $old,
					new_value => $new_val
				)
			}
			else {
				$_[0]->_modified($old,$new_val);
			}
		}
		return $old;
	}
	my $val = $_[0][_val][0];
	ref $val ? $val->data : $val;
}

sub specified {
	my $attr=shift;
	($$attr[_elem]||return 1)->_attr_specified($$attr[_name]);
}

sub ownerElement { # ~~~ If the attr is detached, is _element currently
                   #     erased as it should be?
	shift->_element || ()
}

# ------------------ NODE METHODS ------------ #

*nodeName = \&name;
*nodeValue = \&value;
*nodeType =\&ATTRIBUTE_NODE;

# These all return null
*previousSibling = *nextSibling = *attributes = *parentNode = *prefix =
*namespaceURI = *localName = *normalize
 = sub {};

sub childNodes {
	wantarray ? $_[0]->_val_as_node :(
		$_[0]->_val_as_node,
		$_[0][_list] ||= HTML::DOM::NodeList->new($_[0][_val])
	);
}

*firstChild = *lastChild = \&_val_as_node;

sub ownerDocument { $_[0][_doc] }

sub insertBefore {
	die HTML::DOM::Exception->new(NO_MODIFICATION_ALLOWED_ERR,
	    'The list of child nodes of an attribute cannot be modified');
}

sub replaceChild {
	my($self,$new_node,$old_node) = @_;
	my $val = $self->_value;
	die HTML::DOM::Exception->new(NOT_FOUND_ERR,
	'The node passed to replaceChild is not a child of this attribute')
		if !ref $val || $old_node != $val;
	if(defined blessed $new_node and
	   isa $new_node 'HTML::DOM::DocumentFragment') {
		(($new_node) = $new_node->childNodes) != 1 and
		die HTML::DOM::Exception->new(HIERARCHY_REQUEST_ERR,
			'The document fragment passed to replaceChild ' .
			'does not have exactly one child node');
	}
	die HTML::DOM::Exception->new(HIERARCHY_REQUEST_ERR,
		'The node passed to replaceChild is not a text node')
		if !defined blessed $new_node ||
			!$new_node->isa('HTML::DOM::Text');

	$old_node->trigger_event('DOMNodeRemoved',
		rel_node => $self);
	my $in_doc = $self->[_elem] && $self->[_elem]->is_inside(
		$self->[_doc]
	);
	if($in_doc) {
		$old_node->trigger_event('DOMNodeRemovedFromDocument')
	}
	my $old_parent = $new_node->parent;
	$old_parent and $new_node->trigger_event('DOMNodeRemoved',
		rel_node => $old_parent);
	if($new_node->is_inside($self->[_doc])){
		$new_node->trigger_event('DOMNodeRemovedFromDocument')
	}
	else {
		# Even if it’s already the same document, it’s actually
		# quicker just to set it than to check first.
		$new_node->_set_ownerDocument( $self->[_doc] );
	}

	($_[0][_val][0] = $new_node)->detach;
	weaken($new_node->{_parent}=($self));
	$old_node->parent(undef);

	$new_node->trigger_event('DOMNodeInserted', rel_node => $self);
	if($in_doc) {
		$new_node->trigger_event('DOMNodeInsertedIntoDocument')
	}
	$_->trigger_event('DOMSubtreeModified')
	  for grep defined, $old_parent, $self;
	$self->_modified($old_node->data, $new_node->data);

	$old_node;
}


*removeChild = *appendChild = \&insertBefore;

sub hasChildNodes { 1 }

sub cloneNode {
	# ~~~ The spec.  is not clear as to what should be done with  an
	#     Attr’s child node when it is cloned shallowly. I’m here fol-
	#     lowing the behaviour of Safari and Firefox, which both ignore
	#     the ‘deep’ option.
	my($self,$deep) = @_;
	my $clone = bless [@$self], ref $self;
	weaken $$clone[_doc];
	delete $$clone[$_] for _elem, _list;
	$$clone[_val] = ["$$clone[_val][0]"]; # copy the single-elem array
	                                     # that ->[_val] contains,
	                                   # flattening it in order effec-
	                                # tively to clone it.
	$clone;
}

sub hasAttributes { !1 }

sub isSupported {
	my $self = shift;
	return !1 if $_[0] =~ /events\z/i;
	$HTML::DOM::Implementation::it->hasFeature(@_)
}


1

__END__