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;