view release on metacpan or  search on metacpan

lib/XML/DT/Sequence.pm  view on Meta::CPAN

                 },
                 -body => {
                        item => sub {
                            # XML::DT like handler
                        }
                 },
                 -foot => sub {
                      my ($self, $xml) = @_;
                      # do something with $xml
                 },
                );

=head1 EXPLANATION

There are four options, only two mandatory: C<-tag> and
C<-body>. C<-tag> is the element name that repeats in the XML file,
and that you want to process one at a time. C<-body> is the handler to
process each one of these elements.

C<-head> is the handler to process the XML that appears before the
first instance of the repeating element, and C<-foot> the handler to
process the XML that apperas after the last instance of the repeating
element.

Each one of these handlers can be a code reference that receives the
C<XML::DT::Sequence> object and the XML string, or a hash reference,
with L<XML::DT> handlers to process each XML snippet.

Note that when processing header or footer, XML is incomplete, and the
parser can recover in weird ways.

The C<process> method returns a hash reference with three keys:
C<-head> is the return value of the C<-head> handler, and C<-foot> is
the return value of the C<-foot> handler. C<-body> is the number of
elements of the sequence that were processed.

=head1 METHODS

=head2 new

Constructor.

=head2 process

Processor. Se explanation above.

=head2 break

Forces the process to finish. Useful when you processed enough number
of elements. Note that if you break the process the C<-foot> code will
not be run.

If you are using a code reference as a handler, call it from the first
argument (reference to the object). If you are using a C<XML::DT>
handler, C<< $u >> has the object, so just call C<break> on it.

=cut

sub new {
    my ($class) = @_;
    return bless { } => $class;
}

sub break {
    my $self = shift;
    $self->{BREAK} = 1;
}

sub process {
    my ($self, $file, %ops) = @_;

    die "Option -tag is mantatory." unless exists $ops{-tag};

    local $/ = "</$ops{-tag}>";

    # XXX - fixme... utf8?
    open my $fh, "<:utf8", $file or die "Can't open file $file for reading [$!]";
    my $firstChunk = <$fh>;

    die "No $/ tag found. Bailing out." unless $firstChunk =~ $/;

    my $head = $firstChunk;
    $head =~ s/<$ops{-tag}.*//s;

    ## Process header if there is such a handler
    my $headReturn = undef;
    if (exists($ops{-head})) {
        my $headCode = $ops{-head};
        if (ref($headCode) eq "CODE") {
            $headReturn = $headCode->($self, $head);
        }
        elsif (ref($headCode) eq "HASH") {
            $headReturn = dtstring($head, -recover => 1, -userdata => $self, %$headCode);
        }
        else {
            die "No idea what to do with -head of type ".ref($ops{-head});
        }
    }

    ## process the sequence
    my $chunk = $firstChunk;
    my $totalElems = 0;
    my $bodyCode = $ops{-body} || undef;
    my $code;

    if (!$bodyCode) {
        $code = sub { };
    } elsif (ref($bodyCode) eq "CODE") {
        $code = sub { $bodyCode->($self, $_[0]) };
    } elsif (ref($bodyCode) eq "HASH") {
        $code = sub { dtstring($_[0], -userdata=> $self, %$bodyCode) }
    } else {
        die "No idea what to do with -body of type ".ref($ops{-body});
    }

    do {
        ++$totalElems;
        $chunk =~ s/^.*(?=<$ops{-tag})//s;
        $code->($chunk);
        $chunk = <$fh>;
    } while ($chunk =~ m{</$ops{-tag}>} and !$self->{BREAK});