CommonObject.pm - base class for most of the classes in my application. Contains methods for accessing the data members of my objects, which are implemented as subelements of an XML::LibXML::Element objects blessed into my class.

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 $fiel
+dvalue
    # is undefined.  This will happen if an initial text field value i
+s 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;
[download]

Foo.pm - simplified example of one of the classes in my application.

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;
[download]

testfoo - sample test script illustrating the problem.

#!/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";
[download]