package CommonObject;
use strict;
use XML::LibXML;
use vars qw{ @ISA };
@ISA= qw{ XML::LibXML::Element };
sub createTextField {
my ($self, $fieldname, $fieldvalue) = @_;
my ($newelem, $textnode);
if (defined($fieldname)) {
$newelem = XML::LibXML::Element->new($fieldname);
} else {
return undef;
}
# The Perl XML::LibXML implementation requires that a text node's data be
# set to a defined value, so we set it to an empty string if $fieldvalue
# is undefined. This will happen if an initial text field value is not
# specified.
#
$fieldvalue = '' unless (defined($fieldvalue));
if ($newelem) {
$textnode = XML::LibXML::Text->new($fieldvalue);
} else {
return undef;
}
if (defined($textnode)) {
$newelem->appendChild($textnode);
$self->appendChild($newelem);
} else {
return undef;
}
return $newelem;
}
sub setTextFieldValue {
my $self = shift;
my $fieldname = shift;
my $newvalue = shift;
if (defined($fieldname)) {
my $nodelist = $self->findnodes("./$fieldname");
my $node = $nodelist->item(0) if ($nodelist->size() > 0);
return undef unless defined($node);
my $textnode = $node->getFirstChild();
if ($textnode->isa('XML::LibXML::Text')) {
my $oldvalue = $textnode->getData();
if (defined($oldvalue)) {
$oldvalue =~ s/^\s+//; # Cut leading whitespace.
$oldvalue =~ s/\s+$//; # Cut trailing whitespace.
} else {
$oldvalue = '';
}
if (defined($newvalue)) {
$textnode->setData($newvalue);
} else {
$textnode->setData('');
}
return $oldvalue;
} else {
return undef;
}
}
return undef;
}
sub getTextFieldValue {
my $self = shift;
my $fieldname = shift;
if (defined($fieldname)) {
my $node;
foreach my $child ($self->childNodes()) {
if ($child->isa('XML::LibXML::Element')) {
my $name = $child->localname();
if ($name eq $fieldname) {
$node = $child;
last;
}
}
}
return undef unless defined($node);
my $textnode = $node->getFirstChild();
#printf(qq{Found Text node: $textnode with data "%s"\n},
# $textnode->getData());
if (defined($textnode) && $textnode->isa('XML::LibXML::Text')) {
my $value = $textnode->getData();
if (defined($value)) {
$value =~ s/^\s+//; # Cut leading whitespace.
$value =~ s/\s+$//; # Cut trailing whitespace.
} else {
$value = '';
}
return $value;
} else {
return '';
}
}
return undef;
}
1;
####
package Foo;
use strict;
use XML::LibXML;
use CommonObject;
use vars qw{ @ISA };
@ISA = qw{ CommonObject };
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = XML::LibXML::Element->new('Foo');
#my $doc = XML::LibXML::Document->new();
#$doc->setDocumentElement($self);
bless($self, $class);
$self->createTextField('Name');
return $self;
}
sub setName {
my $self = shift;
my $name = shift;
return $self->setTextFieldValue('Name', $name);
}
sub getName {
my $self = shift;
return $self->getTextFieldValue('Name');
}
1;
####
#!/usr/bin/perl -w
use strict;
use XML::LibXML;
use Foo;
my $foo = Foo->new();
my $doc = XML::LibXML::Document->new();
print "\$foo is a ", ref($foo), " object reference\n";
my $docelem = XML::LibXML::Element->new('Root');
$doc->setDocumentElement($docelem);
$docelem->appendChild($foo);
$foo->setName('Bar');
my $name = $foo->getName();
print qq{\$foo->getName() returned "$name"\n\n};
print qq{Notice that my object has type "Foo" here:\n};
my $localname = $foo->localname();
print "My object: $foo ($localname)\n\n";
my $nodes = $doc->findnodes('//Name');
my $s = scalar(@{$nodes}) == 1 ? '' : 's';
print "Found ", scalar(@{$nodes}), " node$s:\n";
foreach my $node (@{$nodes}) {
print " ", $node->toString(), "\n";
my $parent = $node->parentNode();
print " From a subelement of my object, I call parentNode().\n";
print " Now notice that my object is no longer a Foo object:\n\n";
my $plm = $parent->localname();
print " My parent: $parent ($plm)\n\n";
print " The reference returned by parantNode() is not the same\n";
print " as the original reference:\n\n";
print " ($foo != $parent)\n";
}
print "\n", "Document:\n", $doc->toString(), "\n";