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