File Coverage

blib/lib/PICA/Parser.pm

Criterion	Covered	Total	%
statement	82	82	100.0
branch	32	42	76.1
condition	11	18	61.1
subroutine	10	10	100.0
pod	6	6	100.0
total	141	158	89.2

package PICA::Parser;
{
  $PICA::Parser::VERSION = '0.585';
}
#ABSTRACT: Parse PICA+ data
use strict;

use base qw(Exporter);

use Carp qw(croak);
our @EXPORT_OK = qw(parsefile parsedata);
our @CARP_NOT = qw(PICA::PlainParser PICA::XMLParser);

require PICA::PlainParser;
require PICA::XMLParser;


sub new {
    my $class = "PICA::Parser";
    if (scalar(@_) % 2) { # odd
        $class = shift;
        $class = ref $class || $class;
    }
    my %params = @_;

    my $self = bless {
        defaultparams => {},
        xmlparser => undef,
        plainparser => undef
    }, $class;

    %{ $self->{defaultparams} } = %params if %params;

    return $self;
}


sub parsefile {
    my $self = shift;
    my ($arg, $parser);

    if (ref($self) eq 'PICA::Parser') { # called as a method
        $arg = shift;
        my %params = @_;
        if (ref(\$arg) eq 'SCALAR' and ($arg =~ /.xml$/i or $arg =~ /.xml.gz$/i)) {
            $params{Format} = "XML";
        }
        $parser = $self->_getparser( %params );
        croak("Missing argument to parsefile") unless defined $arg;
        $parser->parsefile( $arg );
        $self;
    } else { # called as a function
        $arg = ($self eq 'PICA::Parser') ? shift : $self;
        croak("Missing argument to parsefile") unless defined $arg;
        $parser = PICA::Parser->new( @_ );
        $parser->parsefile( $arg );
        $parser;
    }
}


sub parsedata {
    my $self = shift;
    my ( $data, $parser );

    if (ref($self) eq 'PICA::Parser') { # called as a method
        $data = shift;
        my %params = @_;
        $parser = $self->_getparser( %params );
        $parser->parsedata( $data );
        $self;
    } else { # called as a function
        $data = ($self eq 'PICA::Parser') ? shift : $self;
        $parser = PICA::Parser->new( @_ );
        $parser->parsedata( $data );
        $parser;
    }
}


sub records {
    my $self = shift;
    return () unless ref $self;

    return $self->{plainparser}->records() if $self->{plainparser};
    return $self->{xmlparser}->records() if $self->{xmlparser};

    return ();
}


sub counter {
    my $self = shift;
    return undef if !ref $self;

    my $counter = 0;
    $counter += $self->{plainparser}->counter() if $self->{plainparser};
    $counter += $self->{xmlparser}->counter() if $self->{xmlparser};
    return $counter;
}


sub enable_binmode_encoding {
    my $fh = shift;
    foreach my $layer ( PerlIO::get_layers( $fh ) ) {
        return if $layer =~ /^encoding|^utf8/;
    }
    binmode ($fh, ':utf8');
}


sub _getparser {
    my $self = shift;
    my %params = @_;
    delete $params{Proceed} if defined $params{Proceed};

    my $parser;

    # join parameters
    my %unionparams = ();
    my %defaultparams = %{ $self->{defaultparams} };
    my $key;
    foreach $key (keys %defaultparams) {
        $unionparams{$key} = $defaultparams{$key}
    }
    foreach $key (keys %params) {
        $unionparams{$key} = $params{$key}
    }
    # remove format parameter
    delete $params{Format} if defined $params{Format};

    # XMLParser
    if ( defined $unionparams{Format} and $unionparams{Format} =~ /^xml$/i ) {
        if ( !$self->{xmlparser} or %params ) {
            #require PICA::XMLParser;
            #if ($self->{xmlparser} &&
            $self->{xmlparser} = PICA::XMLParser->new( %unionparams );
        }
        $parser = $self->{xmlparser};
    } else { # PlainParser
        if ( !$self->{plainparser} or %params ) {
            #require PICA::PlainParser;
            $self->{plainparser} = PICA::PlainParser->new( %unionparams );
        }
        $parser = $self->{plainparser};
    }

    return $parser;
}

1;

__END__