summaryrefslogtreecommitdiff
path: root/Master/Tools/XML/DOM
diff options
context:
space:
mode:
Diffstat (limited to 'Master/Tools/XML/DOM')
-rw-r--r--Master/Tools/XML/DOM/DOMException.pm88
-rw-r--r--Master/Tools/XML/DOM/NamedNodeMap.pm271
-rw-r--r--Master/Tools/XML/DOM/NodeList.pm46
-rw-r--r--Master/Tools/XML/DOM/PerlSAX.pm47
4 files changed, 452 insertions, 0 deletions
diff --git a/Master/Tools/XML/DOM/DOMException.pm b/Master/Tools/XML/DOM/DOMException.pm
new file mode 100644
index 00000000000..d49c69859a4
--- /dev/null
+++ b/Master/Tools/XML/DOM/DOMException.pm
@@ -0,0 +1,88 @@
+######################################################################
+package XML::DOM::DOMException;
+######################################################################
+
+use Exporter;
+
+use overload '""' => \&stringify;
+use vars qw ( @ISA @EXPORT @ErrorNames );
+
+BEGIN
+{
+ @ISA = qw( Exporter );
+ @EXPORT = qw( INDEX_SIZE_ERR
+ DOMSTRING_SIZE_ERR
+ HIERARCHY_REQUEST_ERR
+ WRONG_DOCUMENT_ERR
+ INVALID_CHARACTER_ERR
+ NO_DATA_ALLOWED_ERR
+ NO_MODIFICATION_ALLOWED_ERR
+ NOT_FOUND_ERR
+ NOT_SUPPORTED_ERR
+ INUSE_ATTRIBUTE_ERR
+ );
+}
+
+sub UNKNOWN_ERR () {0;} # not in the DOM Spec!
+sub INDEX_SIZE_ERR () {1;}
+sub DOMSTRING_SIZE_ERR () {2;}
+sub HIERARCHY_REQUEST_ERR () {3;}
+sub WRONG_DOCUMENT_ERR () {4;}
+sub INVALID_CHARACTER_ERR () {5;}
+sub NO_DATA_ALLOWED_ERR () {6;}
+sub NO_MODIFICATION_ALLOWED_ERR () {7;}
+sub NOT_FOUND_ERR () {8;}
+sub NOT_SUPPORTED_ERR () {9;}
+sub INUSE_ATTRIBUTE_ERR () {10;}
+
+@ErrorNames = (
+ "UNKNOWN_ERR",
+ "INDEX_SIZE_ERR",
+ "DOMSTRING_SIZE_ERR",
+ "HIERARCHY_REQUEST_ERR",
+ "WRONG_DOCUMENT_ERR",
+ "INVALID_CHARACTER_ERR",
+ "NO_DATA_ALLOWED_ERR",
+ "NO_MODIFICATION_ALLOWED_ERR",
+ "NOT_FOUND_ERR",
+ "NOT_SUPPORTED_ERR",
+ "INUSE_ATTRIBUTE_ERR"
+ );
+sub new
+{
+ my ($type, $code, $msg) = @_;
+ my $self = bless {Code => $code}, $type;
+
+ $self->{Message} = $msg if defined $msg;
+
+# print "=> Exception: " . $self->stringify . "\n";
+ $self;
+}
+
+sub getCode
+{
+ $_[0]->{Code};
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub getName
+{
+ $ErrorNames[$_[0]->{Code}];
+}
+
+sub getMessage
+{
+ $_[0]->{Message};
+}
+
+sub stringify
+{
+ my $self = shift;
+
+ "XML::DOM::DOMException(Code=" . $self->getCode . ", Name=" .
+ $self->getName . ", Message=" . $self->getMessage . ")";
+}
+
+1; # package return code
diff --git a/Master/Tools/XML/DOM/NamedNodeMap.pm b/Master/Tools/XML/DOM/NamedNodeMap.pm
new file mode 100644
index 00000000000..3747d545f0a
--- /dev/null
+++ b/Master/Tools/XML/DOM/NamedNodeMap.pm
@@ -0,0 +1,271 @@
+######################################################################
+package XML::DOM::NamedNodeMap;
+######################################################################
+
+use strict;
+
+use Carp;
+use XML::DOM::DOMException;
+use XML::DOM::NodeList;
+
+use vars qw( $Special );
+
+# Constant definition:
+# Note: a real Name should have at least 1 char, so nobody else should use this
+$Special = "";
+
+sub new
+{
+ my ($class, %args) = @_;
+
+ $args{Values} = new XML::DOM::NodeList;
+
+ # Store all NamedNodeMap properties in element $Special
+ bless { $Special => \%args}, $class;
+}
+
+sub getNamedItem
+{
+ # Don't return the $Special item!
+ ($_[1] eq $Special) ? undef : $_[0]->{$_[1]};
+}
+
+sub setNamedItem
+{
+ my ($self, $node) = @_;
+ my $prop = $self->{$Special};
+
+ my $name = $node->getNodeName;
+
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR)
+ if $self->isReadOnly;
+
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR)
+ if $node->[XML::DOM::Node::_Doc] != $prop->{Doc};
+
+ croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR)
+ if defined ($node->[XML::DOM::Node::_UsedIn]);
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "can't add name with NodeName [$name] to NamedNodeMap")
+ if $name eq $Special;
+ }
+
+ my $values = $prop->{Values};
+ my $index = -1;
+
+ my $prev = $self->{$name};
+ if (defined $prev)
+ {
+ # decouple previous node
+ $prev->decoupleUsedIn;
+
+ # find index of $prev
+ $index = 0;
+ for my $val (@{$values})
+ {
+ last if ($val == $prev);
+ $index++;
+ }
+ }
+
+ $self->{$name} = $node;
+ $node->[XML::DOM::Node::_UsedIn] = $self;
+
+ if ($index == -1)
+ {
+ push (@{$values}, $node);
+ }
+ else # replace previous node with new node
+ {
+ splice (@{$values}, $index, 1, $node);
+ }
+
+ $prev;
+}
+
+sub removeNamedItem
+{
+ my ($self, $name) = @_;
+
+ # Be careful that user doesn't delete $Special node!
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR)
+ if $name eq $Special;
+
+ my $node = $self->{$name};
+
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR)
+ unless defined $node;
+
+ # The DOM Spec doesn't mention this Exception - I think it's an oversight
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR)
+ if $self->isReadOnly;
+
+ $node->decoupleUsedIn;
+ delete $self->{$name};
+
+ # remove node from Values list
+ my $values = $self->getValues;
+ my $index = 0;
+ for my $val (@{$values})
+ {
+ if ($val == $node)
+ {
+ splice (@{$values}, $index, 1, ());
+ last;
+ }
+ $index++;
+ }
+ $node;
+}
+
+# The following 2 are really bogus. DOM should use an iterator instead (Clark)
+
+sub item
+{
+ my ($self, $item) = @_;
+ $self->{$Special}->{Values}->[$item];
+}
+
+sub getLength
+{
+ my ($self) = @_;
+ my $vals = $self->{$Special}->{Values};
+ int (@$vals);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ return 0 if $XML::DOM::IgnoreReadOnly;
+
+ my $used = $_[0]->{$Special}->{UsedIn};
+ defined $used ? $used->isReadOnly : 0;
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+ my $prop = $self->{$Special};
+
+ my $map = new XML::DOM::NamedNodeMap (Doc => $prop->{Doc});
+ # Not copying Parent property on purpose!
+
+ local $XML::DOM::IgnoreReadOnly = 1; # temporarily...
+
+ for my $val (@{$prop->{Values}})
+ {
+ my $key = $val->getNodeName;
+
+ my $newNode = $val->cloneNode ($deep);
+ $newNode->[XML::DOM::Node::_UsedIn] = $map;
+ $map->{$key} = $newNode;
+ push (@{$map->{$Special}->{Values}}, $newNode);
+ }
+
+ $map;
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ my $special = $self->{$Special};
+
+ $special->{Doc} = $doc;
+ for my $kid (@{$special->{Values}})
+ {
+ $kid->setOwnerDocument ($doc);
+ }
+}
+
+sub getChildIndex
+{
+ my ($self, $attr) = @_;
+ my $i = 0;
+ for my $kid (@{$self->{$Special}->{Values}})
+ {
+ return $i if $kid == $attr;
+ $i++;
+ }
+ -1; # not found
+}
+
+sub getValues
+{
+ wantarray ? @{ $_[0]->{$Special}->{Values} } : $_[0]->{$Special}->{Values};
+}
+
+# Remove circular dependencies. The NamedNodeMap and its values should
+# not be used afterwards.
+sub dispose
+{
+ my $self = shift;
+
+ for my $kid (@{$self->getValues})
+ {
+ undef $kid->[XML::DOM::Node::_UsedIn]; # was delete
+ $kid->dispose;
+ }
+
+ delete $self->{$Special}->{Doc};
+ delete $self->{$Special}->{Parent};
+ delete $self->{$Special}->{Values};
+
+ for my $key (keys %$self)
+ {
+ delete $self->{$key};
+ }
+}
+
+sub setParentNode
+{
+ $_[0]->{$Special}->{Parent} = $_[1];
+}
+
+sub getProperty
+{
+ $_[0]->{$Special}->{$_[1]};
+}
+
+#?? remove after debugging
+sub toString
+{
+ my ($self) = @_;
+ my $str = "NamedNodeMap[";
+ while (my ($key, $val) = each %$self)
+ {
+ if ($key eq $Special)
+ {
+ $str .= "##Special (";
+ while (my ($k, $v) = each %$val)
+ {
+ if ($k eq "Values")
+ {
+ $str .= $k . " => [";
+ for my $a (@$v)
+ {
+# $str .= $a->getNodeName . "=" . $a . ",";
+ $str .= $a->toString . ",";
+ }
+ $str .= "], ";
+ }
+ else
+ {
+ $str .= $k . " => " . $v . ", ";
+ }
+ }
+ $str .= "), ";
+ }
+ else
+ {
+ $str .= $key . " => " . $val . ", ";
+ }
+ }
+ $str . "]";
+}
+
+1; # package return code
diff --git a/Master/Tools/XML/DOM/NodeList.pm b/Master/Tools/XML/DOM/NodeList.pm
new file mode 100644
index 00000000000..81aad84881c
--- /dev/null
+++ b/Master/Tools/XML/DOM/NodeList.pm
@@ -0,0 +1,46 @@
+######################################################################
+package XML::DOM::NodeList;
+######################################################################
+
+use vars qw ( $EMPTY );
+
+# Empty NodeList
+$EMPTY = new XML::DOM::NodeList;
+
+sub new
+{
+ bless [], $_[0];
+}
+
+sub item
+{
+ $_[0]->[$_[1]];
+}
+
+sub getLength
+{
+ int (@{$_[0]});
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub dispose
+{
+ my $self = shift;
+ for my $kid (@{$self})
+ {
+ $kid->dispose;
+ }
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ for my $kid (@{$self})
+ {
+ $kid->setOwnerDocument ($doc);
+ }
+}
+
+1; # package return code
diff --git a/Master/Tools/XML/DOM/PerlSAX.pm b/Master/Tools/XML/DOM/PerlSAX.pm
new file mode 100644
index 00000000000..f025cce0afd
--- /dev/null
+++ b/Master/Tools/XML/DOM/PerlSAX.pm
@@ -0,0 +1,47 @@
+package XML::DOM::PerlSAX;
+use strict;
+
+BEGIN
+{
+ if ($^W)
+ {
+ warn "XML::DOM::PerlSAX has been renamed to XML::Handler::BuildDOM, please modify your code accordingly.";
+ }
+}
+
+use XML::Handler::BuildDOM;
+use vars qw{ @ISA };
+@ISA = qw{ XML::Handler::BuildDOM };
+
+1; # package return code
+
+__END__
+
+=head1 NAME
+
+XML::DOM::PerlSAX - Old name of L<XML::Handler::BuildDOM>
+
+=head1 SYNOPSIS
+
+ See L<XML::DOM::BuildDOM>
+
+=head1 DESCRIPTION
+
+XML::DOM::PerlSAX was renamed to L<XML::Handler::BuildDOM> to comply
+with naming conventions for PerlSAX filters/handlers.
+
+For backward compatibility, this package will remain in existence
+(it simply includes XML::Handler::BuildDOM), but it will print a warning when
+running with I<'perl -w'>.
+
+=head1 AUTHOR
+
+Enno Derksen is the original author.
+
+Send bug reports, hints, tips, suggestions to T.J Mather at
+<F<tjmather@tjmather.com>>.
+
+=head1 SEE ALSO
+
+L<XML::Handler::BuildDOM>, L<XML::DOM>
+