view release on metacpan or  search on metacpan

lib/Algorithm/Diff/Callback.pm  view on Meta::CPAN

package Algorithm::Diff::Callback;
# ABSTRACT: Use callbacks on computed differences
$Algorithm::Diff::Callback::VERSION = '0.111';
use strict;
use warnings;
use parent          'Exporter';

use Carp            'croak';
use List::Util 1.45 'uniq';
use Algorithm::Diff 'diff';

our @EXPORT_OK = qw(diff_hashes diff_arrays);

sub diff_hashes {
    my ( $old, $new, %cbs ) = @_;

    ref $old eq 'HASH' or croak 'Arg 1 must be hashref';
    ref $new eq 'HASH' or croak 'Arg 2 must be hashref';

    my @changed;
    foreach my $key ( keys %{$new} ) {
        if ( ! exists $old->{$key} ) {
            exists $cbs{'added'}
                and $cbs{'added'}->( $key, $new->{$key} );
        } else {
            push @changed, $key;
        }
    }

    foreach my $key ( keys %{$old} ) {
        if ( ! exists $new->{$key} ) {
            exists $cbs{'deleted'}
                and $cbs{'deleted'}->( $key, $old->{$key} );
        }
    }

    foreach my $key (@changed) {
        my $before = $old->{$key} || '';
        my $after  = $new->{$key} || '';

        if ( $before ne $after ) {
            exists $cbs{'changed'}
                and $cbs{'changed'}->( $key, $before, $after );
        }
    }

    return;
}

sub diff_arrays {
    my ( $old, $new, %cbs ) = @_;

    ref $old eq 'ARRAY' or croak 'Arg 1 must be arrayref';
    ref $new eq 'ARRAY' or croak 'Arg 2 must be arrayref';

    # normalize arrays
    my @old = uniq sort @{$old};
    my @new = uniq sort @{$new};

    my @diffs = diff( \@old, \@new );

    foreach my $diff (@diffs) {
        foreach my $changeset ( @{$diff} ) {
            my ( $change, undef, $value ) = @{$changeset};

            if ( $change eq '+' ) {