view release on metacpan or  search on metacpan

lib/Net/XMPP3/Stanza.pm  view on Meta::CPAN

        my $childPath = "";
        while(($path !~ /^\/?\@/) && ($path !~ /^\/?text\(\)/))
        {
            #$self->_debug("_xpath_set: Multi-level!!!!");
            my ($child) = ($path =~ /^\/?([^\/]+)/);
            $path =~ s/^\/?[^\/]+//;
            #$self->_debug("_xpath_set: path($path)");
            #$self->_debug("_xpath_set: childPath($childPath)");

            if (($type eq "scalar") || ($type eq "jid") || ($type eq "timestamp"))
            {
                my $tmpPath = $child;
                $tmpPath = "$childPath/$child" if ($childPath ne "");

                my @nodes = $self->{TREE}->XPath("$tmpPath");
                #$self->_debug("_xpath_set: \$#nodes($#nodes)");
                if ($#nodes == -1)
                {
                    if ($childPath eq "")
                    {
                        $node = $self->{TREE}->add_child($child);
                    }
                    else
                    {
                        my $tree = $self->{TREE}->XPath("$childPath");
                        $node = $tree->add_child($child);
                    }
                }
                else
                {
                    $node = $nodes[0];
                }
            }

            if ($type eq "array")
            {
                $node = $self->{TREE}->add_child($child);
            }

            if ($type eq "flag")
            {
                $node = $self->{TREE}->add_child($child);
                return;
            }

            $childPath .= "/" unless ($childPath eq "");
            $childPath .= $child;
        }

        my ($piece) = ($path =~ /^\/?([^\/]+)/);

        #$self->_debug("_xpath_set: piece($piece)");

        if ($piece =~ /^\@(.+)$/)
        {
            $node->put_attrib($1=>$val);
        }
        elsif ($piece eq "text()")
        {
            $node->remove_cdata();
            $node->add_cdata($val);
        }
    }
}


##############################################################################
#
# _xpath_defined - returns true if there is data for the requested item, false
#                otherwise.
#
##############################################################################
sub _xpath_defined
{
    my $self = shift;
    my $type = shift;
    my $xpath = shift;
    my $childtype = shift;
    my $ns = shift;

    $self->_debug("_xpath_defined: self($self) type($type) xpath($xpath) childtype($childtype)");
    $self->_debug("_xpath_defined: ns($ns)") if defined($ns);
    $self->_debug("_xpath_defined: xml(",$self->{TREE}->GetXML(),")");

    my $subType;
    ($type,$subType) = $self->_xpath_resolve_types($type);
    $self->_debug("_xpath_defined: type($type) subType($subType) ");

    if ($type eq "raw")
    {
        if ($#{$self->{RAWXML}} > -1)
        {
            return 1;
        }
    }

    my @nodes = $self->{TREE}->XPath($xpath);
    # If the $ns is defined, then the presence of nodes does not mean
    # we're defined, we have to check them.
    my $defined = ( @nodes > 0 && !defined($ns) );

    $self->_debug("_xpath_defined: nodes(",join(",",@nodes),")");

    if (!@nodes && (($type eq "child") || ($type eq "children") || ($type eq "node")))
    {
        if ((ref($childtype) eq "HASH") && exists($childtype->{ns}))
        {
            $ns = $childtype->{ns};
        }
    }

    $self->_debug("_xpath_defined: ns(".$ns.") defined(".$defined.")") if defined($ns);

    foreach my $packet (@{$self->{CHILDREN}})
    {
	    $self->_debug("_xpath_defined: packet->GetXMLNS ",$packet->GetXMLNS());
        if (defined($ns) && ($packet->GetXMLNS() eq $ns))
        {
            $defined = 1;
            last;
        }