File Coverage

blib/lib/Test/MasterData/Declare/CompareRow.pm
Criterion Covered Total %
statement 70 70 100.0
branch 10 18 55.5
condition 4 8 50.0
subroutine 15 15 100.0
pod 3 5 60.0
total 102 116 87.9


line stmt bran cond sub pod time code
1             package Test::MasterData::Declare::CompareRow;
2 4     4   62 use 5.010001;
  4         12  
3 4     4   18 use strict;
  4         6  
  4         69  
4 4     4   18 use warnings;
  4         5  
  4         87  
5 4     4   19 use utf8;
  4         10  
  4         20  
6              
7 4     4   96 use parent "Test2::Compare::Hash";
  4         8  
  4         21  
8 4     4   232 use Test2::Util::HashBase qw/json_checks/;
  4         7  
  4         26  
9              
10 4     4   543 use Carp qw/croak/;
  4         7  
  4         158  
11 4     4   20 use Scalar::Util qw/blessed/;
  4         5  
  4         1754  
12              
13 16     16 0 51 sub object_base { "Test::MasterData::Declare::Row" }
14              
15             sub verify {
16 16     16 1 284 my $self = shift;
17 16         44 my %params = @_;
18 16         31 my ($got, $exists) = @params{qw/got exists/};
19              
20 16 50       35 return 0 unless $exists;
21 16 50       29 return 0 unless $got;
22 16 50       31 return 0 unless ref($got);
23 16 50       47 return 0 unless blessed($got);
24 16 50       36 return 0 unless $got->isa($self->object_base);
25 16         39 return 1;
26             }
27              
28             sub add_json_field {
29 2     2 0 3 my $self = shift;
30 2         5 my ($name, @path) = @_;
31 2         3 my $check = pop @path;
32              
33 2 50       5 croak "column name is required"
34             unless defined $name;
35              
36 2   100     8 $self->{+JSON_CHECKS} ||= [];
37 2         3 push @{$self->{+JSON_CHECKS}} => [$name, \@path, $check];
  2         9  
38             }
39              
40             sub _wrap_check {
41 13     13   23 my ($class, $got, $check) = @_;
42              
43 13         32 my $ccheck = $check->clone;
44 13         127 $ccheck->set_file($got->file);
45 13         97 $ccheck->set_lines([$got->lineno]);
46              
47 13         95 return $ccheck;
48             }
49              
50             sub deltas {
51 16     16 1 64 my $self = shift;
52              
53 16         33 my %params = @_;
54 16         35 my ($got, $convert, $seen) = @params{qw/got convert seen/};
55 16         41 my $row = $got->row;
56 16         26 $params{got} = $row;
57             my $wrap_convert = sub {
58 13     13   136 my $check = $convert->(@_);
59 13         635 return $self->_wrap_check($got, $check);
60 16         52 };
61 16         28 $params{convert} = $wrap_convert;
62              
63 16         65 my @deltas = $self->SUPER::deltas(%params);
64              
65 16         776 my $json_checks = $self->{+JSON_CHECKS};
66 16         30 for my $json_check (@$json_checks) {
67 6         47 my ($json_column, $path, $check) = @$json_check;
68 6         10 my $converted_check = $wrap_convert->($check);
69              
70 6         18 my $out = $got->json($json_column, @$path);
71 6 50       26 push @deltas => $converted_check->run(
72             id => ["" => join ".", $json_column, @$path],
73             convert => $wrap_convert,
74             seen => $seen,
75             got => $out,
76             exists => defined $out ? 1 : 0,
77             );
78             }
79              
80 16         122 return @deltas;
81             }
82              
83             sub run {
84 16     16 1 1727 my $self = shift;
85 16         48 my %params = @_;
86 16         23 my $got = $params{got};
87              
88 16         65 my $delta = $self->SUPER::run(@_);
89 16 100       163 return unless $delta;
90              
91 1 50 33     13 if ($got && blessed $got && $got->isa("Test::MasterData::Declare::Row")) {
      33        
92 1         4 $delta->set_id(["HASH" => $got->source]);
93             }
94 1         14 return $delta;
95             }
96              
97             1;