File Coverage

blib/lib/Algorithm/Diff/Callback.pm
Criterion Covered Total %
statement 55 55 100.0
branch 19 28 67.8
condition 4 4 100.0
subroutine 8 8 100.0
pod 2 2 100.0
total 88 97 90.7


line stmt bran cond sub pod time code
1             package Algorithm::Diff::Callback;
2             # ABSTRACT: Use callbacks on computed differences
3             $Algorithm::Diff::Callback::VERSION = '0.110';
4 3     3   38676 use strict;
  3         3  
  3         66  
5 3     3   10 use warnings;
  3         2  
  3         59  
6 3     3   1058 use parent 'Exporter';
  3         636  
  3         11  
7              
8 3     3   112 use Carp 'croak';
  3         3  
  3         155  
9 3     3   9 use List::Util 1.45 'uniq';
  3         48  
  3         235  
10 3     3   1556 use Algorithm::Diff 'diff';
  3         10019  
  3         1006  
11              
12             our @EXPORT_OK = qw(diff_hashes diff_arrays);
13              
14             sub diff_hashes {
15 4     4 1 499 my ( $old, $new, %cbs ) = @_;
16              
17 4 50       9 ref $old eq 'HASH' or croak 'Arg 1 must be hashref';
18 4 50       7 ref $new eq 'HASH' or croak 'Arg 2 must be hashref';
19              
20 4         3 my @changed;
21 4         4 foreach my $key ( keys %{$new} ) {
  4         9  
22 12 100       608 if ( ! exists $old->{$key} ) {
23             exists $cbs{'added'}
24 5 50       13 and $cbs{'added'}->( $key, $new->{$key} );
25             } else {
26 7         8 push @changed, $key;
27             }
28             }
29              
30 4         5 foreach my $key ( keys %{$old} ) {
  4         8  
31 8 100       460 if ( ! exists $new->{$key} ) {
32             exists $cbs{'deleted'}
33 1 50       5 and $cbs{'deleted'}->( $key, $old->{$key} );
34             }
35             }
36              
37 4         5 foreach my $key (@changed) {
38 7   100     16 my $before = $old->{$key} || '';
39 7   100     13 my $after = $new->{$key} || '';
40              
41 7 100       9 if ( $before ne $after ) {
42             exists $cbs{'changed'}
43 1 50       3 and $cbs{'changed'}->( $key, $before, $after );
44             }
45             }
46              
47 4         695 return;
48             }
49              
50             sub diff_arrays {
51 5     5 1 476 my ( $old, $new, %cbs ) = @_;
52              
53 5 50       13 ref $old eq 'ARRAY' or croak 'Arg 1 must be arrayref';
54 5 50       8 ref $new eq 'ARRAY' or croak 'Arg 2 must be arrayref';
55              
56             # normalize arrays
57 5         5 my @old = uniq sort @{$old};
  5         32  
58 5         8 my @new = uniq sort @{$new};
  5         15  
59              
60 5         13 my @diffs = diff( \@old, \@new );
61              
62 5         332 foreach my $diff (@diffs) {
63 4         306 foreach my $changeset ( @{$diff} ) {
  4         5  
64 8         11 my ( $change, undef, $value ) = @{$changeset};
  8         11  
65              
66 8 100       29 if ( $change eq '+' ) {
    100          
67 6 50       11 exists $cbs{'added'} and $cbs{'added'}->($value);
68             } elsif ( $change eq '-' ) {
69 1 50       5 exists $cbs{'deleted'} and $cbs{'deleted'}->($value);
70             } else {
71 1         146 croak "Can't recognize change in changeset: '$change'";
72             }
73             }
74             }
75              
76 4         238 return;
77             }
78              
79             1;
80              
81             __END__