| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package App::MARC::Validator::Report; |
|
2
|
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
144919
|
use strict; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
145
|
|
|
4
|
4
|
|
|
4
|
|
19
|
use warnings; |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
190
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
2120
|
use Class::Utils qw(set_params); |
|
|
4
|
|
|
|
|
55709
|
|
|
|
4
|
|
|
|
|
91
|
|
|
7
|
4
|
|
|
4
|
|
4741
|
use Cpanel::JSON::XS; |
|
|
4
|
|
|
|
|
26832
|
|
|
|
4
|
|
|
|
|
361
|
|
|
8
|
4
|
|
|
4
|
|
2042
|
use Getopt::Std; |
|
|
4
|
|
|
|
|
8847
|
|
|
|
4
|
|
|
|
|
332
|
|
|
9
|
4
|
|
|
4
|
|
2065
|
use Perl6::Slurp qw(slurp); |
|
|
4
|
|
|
|
|
8088
|
|
|
|
4
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = 0.03; |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# Constructor. |
|
14
|
|
|
|
|
|
|
sub new { |
|
15
|
8
|
|
|
8
|
0
|
781027
|
my ($class, @params) = @_; |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Create object. |
|
18
|
8
|
|
|
|
|
27
|
my $self = bless {}, $class; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Process parameters. |
|
21
|
8
|
|
|
|
|
36
|
set_params($self, @params); |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Object. |
|
24
|
8
|
|
|
|
|
67
|
return $self; |
|
25
|
|
|
|
|
|
|
} |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Run. |
|
28
|
|
|
|
|
|
|
sub run { |
|
29
|
7
|
|
|
7
|
0
|
27
|
my $self = shift; |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Process arguments. |
|
32
|
7
|
|
|
|
|
45
|
$self->{'_opts'} = { |
|
33
|
|
|
|
|
|
|
'e' => 'all', |
|
34
|
|
|
|
|
|
|
'h' => 0, |
|
35
|
|
|
|
|
|
|
'l' => 0, |
|
36
|
|
|
|
|
|
|
'p' => 'all', |
|
37
|
|
|
|
|
|
|
'v' => 0, |
|
38
|
|
|
|
|
|
|
}; |
|
39
|
7
|
100
|
100
|
|
|
29
|
if (! getopts('e:hlp:v', $self->{'_opts'}) |
|
|
|
|
100
|
|
|
|
|
|
40
|
|
|
|
|
|
|
|| $self->{'_opts'}->{'h'} |
|
41
|
|
|
|
|
|
|
|| @ARGV < 1) { |
|
42
|
|
|
|
|
|
|
|
|
43
|
3
|
|
|
|
|
242
|
$self->_usage; |
|
44
|
3
|
|
|
|
|
14
|
return 1; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
4
|
|
|
|
|
135
|
my $report_file = $ARGV[0]; |
|
47
|
|
|
|
|
|
|
|
|
48
|
4
|
|
|
|
|
11
|
my $exit_code = $self->_process_report($report_file); |
|
49
|
4
|
100
|
|
|
|
17
|
if ($exit_code != 0) { |
|
50
|
2
|
|
|
|
|
5
|
return $exit_code; |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
2
|
100
|
|
|
|
5
|
if ($self->{'_opts'}->{'l'}) { |
|
54
|
1
|
|
|
|
|
5
|
$exit_code = $self->_process_list; |
|
55
|
|
|
|
|
|
|
} else { |
|
56
|
1
|
|
|
|
|
3
|
$exit_code = $self->_process_errors; |
|
57
|
|
|
|
|
|
|
} |
|
58
|
|
|
|
|
|
|
|
|
59
|
2
|
|
|
|
|
5
|
return $exit_code; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _process_errors { |
|
63
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
|
64
|
|
|
|
|
|
|
|
|
65
|
1
|
|
|
|
|
2
|
foreach my $plugin (sort keys %{$self->{'_list'}}) { |
|
|
1
|
|
|
|
|
4
|
|
|
66
|
3
|
50
|
33
|
|
|
10
|
if ($self->{'_opts'}->{'p'} eq 'all' || $self->{'_opts'}->{'p'} eq $plugin) { |
|
67
|
3
|
100
|
|
|
|
3
|
if (keys %{$self->{'_list'}->{$plugin}} == 0) { |
|
|
3
|
|
|
|
|
9
|
|
|
68
|
2
|
|
|
|
|
3
|
next; |
|
69
|
|
|
|
|
|
|
} |
|
70
|
1
|
|
|
|
|
35
|
print "Plugin '$plugin':\n"; |
|
71
|
1
|
|
|
|
|
3
|
foreach my $error (sort keys %{$self->{'_list'}->{$plugin}}) { |
|
|
1
|
|
|
|
|
3
|
|
|
72
|
1
|
50
|
33
|
|
|
4
|
if ($self->{'_opts'}->{'e'} eq 'all' || $self->{'_opts'}->{'e'} eq $error) { |
|
73
|
1
|
|
|
|
|
19
|
print "- $error\n"; |
|
74
|
1
|
|
|
|
|
2
|
foreach my $id (sort @{$self->{'_list'}->{$plugin}->{$error}}) { |
|
|
1
|
|
|
|
|
2
|
|
|
75
|
1
|
|
|
|
|
2
|
my @err = @{$self->{'_report'}->{$plugin}->{'checks'}->{'not_valid'}->{$id}}; |
|
|
1
|
|
|
|
|
4
|
|
|
76
|
1
|
|
|
|
|
2
|
my $struct_hr = {}; |
|
77
|
1
|
|
|
|
|
1
|
foreach my $err_hr (@err) { |
|
78
|
1
|
50
|
|
|
|
3
|
if ($err_hr->{'error'} eq $error) { |
|
79
|
1
|
|
|
|
|
3
|
$struct_hr = $err_hr->{'params'}; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
} |
|
82
|
1
|
|
|
|
|
10
|
print "-- $id"; |
|
83
|
1
|
|
|
|
|
2
|
my $i = 0; |
|
84
|
1
|
|
|
|
|
11
|
foreach my $param_key (sort keys %{$struct_hr}) { |
|
|
1
|
|
|
|
|
4
|
|
|
85
|
1
|
50
|
|
|
|
3
|
if ($i == 0) { |
|
86
|
1
|
|
|
|
|
9
|
print ': '; |
|
87
|
|
|
|
|
|
|
} else { |
|
88
|
0
|
|
|
|
|
0
|
print ', '; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
1
|
|
|
|
|
8
|
print "$param_key: '".$struct_hr->{$param_key}."'"; |
|
91
|
1
|
|
|
|
|
1
|
$i++; |
|
92
|
|
|
|
|
|
|
} |
|
93
|
1
|
|
|
|
|
9
|
print "\n"; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
} |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
|
|
100
|
1
|
|
|
|
|
3
|
return 0; |
|
101
|
|
|
|
|
|
|
} |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub _process_list { |
|
104
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
|
105
|
|
|
|
|
|
|
|
|
106
|
1
|
|
|
|
|
2
|
foreach my $plugin (sort keys %{$self->{'_list'}}) { |
|
|
1
|
|
|
|
|
5
|
|
|
107
|
3
|
50
|
33
|
|
|
9
|
if ($self->{'_opts'}->{'p'} eq 'all' || $self->{'_opts'}->{'p'} eq $plugin) { |
|
108
|
3
|
100
|
|
|
|
2
|
if (keys %{$self->{'_list'}->{$plugin}} == 0) { |
|
|
3
|
|
|
|
|
8
|
|
|
109
|
2
|
|
|
|
|
13
|
next; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
1
|
|
|
|
|
36
|
print "Plugin '$plugin':\n"; |
|
112
|
1
|
|
|
|
|
2
|
foreach my $error (sort keys %{$self->{'_list'}->{$plugin}}) { |
|
|
1
|
|
|
|
|
4
|
|
|
113
|
1
|
|
|
|
|
20
|
print "- $error\n"; |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
1
|
|
|
|
|
3
|
return 0; |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _process_report { |
|
122
|
4
|
|
|
4
|
|
6
|
my ($self, $report_file) = @_; |
|
123
|
|
|
|
|
|
|
|
|
124
|
4
|
|
|
|
|
13
|
my $report = slurp($report_file); |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# JSON output. |
|
127
|
4
|
|
|
|
|
632
|
my $j = Cpanel::JSON::XS->new; |
|
128
|
4
|
|
|
|
|
100
|
$self->{'_report'} = $j->decode($report); |
|
129
|
|
|
|
|
|
|
|
|
130
|
4
|
|
|
|
|
9
|
$self->{'_list'} = {}; |
|
131
|
4
|
|
|
|
|
5
|
foreach my $plugin (keys %{$self->{'_report'}}) { |
|
|
4
|
|
|
|
|
16
|
|
|
132
|
8
|
100
|
|
|
|
17
|
if (! exists $self->{'_report'}->{$plugin}->{'checks'}) { |
|
133
|
1
|
|
|
|
|
30
|
print STDERR "Doesn't exist key 'checks' in plugin $plugin."; |
|
134
|
1
|
|
|
|
|
7
|
return 1; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
7
|
100
|
|
|
|
13
|
if (! exists $self->{'_report'}->{$plugin}->{'checks'}->{'not_valid'}) { |
|
137
|
1
|
|
|
|
|
28
|
print STDERR "Doesn't exist key 'checks'->'not_valid' in plugin $plugin."; |
|
138
|
1
|
|
|
|
|
5
|
return 1; |
|
139
|
|
|
|
|
|
|
} |
|
140
|
6
|
50
|
|
|
|
9
|
if (! exists $self->{'_list'}->{$plugin}) { |
|
141
|
6
|
|
|
|
|
8
|
$self->{'_list'}->{$plugin} = {}; |
|
142
|
|
|
|
|
|
|
} |
|
143
|
6
|
|
|
|
|
8
|
my $not_valid_hr = $self->{'_report'}->{$plugin}->{'checks'}->{'not_valid'}; |
|
144
|
6
|
|
|
|
|
8
|
foreach my $record_id (keys %{$not_valid_hr}) { |
|
|
6
|
|
|
|
|
13
|
|
|
145
|
2
|
|
|
|
|
3
|
foreach my $error_hr (@{$not_valid_hr->{$record_id}}) { |
|
|
2
|
|
|
|
|
4
|
|
|
146
|
2
|
50
|
|
|
|
5
|
if (! exists $self->{'_list'}->{$plugin}->{$error_hr->{'error'}}) { |
|
147
|
2
|
|
|
|
|
8
|
$self->{'_list'}->{$plugin}->{$error_hr->{'error'}} = [$record_id]; |
|
148
|
|
|
|
|
|
|
} else { |
|
149
|
0
|
|
|
|
|
0
|
push @{$self->{'_list'}->{$plugin}->{$error_hr->{'error'}}}, $record_id; |
|
|
0
|
|
|
|
|
0
|
|
|
150
|
|
|
|
|
|
|
} |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
} |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
|
|
155
|
2
|
|
|
|
|
12
|
return 0; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub _usage { |
|
159
|
3
|
|
|
3
|
|
7
|
my $self = shift; |
|
160
|
|
|
|
|
|
|
|
|
161
|
3
|
|
|
|
|
164
|
print STDERR "Usage: $0 [-h] [-l] [-p plugin] [-v] [--version] report.json\n"; |
|
162
|
3
|
|
|
|
|
85
|
print STDERR "\t-h\t\tPrint help.\n"; |
|
163
|
3
|
|
|
|
|
45
|
print STDERR "\t-l\t\tList unique errors.\n"; |
|
164
|
3
|
|
|
|
|
36
|
print STDERR "\t-p\t\tUse plugin (default all).\n"; |
|
165
|
3
|
|
|
|
|
34
|
print STDERR "\t-v\t\tVerbose mode.\n"; |
|
166
|
3
|
|
|
|
|
33
|
print STDERR "\t--version\tPrint version.\n"; |
|
167
|
3
|
|
|
|
|
35
|
print STDERR "\treport.json\tmarc-validator JSON report.\n"; |
|
168
|
|
|
|
|
|
|
|
|
169
|
3
|
|
|
|
|
9
|
return; |
|
170
|
|
|
|
|
|
|
} |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
1; |