File Coverage

blib/lib/MARC/Schema.pm

Criterion	Covered	Total	%
statement	77	78	98.7
branch	28	30	93.3
condition	10	12	83.3
subroutine	11	11	100.0
pod	2	3	66.6
total	128	134	95.5

package MARC::Schema;

use strict;
use warnings;

our $VERSION = '0.16';

use Cpanel::JSON::XS;
use File::Share ':all';
use File::Slurper 'read_binary';
use Scalar::Util qw(reftype);

sub new {
    my ($class, $arg_ref) = @_;
    my $self = $arg_ref // {};
    bless $self, $class;
    $self->_initialize();
    return $self;
}

sub _initialize {
    my ($self) = shift;
    if (!$self->{fields}) {
        $self->{fields} = $self->_load_schema();
    }
    return;
}

sub _load_schema {
    my ($self) = shift;
    my $json;
    if ($self->{file}) {
        $json = read_binary($self->{file});
    }
    else {
        $self->{file} = dist_file('MARC-Schema', 'marc-schema.json');
        $json = read_binary($self->{file});
    }
    my $schema = decode_json($json);

    return $schema->{fields};
}

sub check {
    my ($self, $record, %options) = @_;

    $record = $record->{record} if reftype $record eq 'HASH';

    $options{counter} = {};
    return map {$self->check_field($_, %options)} @$record;
}

sub check_field {
    my ($self, $field, %options) = @_;

    my $tag = $field->[0];

    my $spec = $self->{fields}->{$tag};

    if (!$spec) {
        if (!$options{ignore_unknown_fields}) {
            return ({tag => $tag, error => 'unknown field', type => 'field'});
        }
        else {
            return ();
        }
    }

    if ($options{counter} && !$spec->{repeatable}) {
        if ($options{counter}{$field->[0]}++) {
            return (
                {
                    tag   => $tag,
                    error => 'field is not repeatable',
                    type  => 'field',
                }
            );
        }
    }

    my @errors;
    if ($spec->{subfields}) {
        my %sfcounter;
        my (undef, undef, undef, @subfields) = @$field;
        while (@subfields) {
            my ($code, undef) = splice @subfields, 0, 2;
            my $sfspec = $spec->{subfields}->{$code};

            if ($sfspec) {
                if (!$sfspec->{repeatable} && $sfcounter{$code}++) {
                    push @errors,
                        {
                        tag   => $tag,
                        error => 'subfield is not repeatable',
                        type  => 'subfield',
                        value => $code,
                        };
                }
            }
            elsif (!$options{ignore_unknown_subfields}) {
                push @errors,
                    {
                    tag   => $tag,
                    error => "unknown subfield",
                    type  => 'subfield',
                    value => $code,
                    };
            }
        }
    }

    if ($spec->{indicator1}) {
        my (undef, $code, @other) = @$field;
        $code //= ' ';
        my (@matches)
            = grep {$code =~ /^[$_]/} keys %{$spec->{indicator1}->{codes}};

        if (@matches > 0) {

            # everything is ok
        }
        else {
            push @errors,
                {
                tag   => $tag,
                error => 'unknown first indicator',
                type  => 'indicator',
                value => $code,
                };
        }
    }

    if ($spec->{indicator2}) {
        my (undef, undef, $code, @other) = @$field;
        $code //= ' ';
        my (@matches)
            = grep {$code =~ /^[$_]/} keys %{$spec->{indicator2}->{codes}};

        if (@matches > 0) {

            # everything is ok
        }
        else {
            push @errors,
                {
                tag   => $tag,
                error => 'unknown second indicator',
                type  => 'indicator',
                value => $code,
                };
        }
    }

    return @errors;
}

1;
__END__