File Coverage

blib/lib/PICA/SRUSearchParser.pm

Criterion	Covered	Total	%
statement	15	60	25.0
branch	0	24	0.0
condition	0	6	0.0
subroutine	5	14	35.7
pod	8	8	100.0
total	28	112	25.0

package PICA::SRUSearchParser;
{
  $PICA::SRUSearchParser::VERSION = '0.585';
}
#ABSTRACT: Parse a SRU response in XML and extract PICA+ records.
use strict;


use Carp qw(croak);
use PICA::XMLParser;
use XML::SAX::ParserFactory;
use base qw(XML::SAX::Base);


sub new {
    my ($class, $xmlparser) = @_;
    $class = ref $class || $class;

    $xmlparser = PICA::XMLParser->new()
        unless UNIVERSAL::isa($xmlparser, "PICA::XMLParser");

    my $self = {
        xmlparser => $xmlparser,
        char_data => "",
        in_record => 0,
        numberOfRecords => undef,
        currentNumber => 0,
        resultSetId => undef,
    };

    return bless $self, $class;
}


sub parse {
    my ($self, $document) = @_;

    my $parser = XML::SAX::ParserFactory->new(
        RequiredFeatures => { 'http://xml.org/sax/features/namespaces' => 1 }
      )->parser( Handler => $self );

    $self->{currentNumber} = 0;
    $parser->parse_string($document);

    return $self->{xmlparser};
}


sub numberOfRecords {
    my $self = shift;
    return $self->{numberOfRecords};
}


sub currentNumber {
    my $self = shift;
    return $self->{currentNumber};
}


sub resultSetId {
    my $self = shift;
    return $self->{resultSetId};
}


sub start_element {
    my ($self, $el) = @_;

    if ($self->{in_record}) {

        # TODO: nasty hack because sru.gbv.de is broken:
        my ($tag) = grep { $_->{LocalName} eq 'tag' } values %{ $el->{Attributes} };
        if (defined $tag and $tag->{Value} eq '') {
            $self->{skip_field} = 1;
        } else {
            $self->{xmlparser}->start_element($el);
        }

    } else {
        $self->{char_data} = "";
        if ( _sru_element($el,"recordData") ) {
            #print "$name\n";
            $self->{in_record} = 1;
        }
    }
}

sub _sru_element {
    my ($el, $name) = @_;
    return $el->{LocalName} eq $name and $el->{NamespaceURI} eq 'http://www.loc.gov/zing/srw/';
}


sub end_element {
    my ($self, $el) = @_;

    if ($self->{in_record}) {
        if ( _sru_element($el,"recordData") ) {
            $self->{currentNumber}++;
            $self->{in_record} = 0;
        } else {
            if ( $self->{skip_field} ) { # nasty hack because sru.gbv.de is broken
                $self->{skip_field} = 0 if $el->{LocalName} eq 'datafield';
            } else {
                $self->{xmlparser}->end_element($el);
            }
        }
    } else {
        if ( _sru_element($el,"numberOfRecords") ) {
            $self->{numberOfRecords} = $self->{char_data};
        } elsif ( _sru_element($el,"resultSetId") ) {
            $self->{resultSetId} = $self->{char_data};
        }
    }
}


sub characters {
    my ($self, $data) = @_;

    if ($self->{in_record}) {
        $self->{xmlparser}->characters($data);
    } else {
        ($data) = values %$data;
        $self->{char_data} .= $data;
    }
}

1;

__END__