File Coverage

blib/lib/Data/KeyDiff.pm

Criterion	Covered	Total	%
statement	63	68	92.6
branch	19	30	63.3
condition	7	16	43.7
subroutine	5	7	71.4
pod	1	1	100.0
total	95	122	77.8

package Data::KeyDiff;

use warnings;
use strict;

=head1 NAME

Data::KeyDiff - Diff one set/list against another with a key basis

=head1 VERSION

Version 0.021

=cut

$Data::KeyDiff::VERSION = '0.021';

=head1 SYNOPSIS

    # For each item in the list, the number is the item "key", the letter is the item "data"
    my @A = qw/1a 2b 3c 4d 5e 6f/;
    my @B = qw/5e 1f 2b 3r 4d 7q j n/;

    use Data::KeyDiff qw/diff/;

    diff( \@A, \@B,
        key =>
            sub($item) {
                # Return the leading number from $item
            },

        is_different =>
            sub($a, $b) {
                # Is the letter on $a different from $b?
            },

        is_new =>
            sub($item) {
                # Does $item already have a key?
            },

        # "j" and "n" are new!
        new => sub($element) {
            # Handle a new $element
        },

        # "7q" was inserted (already had a key)
        insert => sub($element) {
            # $element was "inserted" into @B
        },

        # "1f" and "3r" were updated
        update => sub($element) {
            # $element was "update" in @B
        },

        # "6f" was deleted
        delete => sub($element) {
            # $element was "deleted" in @B
        },

        # "5e", "2b", and "4d" changed rank
        update_rank => sub($element) {
            # $element had it's rank changed in @B
        },
    );

=head1 DESCRIPTION

Data::KeyDiff performs a diff-like operation on sets that have unique keys associated with each element.
Instead of looking at the whole list, C looks at each element on a case-by-case basis to see whether it's state or
inclusion has changed from the "before" set to the "after" set.

=head1 METHODS

=head2 Data::KeyDiff->diff( , ,  )

Compare the before-set to the after-set. Call handlers in  as defined.

Besides the before-set and after-set, this method accepts the following:

=over

=item ignore($item) OPTIONAL

A subroutine that returns true if $item should be ignored (e.g. commented). If an item ignored, the rank counter is not incremented, but the position counter still is.

=item prepare($item) OPTIONAL

A subroutine that returns a replacement for $item in further processing. Basically, this allows you to preprocess the $item before passing it to C, C, etc.

=item is_new($item)

A subroutine that returns true if $item is "new" and so doesn't already have a key.
Note, this subroutine is not run on the before-set (every item in that set should already have a key).

=item key($item)

A subroutine that returns the key of $item.

=item is_different($before_item, $after_item, $before_element, $after_element)

=item compare($before_item, $after_item, $before_element, $after_element)

A subroutine that returns true if $before_item is different from $after_item.

=item new($element) OPTIONAL

Called for each new $element

=item insert($element) OPTIONAL

Called for each $element that should be inserted

=item update($element) OPTIONAL

Called for each $element that should be updated

=item update_rank($element) OPTIONAL

Called for each $element that is otherwise the same, but has a different rank

=item delete($element) OPTIONAL

Called for each $element that should be deleted

=back

=head1 EXPORTS

=head2 diff( ... )

Same syntax as above. See above for more information.

=head1 AUTHOR

Robert Krimen, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Data::KeyDiff


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2007 Robert Krimen, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

use Data::KeyDiff::Element;
use Carp;

require Exporter;
@Data::KeyDiff::ISA = qw/Exporter/;
@Data::KeyDiff::EXPORT_OK = qw/diff/;

sub diff {
    shift if $_[0] && $_[0] eq __PACKAGE__;
    my $before = shift;
    my $after = shift;
    my %in = @_;

    my $get_key = $in{key} || $in{get_key} || sub {
        return shift;
    };
    my $is_new = $in{is_new};
    my $prepare = $in{prepare};
    my $is_different = $in{is_different} || $in{compare} || sub {
        my $left = shift;
        my $right = shift;
        return ((defined $left ^ defined $right) || (defined $left && $left ne $right));
    };
    my $ignore = $in{ignore};
    my ($on_new, $on_insert, $on_update, $on_update_rank, $on_delete) = @in{qw/new insert update update_rank delete/};

    my %before;
    my %after;
    my (@new, %insert, %update, %update_rank, %delete);

    my $position = my $rank = 0;
    $position--;
    my $item;
    for $item (@$before) {
        $position++;
        next if $ignore && $ignore->($item);
        my $value = $prepare ? $prepare->($item) : $item;
        my $key = $get_key->($value, $item);
        my $element = Data::KeyDiff::Element->new(key => $key, value => $value, position => $position, rank => $rank++, item => $item, in_before => 1);
        $before{$key} = $element;
    }

    $position = $rank = 0;
    $position--;
    for $item (@$after) {
        $position++;
        next if $ignore && $ignore->($item);
        my $value = $prepare ? $prepare->($item) : $item;
        if ($is_new && $is_new->($value, $item)) {
            my $element = Data::KeyDiff::Element->new(value => $value, position => $position, rank => $rank++, item => $item, is_new => 1);
            push @new, $element;
            next;
        }
        my $key = $get_key->($value, $item);
        my $element = Data::KeyDiff::Element->new(key => $key, value => $value, position => $position, rank => $rank++, item => $item, in_after => 1);
        $after{$key} = $element;
        if (! $before{$key}) {
            $insert{$key}++;
        }
        elsif ($is_different->($before{$key}->value, $element->value, $before{$key}, $element)) {
            $update{$key}++;
        }
        elsif ($before{$key}->rank != $after{$key}->rank) {
            $update_rank{$key}++;
        }
    }

    for my $key (keys %before) {
        next if exists $after{$key};
        $delete{$key}++;
    }

    if ($on_new) {
        $on_new->($_) for @new;
    }

    if ($on_insert) {
        $on_insert->($after{$_}) for keys %insert;
    }

    if ($on_update) {
        $on_update->($after{$_}, $before{$_}) for keys %update;
    }

    if ($on_update_rank) {
        $on_update_rank->($after{$_}, $before{$_}) for keys %update_rank;
    }

    if ($on_delete) {
        $on_delete->($before{$_}) for keys %delete;
    }
}

1; # End of Data::KeyDiff