#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# $Id: AttributeListImpl.pm,v 1.24 2004/06/06 21:11:48 eric Exp $

use strict;
require Exporter;
require AutoLoader;

use W3C::XML::XmlElementTree;
use W3C::XML::AttributeListImpl;

$W3C::XML::AttributeListImpl::REVISION = '$Id: AttributeListImpl.pm,v 1.24 2004/06/06 21:11:48 eric Exp $ ';

package W3C::XML::AttributeListImpl;

use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.97;
$DSLI = 'adpO';
@TODO = ('It is impossible to to distinguish getValue("1") from getValue(1) so 
attributes with a name that matches m/\A\d+\Z/ will be lost unless retrieved by number.');

use vars qw($QNAME $TYPE $VALUE $URI $LNAME);
($QNAME, $TYPE, $VALUE, $URI, $LNAME) = (0, 1, 2, 3, 4);

#####
# per-object data
# ATTIBUTES	- array of all the collected attributes
# DEBUG		- per-object control of debugging info

#####
# new - prepare a W3C::XML::AttributeListImpl with a new connection

sub new {
    my ($proto, $defaultNamespace, $atts) = @_;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{DEBUG} = 0;
    # "private" data
    $self->{ATTRIBUTES} = [];
    bless ($self, $class);
    $self->{DEFAULT_NAMESPACE} = $defaultNamespace; # @@@ xmlns
    $self->setAttributeList($atts) if (defined $atts);
    ++ ${ $self->{"_OUTSTANDING"} };
    return $self;
}

#####
# setAttributeList - replace into attribute list

sub setAttributeList {
    my ($self, $atts) = @_;
    my $size = $atts->getLength();
    $self->clear();
    for (my $i = 0; $i < $size; $i++) {
	$self->addAtribute($atts->getName($i), $atts.getType($i), $atts->getValue($i));
    }
}

#####
# addAttribute - add new attribute to attribute list

sub addAttribute {
    my ($self, $name, $type, $value) = @_;
#    $name = $self->{DEFAULT_NAMESPACE}.':'.$name if ($name !~ m/\A [^:]+ : /x); # xmlns
    push (@{$self->{ATTRIBUTES}}, [$name, $type, $value]);
}

#####
# removeAttribute - and get rid of it

sub removeAttribute {
    my ($self, $name) = @_;

    my $new = {};
    my $attrs = $self->{ATTRIBUTES};
    for (my $i = 0; $i < @$attrs; $i++) {
#	push (@$new, $$attrs[$i]) if ($ {@$attrs[$i]}[$QNAME] ne $name);
	if ($attrs->[$i][$QNAME] eq $name) {
	    splice (@$attrs, $i, 1);
#	    return;
	}
    }
#    $self->{ATTRIBUTES} = $new;   
}

#####
# clear - get rid of all attributes

sub clear {
    my ($self, $name) = @_;
    $self->{ATTRIBUTES} = [];
}

#####
# getLength - return the number of attribute

sub getLength {
    my ($self) = @_;
    return scalar @{$self->{ATTRIBUTES}};
}

#####
# getName - return the name of the i'th attribute

sub getName {
    my ($self, $i) = @_;
    return undef if ($i >= @{$self->{ATTRIBUTES}});
    return @{@{$self->{ATTRIBUTES}}[$i]}[$QNAME];
}

#####
# getType - return the type of the i'th attribute

sub getType {
    my ($self, $i) = @_;
    return $self->getOne($i, $TYPE);
}

#####
# getValue - return the value of the i'th attribute

sub getValue {
    my ($self, $i) = @_;
    return $self->getOne($i, $VALUE);
}

#####
# getOne - return the n'th object element of the i'th attribute

sub getOne {
    my ($self, $arg1, $n) = @_;
    my $i;
    if ($arg1 =~ m/\A\d+\Z/) {
	$i = $arg1;
    } else {
	for ($i = 0; $i < @{$self->{ATTRIBUTES}}; $i++) {
	    last if ($self->{ATTRIBUTES}->[$i]->[$QNAME] eq $arg1);
	}
	# if not found, $i >= @$attrs so return undef
    }
    return undef if ($i >= @{$self->{ATTRIBUTES}});
    return $self->{ATTRIBUTES}->[$i]->[$VALUE];
}

#####
# toString - dump the attribute list

sub toString {
    my ($self, $prefix, $namespaceHandler) = @_;
    my $ret; # = 'default namespace: '.$self->{DEFAULT_NAMESPACE}."\n";
    map {
	my $name = $_->[$QNAME];
	$name = $namespaceHandler->unmapNamespace($name) if ($namespaceHandler);
	$ret .=$prefix.$name.'('.$_->[$TYPE].'): '.$_->[$VALUE]."\n"
	} @{$self->{ATTRIBUTES}};
    return $ret;
}

package W3C::XML::AttributesImpl;

use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);
@ISA = qw(W3C::XML::AttributeListImpl);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.01;
$DSLI = 'adpO';
@TODO = ('just stubbed.');

use vars qw($QNAME $TYPE $VALUE $URI $LNAME $VURI $VLNAME);
($QNAME, $TYPE, $VALUE, $URI, $LNAME, $VURI, $VLNAME) = (0, 1, 2, 3, 4, 6, 7);

sub new {
    my ($proto, $atts) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new();
    bless ($self, $class);
    if (defined $atts) {
	$self->setAttributes($atts);
    }
    return $self
}

sub getURI {
    my ($self, $index) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	return $self->{ATTRIBUTES}[$index][$URI];
    } else {
	return undef;
    }
}

sub getLocalName {
    my ($self, $index) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	return $self->{ATTRIBUTES}[$index][$LNAME];
    } else {
	return undef;
    }
}

sub getQName {
    my ($self, $index) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	return $self->{ATTRIBUTES}[$index][$QNAME];
    } else {
	return undef;
    }
}

sub getType {
    my ($self, $indexOrUriOrQName, $localNameOrNull) = @_;
    my $recNo = $self->_getRecordNumber($indexOrUriOrQName, $localNameOrNull);
    return defined $recNo ? $self->{ATTRIBUTES}[$recNo][$TYPE] : undef;
}

sub getValue {
    my ($self, $indexOrUriOrQName, $localNameOrNull) = @_;
    my $recNo = $self->_getRecordNumber($indexOrUriOrQName, $localNameOrNull);
    return defined $recNo ? $self->{ATTRIBUTES}[$recNo][$VALUE] : undef;
}

sub getIndex {
    my ($self, $uriOrQName, $localNameOrNull) = @_;
    return $self->_getRecordNumber($uriOrQName, $localNameOrNull);

    if ($localNameOrNull) {
	for (my $i = 0; $i < @{$self->{ATTRIBUTES}}; $i++) {
	    if ($self->{ATTRIBUTES}[$i][$URI] eq $uriOrQName && $self->{ATTRIBUTES}[$i][$LNAME] eq $localNameOrNull) {
		return $i;
	    }
	}
    } else {
	for (my $i = 0; $i < @{$self->{ATTRIBUTES}}; $i++) {
	    if ($self->{ATTRIBUTES}[$i][$QNAME] eq $uriOrQName) {
		return $i;
	    }
	}
    }
    return undef;
}

sub clear {
    my ($self) = @_;
    $self->{ATTRIBUTES} = [];
}

sub setAttributes {
    my ($self, $atts) = @_;
    $self->clear();
    my $len = $atts->getLength();
    for (my $i = 0; $i < $len; $i++) {
	$self->{ATTRIBUTES}[$i][$URI] = $atts->getURI($i);
	$self->{ATTRIBUTES}[$i][$LNAME] = $atts->getLocalName($i);
	$self->{ATTRIBUTES}[$i][$QNAME] = $atts->getQName($i);
	$self->{ATTRIBUTES}[$i][$TYPE] = $atts->getType($i);
	$self->{ATTRIBUTES}[$i][$VALUE] = $atts->getValue($i);
    }
}

sub addAttribute {
    my ($self, $uri, $localName, $qName, $type, $value) = @_;
    push (@{$self->{ATTRIBUTES}}, [$qName, $type, $value, $uri, $localName]);
}

sub setAttribute {
    my ($self, $index, $uri, $localName, $qName, $type, $value) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index] = [$qName, $type, $value, $uri, $localName];
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub removeAttribute {
    my ($self, $index) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	splice(@{$self->{ATTRIBUTES}}, $index, 1);
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub setURI {
    my ($self, $index, $uri) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index][$URI] = $uri;
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub setLocalName {
    my ($self, $index, $localName) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index][$LNAME] = $localName;
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub setQName {
    my ($self, $index, $qName) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index][$QNAME] = $qName;
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub setType {
    my ($self, $index, $type) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index][$TYPE] = $type;
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub setValue {
    my ($self, $index, $value) = @_;
    if ($index >= 0 && $index < @{$self->{ATTRIBUTES}}) {
	$self->{ATTRIBUTES}[$index][$VALUE] = $value;
    } else {
	&throw(new W3C::Util::OutOfBoundsException(-index => $index, -name => 'W3C::XML::AttributesImpl ATTRIBUTES'));
    }
}

sub _getRecordNumber {
    my ($self, $indexOrUriOrQName, $localNameOrNull) = @_;
    if ($indexOrUriOrQName =~ /^\d+$/) {
	if ($indexOrUriOrQName >= 0 && $indexOrUriOrQName < @{$self->{ATTRIBUTES}}) {
	    return $indexOrUriOrQName;
	}
    } elsif ($localNameOrNull) {
	for (my $i = 0; $i < @{$self->{ATTRIBUTES}}; $i++) {
	    if ($self->{ATTRIBUTES}[$i][$URI] eq $indexOrUriOrQName && $self->{ATTRIBUTES}[$i][$LNAME] eq $localNameOrNull) {
		return $i;
	    }
	}
    } else {
	for (my $i = 0; $i < @{$self->{ATTRIBUTES}}; $i++) {
	    if ($self->{ATTRIBUTES}[$i][$QNAME] eq $indexOrUriOrQName) {
		return $i;
	    }
	}
    }
    return undef;
}

sub toString {
    my ($self, $prefix, $namespaceHandler) = @_;
    my $ret; # = 'default namespace: '.$self->{DEFAULT_NAMESPACE}."\n";
    map {
	my $nameNs = $_->[$URI];
	my $name = $_->[$QNAME];
	$name = $nameNs.':'.$name if ($nameNs);
	my $valueNs = $_->[$VURI];
	my $value = $_->[$VALUE];
	$value = $valueNs.':'.$value if ($valueNs);
	$ret .=$name.'('.$_->[$TYPE].'): '.$value."\n"
	} @{$self->{ATTRIBUTES}};
    return $ret;
}

package W3C::XML::AttributeListImpl;

1;

__END__

=head1 NAME

W3C::XML::AttributeListImpl - implementation of the SAX AttributeList interface

=head1 SYNOPSIS

  use W3C::XML::AttributeListImpl;
  my $attributeList = new W3C::XML::AttributeListImpl;
  $attributeList->addAttribute($attrname, "CDATA", $attrvalue);

=head1 DESCRIPTION

This is an implementation of the SAX AttributeList interface.

This module is part of the W3C::XML CPAN module.

=head1 AUTHOR

Eric Prud\'hommeaux <eric@w3.org>

=head1 SEE ALSO

W3C::XML::XmlParser(3) perl(1).

=cut

