File Coverage

blib/lib/MARC/Schema.pm
Criterion Covered Total %
statement 76 78 97.4
branch 26 30 86.6
condition 10 12 83.3
subroutine 11 11 100.0
pod 2 3 66.6
total 125 134 93.2


line stmt bran cond sub pod time code
1             package MARC::Schema;
2              
3 2     2   165128 use strict;
  2         11  
  2         48  
4 2     2   8 use warnings;
  2         4  
  2         77  
5              
6             our $VERSION = '0.14';
7              
8 2     2   1988 use Cpanel::JSON::XS;
  2         10085  
  2         157  
9 2     2   638 use File::Share ':all';
  2         44045  
  2         289  
10 2     2   758 use File::Slurper 'read_binary';
  2         22431  
  2         101  
11 2     2   13 use Scalar::Util qw(reftype);
  2         4  
  2         1184  
12              
13             sub new {
14 3     3 0 16751 my ($class, $arg_ref) = @_;
15 3   100     20 my $self = $arg_ref // {};
16 3         7 bless $self, $class;
17 3         8 $self->_initialize();
18 3         14 return $self;
19             }
20              
21             sub _initialize {
22 3     3   3 my ($self) = shift;
23 3 100       10 if (!$self->{fields}) {
24 2         4 $self->{fields} = $self->_load_schema();
25             }
26 3         6 return;
27             }
28              
29             sub _load_schema {
30 2     2   4 my ($self) = shift;
31 2         3 my $json;
32 2 50       5 if ($self->{file}) {
33 0         0 $json = read_binary($self->{file});
34             }
35             else {
36 2         9 $self->{file} = dist_file('MARC-Schema', 'marc-schema.json');
37 2         339 $json = read_binary($self->{file});
38             }
39 2         71904 my $schema = decode_json($json);
40              
41 2         22 return $schema->{fields};
42             }
43              
44             sub check {
45 1     1 1 9 my ($self, $record, %options) = @_;
46              
47 1 50       10 $record = $record->{record} if reftype $record eq 'HASH';
48              
49 1         4 $options{counter} = {};
50 1         3 return map {$self->check_field($_, %options)} @$record;
  9         19  
51             }
52              
53             sub check_field {
54 9     9 1 19 my ($self, $field, %options) = @_;
55              
56 9         14 my $tag = $field->[0];
57              
58 9         13 my $spec = $self->{fields}->{$tag};
59              
60 9 100       17 if (!$spec) {
61 1 50       2 if (!$options{ignore_unknown_fields}) {
62 1         17 return ({tag => $tag, error => 'unknown field', type => 'field'});
63             }
64             else {
65 0         0 return ();
66             }
67             }
68              
69 8 100 66     71 if ($options{counter} && !$spec->{repeatable}) {
70 6 100       45 if ($options{counter}{$field->[0]}++) {
71             return (
72             {
73 1         13 tag => $tag,
74             error => 'field is not repeatable',
75             type => 'field',
76             }
77             );
78             }
79             }
80              
81 7         15 my @errors;
82 7 100       12 if ($spec->{subfields}) {
83 5         6 my %sfcounter;
84 5         18 my (undef, undef, undef, @subfields) = @$field;
85 5         10 while (@subfields) {
86 10         25 my ($code, undef) = splice @subfields, 0, 2;
87 10         15 my $sfspec = $spec->{subfields}->{$code};
88              
89 10 100       18 if ($sfspec) {
    50          
90 9 100 100     19 if (!$sfspec->{repeatable} && $sfcounter{$code}++) {
91 1         16 push @errors,
92             {
93             tag => $tag,
94             error => 'subfield is not repeatable',
95             type => 'subfield',
96             value => $code,
97             };
98             }
99             }
100             elsif (!$options{ignore_unknown_subfields}) {
101 1         3 push @errors,
102             {
103             tag => $tag,
104             error => "unknown subfield",
105             type => 'subfield',
106             value => $code,
107             };
108             }
109             }
110             }
111              
112 7 100       38 if ($spec->{indicator1}) {
113 5         11 my (undef, $code, @other) = @$field;
114 5   100     13 $code //= ' ';
115             my (@matches)
116 5         5 = grep {$code =~ /^[$_]/} keys %{$spec->{indicator1}->{codes}};
  9         82  
  5         14  
117              
118 5 100       15 if (@matches > 0) {
119              
120             # everything is ok
121             }
122             else {
123 1         3 push @errors,
124             {
125             tag => $tag,
126             error => 'unknown first indicator',
127             type => 'indicator',
128             value => $code,
129             };
130             }
131             }
132              
133 7 100       13 if ($spec->{indicator2}) {
134 2         6 my (undef, undef, $code, @other) = @$field;
135 2   50     4 $code //= ' ';
136             my (@matches)
137 2         3 = grep {$code =~ /^[$_]/} keys %{$spec->{indicator2}->{codes}};
  3         25  
  2         5  
138              
139 2 100       4 if (@matches > 0) {
140              
141             # everything is ok
142             }
143             else {
144 1         4 push @errors,
145             {
146             tag => $tag,
147             error => 'unknown second indicator',
148             type => 'indicator',
149             value => $code,
150             };
151             }
152             }
153              
154 7         15 return @errors;
155             }
156              
157             1;
158             __END__