package ENode;
use Carp;
# This lets us printout and veiw $node as the $node->{path}
# as long as we are using it as a string.
use overload
'""' => \&path,
'!' => \&isnotnode,
'bool' => \&isanode;
#print ("Loading ENode.pl\n");
# Used internally to export methods to other namespaces.
sub import
{
my ($caller_package) = caller;
foreach $method (@_) {
*{"${caller_package}::${method}"} = *{"ENode::${method}"};
}
}
# Create a new node given a path (this one is exported)
sub enode
{
my ($path) = @_;
return (ENode::new ('ENode', $path));
}
sub enode_rx
{
my ($regex) = @_;
my $obj = ENode::new ('ENode', "object");
if (!$obj) {
return undef;
}
return ($obj->child_rx ($regex));
}
sub elist
{
my ($basename, $search) = @_;
my $obj = ENode::new ('ENode', "object");
if (!$obj) {
return undef;
}
return ($obj->children ($basename, $search));
}
sub elist_rx
{
my ($regex) = @_;
my $obj = ENode::new ('ENode', "object");
if (!$obj) {
return undef;
}
return ($obj->children_rx ($regex));
}
# Create a new enode object.
sub new
{
my ($class, $path) = @_;
my ($mytype, $myname);
my $__enodeptr = Entity::enode_ptr ($path);
my $self = {};
bless ($self, $class);
$self->{__enodeptr} = $__enodeptr;
if ($self->{__enodeptr} != 0) {
Entity::enode_ref ($self->{__enodeptr});
}
return ($self);
}
# for use from inside entity
sub new_from_ptr
{
my ($class, $ptr) = @_;
if ($ptr == 0) {
return;
}
my $self = {};
bless ($self, $class);
$self->{__enodeptr} = $ptr;
Entity::enode_ref ($self->{__enodeptr});
return ($self);
}
# destructor for releasing node reference
sub DESTROY
{
my ($self) = @_;
if ($self->{__enodeptr} != 0) {
Entity::enode_unref ($self->{__enodeptr});
}
}
# Call a function in another object/lang.
sub call
{
my $self = shift;
node_broken ($self);
return ( Entity::enode_call ($self->{__enodeptr}, @_) );
}
# Get/set attributes for a node
sub attrib
{
my $self = shift;
node_broken ($self);
my ($attribute, $value, $i);
# I _think_ this way is more efficient as it avoids excessive copies.
# We are already copying all the attributes in when we call the method...
if (@_ == 1) {
$attribute = shift;
return (Entity::enode_attrib ($self->{__enodeptr}, $attribute));
} else {
for ($i = 0; $i < @_; $i += 2) {
$attribute = $_[$i];
$value = $_[$i + 1];
Entity::enode_attrib ($self->{__enodeptr}, $attribute, $value);
}
}
}
sub attrib_quiet
{
my $self = shift;
node_broken ($self);
my ($attribute, $value, $i);
# I _think_ this way is more efficient as it avoids excessive copies.
# We are already copying all the attributes in when we call the method...
if (@_ == 1) {
$attribute = shift;
return (Entity::enode_attrib_quiet ($self->{__enodeptr}, $attribute));
} else {
for ($i = 0; $i < @_; $i += 2) {
$attribute = $_[$i];
$value = $_[$i + 1];
Entity::enode_attrib_quiet ($self->{__enodeptr}, $attribute, $value);
}
}
}
# Check the truth of an atrrib. I wonder if we really need this function.
sub attrib_is_true
{
my $self = shift;
node_broken ($self);
Entity::enode_attrib_is_true ($self->{__enodeptr}, shift);
}
# Setup the attribs, only needed by userrend.
sub attribs_sync
{
my $self = shift;
node_broken ($self);
Entity::enode_attribs_sync ($self->{__enodeptr});
}
# Get data of a node
sub get_xml
{
my $self = shift;
node_broken ($self);
return (Entity::enode_get_xml ($self->{__enodeptr}));
}
# Get data of a node
sub get_child_xml
{
my $self = shift;
node_broken ($self);
return (Entity::enode_get_child_xml ($self->{__enodeptr}));
}
# Append new xml
sub append_xml
{
my ($self, $xml) = @_;
node_broken ($self);
Entity::enode_append_xml ($self->{__enodeptr}, $xml);
}
# Delete tree
sub delete
{
my ($self) = @_;
node_broken ($self);
print ("The delete method of the ENode class is depricated, please use destroy instead.\n");
Entity::enode_delete ($self->{__enodeptr});
# Normally, you'd think that setting the pointer to NULL
# at this point would make sense, but we have to let the
# reference counting handle this, or the node will never
# really get deleted.
#$self->{__enodeptr} = 0;
}
sub delete_children
{
my ($self) = @_;
node_broken ($self);
print ("The delete_children method of the ENode class is depricated, please use destroy_children instead.\n");
Entity::enode_delete_children ($self->{__enodeptr});
}
# Delete tree
sub destroy
{
my ($self) = @_;
node_broken ($self);
Entity::enode_destroy ($self->{__enodeptr});
# Normally, you'd think that setting the pointer to NULL
# at this point would make sense, but we have to let the
# reference counting handle this, or the node will never
# really get deleted.
#$self->{__enodeptr} = 0;
}
sub destroy_children
{
my ($self) = @_;
node_broken ($self);
Entity::enode_destroy_children ($self->{__enodeptr});
}
sub new_child
{
my $self = shift;
my $type = shift;
my $__enodeptr;
node_broken ($self);
my $__enodeptr = Entity::enode_new_child ($self->{__enodeptr}, $type, @_);
return (ENode::new_from_ptr ('ENode', $__enodeptr));
}
sub child
{
my ($self, $search) = @_;
node_broken ($self);
my $__enodeptr = Entity::enode_child ($self->{__enodeptr}, $search);
return (ENode::new_from_ptr ('ENode', $__enodeptr));
}
sub child_rx
{
my ($self, $search) = @_;
node_broken ($self);
my $__enodeptr = Entity::enode_child_rx ($self->{__enodeptr}, $search);
return (ENode::new_from_ptr ('ENode', $__enodeptr));
}
sub children
{
my ($self, $search) = @_;
my (@nodes, $enodeptr, @list);
node_broken ($self);
if (defined ($search)) {
@list = Entity::enode_children ($self->{__enodeptr}, $search);
} else {
@list = Entity::enode_children ($self->{__enodeptr});
}
foreach $enodeptr (@list) {
if ($enodeptr != 0) {
push @nodes, ENode::new_from_ptr ('ENode', $enodeptr);
}
}
return @nodes;
}
sub children_rx
{
my ($self, $regex) = @_;
my (@nodes, $__enodeptr, @list);
node_broken ($self);
@list = Entity::enode_children_rx ($self->{__enodeptr}, $regex);
foreach $__enodeptr (@list) {
if ($__enodeptr != 0) {
push @nodes, ENode::new_from_ptr ('ENode', $__enodeptr);
}
}
return @nodes;
}
sub children_attrib
{
my ($self, $attrib, $value) = @_;
my (@nodes, $__enodeptr, @list);
node_broken ($self);
@list = Entity::enode_children_attrib ($self->{__enodeptr}, $attrib, $value);
foreach $__enodeptr (@list) {
if ($__enodeptr != 0) {
push @nodes, ENode::new_from_ptr ('ENode', $__enodeptr);
}
}
return @nodes;
}
sub children_attrib_rx
{
my ($self, $attrib, $regex) = @_;
my (@nodes, $__enodeptr, @list);
node_broken ($self);
@list = Entity::enode_children_attrib_rx ($self->{__enodeptr}, $attrib, $regex);
foreach $__enodeptr (@list) {
if ($__enodeptr != 0) {
push @nodes, ENode::new_from_ptr ('ENode', $__enodeptr);
}
}
return @nodes;
}
sub parent
{
my ($self, $search) = @_;
my $node;
node_broken ($self);
if (defined ($search)) {
$node = ENode::new_from_ptr ('ENode', Entity::enode_parent ($self->{__enodeptr}, $search));
} else {
$node = ENode::new_from_ptr ('ENode', Entity::enode_parent ($self->{__enodeptr}));
}
return ($node);
}
sub get_data
{
my ($self) = @_;
node_broken ($self);
return (Entity::enode_get_data ($self->{__enodeptr}));
}
sub set_data
{
my ($self, $data) = @_;
node_broken ($self);
Entity::enode_set_data ($self->{__enodeptr}, $data);
}
sub append_data
{
my ($self, $data) = @_;
node_broken ($self);
Entity::enode_append_data ($self->{__enodeptr}, $data);
}
sub insert_data
{
my ($self, $offset, $data) = @_;
node_broken ($self);
Entity::enode_insert_data ($self->{__enodeptr}, $offset, $data);
}
sub delete_data
{
my ($self, $offset, $count) = @_;
node_broken ($self);
Entity::enode_delete_data ($self->{__enodeptr}, $offset, $count);
}
sub type
{
my ($self) = @_;
node_broken ($self);
return (Entity::enode_type ($self->{__enodeptr}))
}
sub basename
{
my ($self) = @_;
node_broken ($self);
return (Entity::enode_type ($self->{__enodeptr}) . "." . $self->attrib ("name"))
}
sub list_set_attribs
{
my ($self) = @_;
node_broken ($self);
return (Entity::enode_list_set_attribs ($self->{__enodeptr}));
}
sub supported_attribs
{
my ($self) = @_;
node_broken ($self);
return (Entity::enode_supported_attribs ($self->{__enodeptr}));
}
sub attrib_description
{
my ($self, $attrib) = @_;
node_broken ($self);
return (Entity::enode_attrib_description ($self->{__enodeptr}, $attrib));
}
sub attrib_value_type
{
my ($self, $attrib) = @_;
node_broken ($self);
return (Entity::enode_attrib_value_type ($self->{__enodeptr}, $attrib));
}
sub attrib_possible_values
{
my ($self, $attrib) = @_;
node_broken ($self);
return (Entity::enode_attrib_possible_values ($self->{__enodeptr}, $attrib));
}
sub write
{
my $self = $_[0]; ### Don't want to modify the args list.
node_broken ($self);
return (Entity::enode_attrib ($self->{__enodeptr}, "_sendq", $_[1]));
}
#### OVERLOADED OPPERATORS. ####
# Returns path of node
sub path ## '""'
{
my $self = shift;
if (isnotnode ($self)) {
return (undef);
} else {
return (Entity::enode_path ($self->{__enodeptr}));
}
}
sub isanode ## 'bool'
{
my $self = shift;
return ($self->{__enodeptr});
}
sub isnotnode ## Opposite of isanode. '!'
{
return ( !isanode(shift) );
}
sub node_broken ## Called before doing anything special with a node.
{
my $self = shift;
if (!$self)
{
confess ("ENode not good.\n");
}
}
#print ("Loaded.\n");
return 1;
syntax highlighted by Code2HTML, v. 0.9.1