view release on metacpan or  search on metacpan

lib/XML/Reader.pm  view on Meta::CPAN

                            $kval =~ s{'}'''xmsg;
                            $kval =~ s{<}'&lt;'xmsg;
                            $kval =~ s{>}'&gt;'xmsg;
                            $element .= qq{ $key='$kval'};
                        }
                        $element .= '>';
                    }
                    if ($self->{is_proc}) {
                        my $tgt = $self->{proc_tgt};
                        my $dat = $self->{proc_data};
                        for ($tgt, $dat) {
                            s{&}'&amp;'xmsg;
                            s{'}'&apos;'xmsg;
                            s{<}'&lt;'xmsg;
                            s{>}'&gt;'xmsg;
                        }
                        $element .= "<?$tgt $dat?>";
                    }
                    if ($self->{is_text}) {
                        my $tval = $self->{value};
                        if ($tval ne '') {
                            $tval =~ s{&}'&amp;'xmsg;
                            $tval =~ s{<}'&lt;'xmsg;
                            $tval =~ s{>}'&gt;'xmsg;
                            $element .= $tval;
                        }
                    }
                    if ($self->{is_comment}) {
                        my $tval = $self->{comment};
                        $tval =~ s{&}'&amp;'xmsg;
                        $tval =~ s{<}'&lt;'xmsg;
                        $tval =~ s{>}'&gt;'xmsg;
                        $element .= "<!-- $tval -->";
                    }
                    if ($self->{is_end}) {
                        $element .= '</'.$self->{tag}.'>';
                    }

                    $self->{bush}[$r] .= $element;
                }

                if ($border and $self->{is_end}) {
                    push @{$self->{rresult}}, [$r, $self->{bush}[$r]];
                    $param->{qrfix} = undef;
                }
            }
            redo;
        }

        # Here we check for the {using => ...} option
        $self->{prefix} = '';

        for my $check (@{$self->{using}}) {
            if ($check eq $self->{path}) {
                $self->{prefix} = $check;
                $self->{path}   = '/';
                $self->{level}  = 0;
                $self->{tag}    = ''; # unfortunately we have to nullify the tag here...
                last;
            }
            if ($check.'/' eq substr($self->{path}, 0, length($check) + 1)) { my @temp = split m{/}xms, $check;
                $self->{prefix} = $check;
                $self->{path}   = substr($self->{path}, length($check));
                $self->{level} -= @temp - 1;
                last;
            }
        }

        # check if option {using => ...} has been requested, and if so, then skip all
        # lines that don't have a prefix...
        if (@{$self->{using}} and $self->{prefix} eq '') {
            redo;
        }
    }

    return 1;
}

sub get_token {
    my $self = shift;

    until (@{$self->NB_data}) {
        # Here is the all important reading of a chunk of XML-data from the filehandle...

        my $buf;

        if (ref($self->NB_fh) eq 'Acme::HTTP') {
            my $ct = $self->NB_fh->read_entity_body($buf, 4096); # returns number of bytes read, or undef if IO-Error
            last unless $ct;
        }
        else {
            read($self->NB_fh, $buf, 4096);
        }

        # We leave immediately as soon as there is no more data left (EOF)
        last if $buf eq '';

        # and here is the all important parsing of that chunk:
        # and we could get exceptions thrown here if the XML is invalid...
        
        $self->{ExpatNB}->parse_more($buf);

        # ...the recommended way to catch those exceptions is not here, but by wrapping
        # eval{} around $rdr->iterate like follows
        #
        #    while (eval{$rdr->iterate}) {
        #        my $text = $rdr->value;
        #        # ...
        #    }
        #    if ($@) {
        #        print "found an error: $@\n";
        #    }
    }

    # return failure if end-of-file...
    unless (@{$self->NB_data}) {
        return;
    }

    my $token = shift @{$self->NB_data};
    bless $token, 'XML::Reader::Token';