File Coverage

blib/lib/Data/Difflet.pm

Criterion	Covered	Total	%
statement	101	108	93.5
branch	29	36	80.5
condition	7	9	77.7
subroutine	16	17	94.1
pod	2	3	66.6
total	155	173	89.6

package Data::Difflet;
use strict;
use warnings FATAL => 'recursion';
use 5.008008;
our $VERSION = '0.10';
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') {
        if (ref $b eq 'ARRAY') {
            $self->_print("[\n");
            {
                local $LEVEL = $LEVEL + 1;
                my $alen = 0+@$a;
                my $blen = 0+@$b;
                my $i = 0;
                while (1) {
                    if ($i<$alen && $i<$blen) { # both
                        if (_f($a->[$i]) eq _f($b->[$i])) {
                            $self->_print("%s,\n", _f($a->[$i]));
                        } else {
                            if (ref($a->[$i]) or ref($b->[$i])) {
                                local $LEVEL = $LEVEL + 1;
                                $self->_compare($a->[$i], $b->[$i]);
                            } else {
                                $self->_updated("%s,", $a->[$i]);
                                $self->_comment(" # != %s\n", $b->[$i]);
                            }
                        }
                    } elsif ($i<$alen) {
                        $self->_inserted("%s,\n", _f $a->[$i]);
                    } elsif ($i<$blen) {
                        $self->_deleted("%s,\n", _f $b->[$i]);
                    } else {
                        last;
                    }
                    ++$i;
                }
            }
            $self->_print("]\n");
        } else {
            $self->_inserted("%s\n", $self->ddf($a));
            $self->_deleted("%s\n",  $self->ddf($b));
        }
    } else {
        if ($self->ddf($a) eq $self->ddf($b)) {
            $self->_print("%s\n", $self->ddf($a));
        } else {
            $self->_inserted("%s\n", $self->ddf($a));
            $self->_deleted("%s\n", $self->ddf($b));
        }
    }
}

sub _print {
    my ($self, @args) = @_;
    $BUFFER .= ' 'x($LEVEL*$self->{indent});
    $BUFFER .= sprintf colored(['reset'], shift @args), @args;
}

sub _inserted {
    my ($self, @args) = @_;
    $BUFFER .= ' 'x($LEVEL*$self->{indent});
    $BUFFER .= sprintf colored([$self->{"inserted_color"}], shift @args), @args;
}

sub _updated {
    my ($self, @args) = @_;
    $BUFFER .= ' 'x($LEVEL*$self->{indent});
    $BUFFER .= sprintf colored([$self->{"updated_color"}], shift @args), @args;
}

sub _deleted {
    my ($self, @args) = @_;
    $BUFFER .= ' 'x($LEVEL*$self->{indent});
    $BUFFER .= sprintf colored([$self->{"deleted_color"}], shift @args), @args;
}

sub _comment {
    my ($self, @args) = @_;
    $BUFFER .= ' 'x($LEVEL*$self->{indent});
    $BUFFER .= sprintf colored([$self->{"comment_color"}], shift @args), @args;
}

1;
__END__