File Coverage

blib/lib/Value/Diff.pm
Criterion Covered Total %
statement 62 62 100.0
branch 36 36 100.0
condition 9 9 100.0
subroutine 12 12 100.0
pod 1 1 100.0
total 120 120 100.0


line stmt bran cond sub pod time code
1             package Value::Diff;
2             $Value::Diff::VERSION = '0.002';
3 7     7   482592 use v5.10;
  7         78  
4 7     7   38 use strict;
  7         13  
  7         169  
5 7     7   55 use warnings;
  7         12  
  7         274  
6              
7 7     7   63 use Exporter qw(import);
  7         29  
  7         5051  
8              
9             our @EXPORT = qw(diff);
10              
11             my $no_diff = \'no_diff';
12              
13             sub _has_diff
14             {
15 143 100   143   273 return !!1 unless defined $_[0];
16 138         420 return $_[0] ne $no_diff;
17             }
18              
19             sub _diff_hash
20             {
21 20     20   53 my ($left, $right) = @_;
22              
23 20         32 my %out;
24 20         25 for my $key (keys %{$left}) {
  20         73  
25 33         51 my $value = $left->{$key};
26             $out{$key} = $value
27 33 100       65 unless exists $right->{$key};
28              
29 33         80 my $diff = _diff($value, $right->{$key});
30 33 100       56 $out{$key} = $diff
31             if _has_diff($diff);
32             }
33              
34 20 100       70 return %out ? \%out : $no_diff;
35             }
36              
37             sub _diff_array
38             {
39 22     22   39 my ($left, $right) = @_;
40              
41 22         37 my @out;
42 22         26 my @other = @{$right};
  22         41  
43              
44             OUTER:
45 22         30 for my $value (@{$left}) {
  22         39  
46 38         74 for my $key (0 .. $#other) {
47 46         84 my $other_value = $other[$key];
48 46 100       77 if (!_has_diff(_diff($value, $other_value))) {
49 27         45 splice @other, $key, 1;
50 27         68 next OUTER;
51             }
52             }
53              
54             # TODO: take the smallest diff instead of full $left?
55 11         23 push @out, $value;
56             }
57              
58 22 100       77 return @out ? \@out : $no_diff;
59             }
60              
61             sub _diff_scalar
62             {
63 13     13   31 my ($left, $right) = @_;
64              
65 13         41 my $diff = _diff($$left, $$right);
66 13 100       48 return _has_diff($diff) ? \$diff : $no_diff;
67             }
68              
69             sub _diff_other
70             {
71 81     81   137 my ($left, $right) = @_;
72              
73 81 100 100     362 return $left
      100        
74             if defined $left ne defined $right
75             || (defined $left && $left ne $right);
76              
77 56         154 return $no_diff;
78             }
79              
80             sub _diff
81             {
82 143     143   248 my ($left, $right) = @_;
83              
84 143         229 my $ref_left = ref $left;
85 143         194 my $ref_right = ref $right;
86 143 100       288 return $left if $ref_left ne $ref_right;
87 136 100       286 return _diff_array($left, $right) if $ref_left eq 'ARRAY';
88 114 100       212 return _diff_hash($left, $right) if $ref_left eq 'HASH';
89 94 100 100     351 return _diff_scalar($left, $right) if $ref_left eq 'SCALAR' || $ref_left eq 'REF';
90 81         152 return _diff_other($left, $right);
91             }
92              
93             sub _empty_of_type
94             {
95 5     5   23 my ($left) = @_;
96              
97 5         20 my $type = ref $left;
98 5 100       15 return [] if $type eq 'ARRAY';
99 4 100       8 return {} if $type eq 'HASH';
100 3 100       7 return \undef if $type eq 'SCALAR';
101 2         5 return undef;
102             }
103              
104             sub diff
105             {
106 51     51 1 31781 my ($left, $right, $out) = @_;
107              
108 51         127 my $diff = _diff($left, $right);
109              
110 51 100       106 if (_has_diff($diff)) {
111 24 100       112 $$out = $diff if ref $out;
112 24         124 return !!1;
113             }
114             else {
115 27 100       126 $$out = _empty_of_type($left) if ref $out;
116 27         133 return !!0;
117             }
118             }
119              
120             1;
121              
122             # ABSTRACT: find the difference between two Perl values
123