view release on metacpan or  search on metacpan

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

    # Everything else
    else {  
        $self->{_curr_ref}->{$el} = $new_ref;
    }

    # Step up linked list
    $self->{_curr_ref} = $new_ref;

    return;

}

sub _handle_end {

    my ($self, $p, $el) = @_;

    # Track length of indexed elements
    if (defined $self->{_make_index}->{$el}) {
        my $iter = scalar @{ $self->{_curr_ref}->{__offsets} } - 1;
        my $offset = $self->{_curr_ref}->{__offsets}->[$iter];

        my $len = $p->current_byte - $offset;
        # Don't forget to add length of tag and "</>" chars
        # if an element is not empty (i.e. if it has a closing tag).
        # There may be a better way to deduce this based on the parser itself,
        # but current empty elements must be defined in the subclass itself.
        if (! defined $self->{_empty_el}->{$el}) {
            $len += length($el) + 3;
        }
        $self->{_curr_ref}->{__lengths}->[$iter] = $len;

    }

    # Reset handlers for skipped elements
    if (defined $self->{_skip_inside}->{$el}) {
        $p->setHandlers(
            Start => sub{ $self->_handle_start( @_) },
            End   => sub{ $self->_handle_end( @_) },
            Char  => sub{ $self->_handle_char( @_) },
        );
        delete $self->{_skip_parse};
        return;
    }

    # Don't do anything if inside skipped element
    return if ($self->{_skip_parse});

    # Step back down linked list
    my $last_ref = $self->{_curr_ref}->{_back};
    delete $self->{_curr_ref}->{_back};
    $self->{_curr_ref} = $last_ref;

    return;

}

sub _handle_char {

    my ($self, $p, $data) = @_;
    $self->{_curr_ref}->{pcdata} .= $data
        if ($data =~ /\S/);
    return;

}

sub goto {

    my ($self, $ref, $idx) = @_;
    croak "Bad list ref" if (! exists $ref->{__pos});
    croak "$idx not an integer" if ($idx =~ /\D/);
    # $idx allowed to be equal to count because this indicates end-of-records
    croak "$idx out of range" if ($idx < 0 || $idx > $ref->{__count});
    $ref->{__pos} = $idx;
    return;

}

sub fetch_record {

    my ($self, $ref, $idx, %args) = @_;

    croak "Bad list ref" if (! exists $ref->{__pos});
    
    # check record cache if used
    return $ref->{__memoized}->{$idx}
        if ($self->{__use_cache} && exists $ref->{__memoized}->{$idx});

    my $offset = $ref->{__offsets}->[ $idx ];
    croak "Record not found for $idx" if (! defined $offset);

    my $to_read = $ref->{__lengths}->[ $idx ];
    my $el   = $self->_read_element($offset,$to_read);

    my $type = $ref->{__record_type};
    my $class = $self->{__record_classes}->{$type};
    croak "No class defined for record type $type\n" if (! defined $class);
    my $record = $class->new( xml => $el,
        use_cache => $self->{__use_cache}, %args );

    # cache record if necessary
    if ($self->{__use_cache}) {
        #dunlock($ref);
        $ref->{__memoized}->{$idx} = $record;
        #dlock($ref);
    }
    
    return $record;

}

sub next_record {

    my ($self, $ref, %args) = @_;

    my $pos = $ref->{__pos};
    return if ($pos == $ref->{__count}); #EOF

    my $record;

    # There is a while loop here because a return value of -1 from