view release on metacpan or  search on metacpan

lib/XML/Stream/Parser/DTD.pm  view on Meta::CPAN

    $dstr = $self->{ELEMENT}->{$dstr} if exists($self->{ELEMENT}->{$dstr});

    if ($dstr->{type} eq "element")
    {
        return 0 if ($dstr->{element} ne $tag);
        return 1 if !exists($dstr->{repeat});
        return 1 if (($dstr->{repeat} eq "+") && ($count == 1)) ;
    }
    else
    {
        return 0 if (($dstr->{repeat} eq "*") || ($dstr->{repeat} eq "?"));
        my $test = 0;
        foreach my $index (0..$#{$dstr->{list}})
        {
            $test = $test | $self->required($dstr->{list}->[$index],$tag,$count);
        }
        return $test;
    }
    return 0;
}


sub addchild
{
    my $self = shift;
    my ($tag,$child,$tree) = @_;

#  print "addchild: tag($tag) child($child)\n";

    my @current;
    if (defined($tree))
    {
#    &Net::Jabber::printData("\$tree",$tree);

        @current = &XML::Stream::GetXMLData("index array",$tree,"*","","");

#    &Net::Jabber::printData("\$current",\@current);
    }

    my @newBranch = $self->addchildrecurse($self->{ELEMENT}->{$tag},$child,\@current);

    return $tree unless ("@newBranch" ne "");

#  &Net::Jabber::printData("\$newBranch",\@newBranch);

    my $location = shift(@newBranch);

    if ($location eq "end")
    {
        splice(@{$$tree[1]},@{$$tree[1]},0,@newBranch);
    }
    else
    {
        splice(@{$$tree[1]},$location,0,@newBranch);
    }
    return $tree;
}


sub addcdata
{
    my $self = shift;
    my ($tag,$child,$tree) = @_;

#  print "addchild: tag($tag) child($child)\n";

    my @current;
    if (defined($tree))
    {
#    &Net::Jabber::printData("\$tree",$tree);

        @current = &XML::Stream::GetXMLData("index array",$tree,"*","","");

#    &Net::Jabber::printData("\$current",\@current);
    }

    my @newBranch = $self->addchildrecurse($self->{ELEMENT}->{$tag},$child,\@current);

    return $tree unless ("@newBranch" ne "");

#  &Net::Jabber::printData("\$newBranch",\@newBranch);

    my $location = shift(@newBranch);

    if ($location eq "end")
    {
        splice(@{$$tree[1]},@{$$tree[1]},0,@newBranch);
    }
    else
    {
        splice(@{$$tree[1]},$location,0,@newBranch);
    }
    return $tree;
}


sub addchildrecurse
{
    my $self = shift;
    my ($dstr,$child,$current) = @_;

#  print "addchildrecurse: child($child) type($dstr->{type})\n";

    if ($dstr->{type} eq "element")
    {
#    print "addchildrecurse: tag($dstr->{element})\n";
        my $count = 0;
        while(($#{@{$current}} > -1) && ($dstr->{element} eq $$current[0]))
        {
            shift(@{$current});
            shift(@{$current});
            $count++;
        }
        if (($dstr->{element} eq $child) &&
            ($self->repeatcheck($dstr,(($count > 0) ? $child : "")) == 1))
        {
            my @return = ( "end" , $self->newbranch($child));
            @return = ($$current[1], $self->newbranch($child))
                if ($#{@{$current}} > -1);
#      print "addchildrecurse: Found the spot! (",join(",",@return),")\n";