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.111';
4 3     3   48348 use strict;
  3         5  
  3         78  
5 3     3   11 use warnings;
  3         4  
  3         76  
6 3     3   1323 use parent 'Exporter';
  3         815  
  3         13  
7              
8 3     3   133 use Carp 'croak';
  3         3  
  3         196  
9 3     3   11 use List::Util 1.45 'uniq';
  3         60  
  3         248  
10 3     3   1753 use Algorithm::Diff 'diff';
  3         12603  
  3         1227  
11              
12             our @EXPORT_OK = qw(diff_hashes diff_arrays);
13              
14             sub diff_hashes {
15 4     4 1 728 my ( $old, $new, %cbs ) = @_;
16              
17 4 50       10 ref $old eq 'HASH' or croak 'Arg 1 must be hashref';
18 4 50       8 ref $new eq 'HASH' or croak 'Arg 2 must be hashref';
19              
20 4         3 my @changed;
21 4         2 foreach my $key ( keys %{$new} ) {
  4         11  
22 12 100       16 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         978 foreach my $key ( keys %{$old} ) {
  4         20  
31 8 100       672 if ( ! exists $new->{$key} ) {
32             exists $cbs{'deleted'}
33 1 50       5 and $cbs{'deleted'}->( $key, $old->{$key} );
34             }
35             }
36              
37 4         6 foreach my $key (@changed) {
38 7   100     1037 my $before = $old->{$key} || '';
39 7   100     11 my $after = $new->{$key} || '';
40              
41 7 100       13 if ( $before ne $after ) {
42             exists $cbs{'changed'}
43 1 50       4 and $cbs{'changed'}->( $key, $before, $after );
44             }
45             }
46              
47 4         10 return;
48             }
49              
50             sub diff_arrays {
51 5     5 1 751 my ( $old, $new, %cbs ) = @_;
52              
53 5 50       15 ref $old eq 'ARRAY' or croak 'Arg 1 must be arrayref';
54 5 50       9 ref $new eq 'ARRAY' or croak 'Arg 2 must be arrayref';
55              
56             # normalize arrays
57 5         5 my @old = uniq sort @{$old};
  5         41  
58 5         9 my @new = uniq sort @{$new};
  5         18  
59              
60 5         16 my @diffs = diff( \@old, \@new );
61              
62 5         371 foreach my $diff (@diffs) {
63 4         652 foreach my $changeset ( @{$diff} ) {
  4         7  
64 8         8 my ( $change, undef, $value ) = @{$changeset};
  8         12  
65              
66 8 100       18 if ( $change eq '+' ) {
    100          
67 6 50       17 exists $cbs{'added'} and $cbs{'added'}->($value);
68             } elsif ( $change eq '-' ) {
69 1 50       6 exists $cbs{'deleted'} and $cbs{'deleted'}->($value);
70             } else {
71 1         156 croak "Can't recognize change in changeset: '$change'";
72             }
73             }
74             }
75              
76 4         362 return;
77             }
78              
79             1;
80              
81             __END__