view release on metacpan or  search on metacpan

lib/Jabber/NodeFactory.pm  view on Meta::CPAN

sub _endTag {

  my ($self, $expat, $tag) = @_;
  $self->_debug("END  : $tag");
  $self->{depth} -= 1;
# $self->{currnode} = $self->{node}->parent();
  $self->{currnode} = $self->{currnode}->parent();

}

sub _charData {

  my ($self, $expat, $data) = @_;
  $self->_debug("DATA : $data");
  $self->{currnode}->data($self->{currnode}->data().$data);

}

=back

=cut

############################################################################

package Jabber::NodeFactory::Node;

=head1 METHODS in Jabber::NodeFactory::Node

=over 4

=item new()

Construct a new node. Returns a Jabber::NodeFactory::Node object. You must
specify a tag name for the node.

Example:

  my $tag1 = new Jabber::NodeFactory::Node('tag1');

$tag1 represents a node that looks like this:

  <tag1/>

=cut

use Scalar::Util qw(weaken);

sub new {

  my ($class, $name, $xmlns, $parent) = @_;

  my $node = {
               name   => $name,
               attrs  => {},
               data   => '',
               kids   => [],
               parent => $parent,
             };

  weaken($node->{parent}); # XXX
  bless $node => $class;
  $node->attr('xmlns' => $xmlns) if $xmlns;
  return $node;

}


=item name()

Returns the name (the tag name) of the node, in the form of a string.

=cut

sub name {
  my $self = shift;
  return $self->{name};
}


=item parent()

Returns the node's parent. This will be a node object or undef (if
it doesn't have a parent).

=cut

sub parent { 
  my $self = shift;
  return $self->{parent};
}


# sets parent; called from insertTag()
sub _setParent {
  my $self = shift;
  my $parent = shift;
  $self->{parent} = $parent;
  return $self->{parent};
}


=item attr()

Sets or gets a node attribute. Pass one argument - an attribute 
name - to get the value, or two arguments - the name and a value - 
to set the value. In both cases the value is returned.

Example:

  $tag1->attr('colour' => 'red');
  print $tag1->attr('colour');

prints

  red

=cut

sub attr {

  my ($self, $attr, $val) = @_;