File Coverage

lib/ClarID/Tools/Validator.pm
Criterion Covered Total %
statement 44 48 91.6
branch 7 12 58.3
condition n/a
subroutine 10 11 90.9
pod 0 1 0.0
total 61 72 84.7


line stmt bran cond sub pod time code
1             package ClarID::Tools::Validator;
2 5     5   36 use strict;
  5         12  
  5         196  
3 5     5   25 use warnings;
  5         9  
  5         260  
4 5     5   30 use utf8;
  5         9  
  5         33  
5 5     5   3067 use JSON::Validator;
  5         2856788  
  5         46  
6 5     5   364 use JSON::Validator::Schema;
  5         14  
  5         38  
7 5     5   3941 use Term::ANSIColor qw(:constants);
  5         58740  
  5         7458  
8 5     5   127 use Exporter 'import';
  5         54  
  5         3402  
9             our @EXPORT_OK = qw(validate_codebook _self_validate);
10              
11             sub validate_codebook {
12 4     4 0 15 my ($data, $schema, $debug) = @_;
13              
14 4 50       18 ClarID::Tools::Validator::_self_validate($schema) if $debug;
15              
16 4         44 my $jv = JSON::Validator->new;
17 4         123 $jv->schema($schema);
18              
19 4         165906 my @errors = $jv->validate($data);
20 4 100       275092 if (@errors) {
21 1         5 _say_errors(\@errors);
22 1         1067 die "Codebook validation failed\n";
23             }
24              
25             # Additional stub_code uniqueness validation (for all relevant entities/categories)
26             _validate_unique_stub_codes($data, 'biosample', $_)
27 3         20 for qw(project species tissue sample_type assay timepoint);
28              
29             _validate_unique_stub_codes($data, 'subject', $_)
30 2         10 for qw(study type sex age_group);
31              
32 2         125 return 1;
33             }
34              
35             sub _validate_unique_stub_codes {
36 23     23   55 my ($data, $entity, $category) = @_;
37              
38 23 50       73 my $defs = $data->{entities}{$entity}{$category}
39             or die "Missing category '$category' in entity '$entity'";
40              
41 23         32 my %seen;
42 23         98 for my $key (keys %$defs) {
43 221         325 my $def = $defs->{$key};
44 221 50       436 next unless defined $def->{stub_code};
45 221         366 my $sc = $def->{stub_code};
46              
47 221 100       385 if (exists $seen{$sc}) {
48             die sprintf(
49             "Duplicate stub_code '%s' in category '%s' (entity: '%s') for keys '%s' and '%s'\n",
50 1         442 $sc, $category, $entity, $key, $seen{$sc}
51             );
52             }
53 220         627 $seen{$sc} = $key;
54             }
55             }
56              
57             sub _self_validate {
58 0     0   0 my ($schema) = @_;
59 0         0 my $validator = JSON::Validator::Schema->new($schema);
60 0 0       0 die "Invalid JSON Schema\nSee https://json-schema.org/" if $validator->is_invalid;
61 0         0 print "Codebook Schema is OK\n";
62             }
63              
64             sub _say_errors {
65 1     1   3 my ($errors) = @_;
66 1         4 print BOLD RED (join "\n", @$errors) , RESET "\n";
67             }
68              
69             1;