view release on metacpan or  search on metacpan

lib/Data/Difflet.pm  view on Meta::CPAN

package Data::Difflet;
use strict;
use warnings FATAL => 'recursion';
use 5.008008;
our $VERSION = '0.11';
use Term::ANSIColor;
use Data::Dumper;

our $LEVEL;
our $BUFFER;

sub new {
    my $class = shift;
    my %color = (
        inserted_color => 'green',
        deleted_color  => 'red',
        updated_color  => 'blue',
        comment_color  => 'cyan',
    );
    if ($ENV{DD_COLOR}) {
        # TYPE=FG;BG:TYPE=FG;BG:...
        for my $type_color (split /:/, $ENV{DD_COLOR}) {
            my($type, $color) = split /=/, $type_color, 2;
            my($fg, $bg)      = split /;/, $color, 2;
            $type .= "_color";
            $color{$type} = ($fg ? "$fg " : "").($bg ? "on_$bg" : "");
        }
    }
    bless {
        %color,
        indent => 2,
    }, $class;
}

sub _f($) { die "Do not call directly"; }

sub ddf {
    my $self = shift;
    @_==1 or die;

    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 0;
    Dumper(@_);
}

sub compare {
    my $self = shift;
    local $LEVEL = 0;
    local $BUFFER = '';
    no warnings 'redefine';
    local *_f = sub($) { $self->ddf(@_) };
    local $Term::ANSIColor::EACHLINE = "\n";
    $self->_compare(@_);
    return $BUFFER;
}

# TODO: recursion detection
sub _compare {
    my ($self, $a, $b) = @_;
    if (ref $a eq 'HASH') { # dump hash
        if (ref $b eq 'HASH') {
            $self->_print("{\n");
            {
                local $LEVEL = $LEVEL + 1;
                for my $key (sort keys %$a) {
                    if (exists $b->{$key}) {
                        if ($self->ddf($b->{$key}) eq $self->ddf($a->{$key})) {
                            $self->_print("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
                        } else {
                            if (ref($a->{$key}) or ref($b->{$key})) {
                                $self->_print("%s => ", _f($key));
                                local $LEVEL = $LEVEL + 1;
                                $self->_compare($a->{$key}, $b->{$key});
                                $self->_print(",\n");
                            } else {
                                $self->_updated("%s => %s,", _f($key), _f($a->{$key}));
                                $self->_comment(" # != %s,\n", _f($b->{$key}));
                            }
                        }
                    } else {
                        $self->_inserted("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
                    }
                }
                for my $key (sort keys %$b) {
                    next if exists $a->{$key};
                    $self->_deleted("%s => %s,\n", $self->ddf($key), $self->ddf($b->{$key}));
                }
            }
            $self->_print("}\n");
            return;
        } else {
            $self->_inserted("%s\n", $self->ddf($a));
            $self->_deleted("%s\n",  $self->ddf($b));
        }
    } elsif (ref $a eq 'ARRAY') {