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";