File Coverage

blib/lib/Data/Difflet.pm
Criterion Covered Total %
statement 105 112 93.7
branch 29 36 80.5
condition 7 9 77.7
subroutine 16 17 94.1
pod 2 3 66.6
total 159 177 89.8


line stmt bran cond sub pod time code
1             package Data::Difflet;
2 3     3   37467 use strict;
  3         5  
  3         111  
3 3     3   14 use warnings FATAL => 'recursion';
  3         3  
  3         113  
4 3     3   52 use 5.008008;
  3         14  
  3         160  
5             our $VERSION = '0.11';
6 3     3   2128 use Term::ANSIColor;
  3         21621  
  3         226  
7 3     3   2128 use Data::Dumper;
  3         24863  
  3         872  
8              
9             our $LEVEL;
10             our $BUFFER;
11              
12             sub new {
13 1     1 1 11 my $class = shift;
14 1         7 my %color = (
15             inserted_color => 'green',
16             deleted_color => 'red',
17             updated_color => 'blue',
18             comment_color => 'cyan',
19             );
20 1 50       7 if ($ENV{DD_COLOR}) {
21             # TYPE=FG;BG:TYPE=FG;BG:...
22 0         0 for my $type_color (split /:/, $ENV{DD_COLOR}) {
23 0         0 my($type, $color) = split /=/, $type_color, 2;
24 0         0 my($fg, $bg) = split /;/, $color, 2;
25 0         0 $type .= "_color";
26 0 0       0 $color{$type} = ($fg ? "$fg " : "").($bg ? "on_$bg" : "");
    0          
27             }
28             }
29             bless {
30 1         9 %color,
31             indent => 2,
32             }, $class;
33             }
34              
35 0     0   0 sub _f($) { die "Do not call directly"; }
36              
37             sub ddf {
38 67     67 0 534 my $self = shift;
39 67 50       117 @_==1 or die;
40              
41 67         57 local $Data::Dumper::Terse = 1;
42 67         55 local $Data::Dumper::Indent = 0;
43 67         129 Dumper(@_);
44             }
45              
46             sub compare {
47 8     8 1 23 my $self = shift;
48 8         10 local $LEVEL = 0;
49 8         12 local $BUFFER = '';
50 3     3   20 no warnings 'redefine';
  3         4  
  3         2863  
51 8     32   35 local *_f = sub($) { $self->ddf(@_) };
  32         381  
52 8         11 local $Term::ANSIColor::EACHLINE = "\n";
53 8         18 $self->_compare(@_);
54 8         255 return $BUFFER;
55             }
56              
57             # TODO: recursion detection
58             sub _compare {
59 11     11   17 my ($self, $a, $b) = @_;
60 11 100       34 if (ref $a eq 'HASH') { # dump hash
    100          
61 4 100       9 if (ref $b eq 'HASH') {
62 3         8 $self->_print("{\n");
63             {
64 3         147 local $LEVEL = $LEVEL + 1;
  3         6  
65 3         13 for my $key (sort keys %$a) {
66 8 100       233 if (exists $b->{$key}) {
67 5 100       15 if ($self->ddf($b->{$key}) eq $self->ddf($a->{$key})) {
68 1         48 $self->_print("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
69             } else {
70 4 100 66     129 if (ref($a->{$key}) or ref($b->{$key})) {
71 1         3 $self->_print("%s => ", _f($key));
72 1         27 local $LEVEL = $LEVEL + 1;
73 1         13 $self->_compare($a->{$key}, $b->{$key});
74 1         24 $self->_print(",\n");
75             } else {
76 3         8 $self->_updated("%s => %s,", _f($key), _f($a->{$key}));
77 3         115 $self->_comment(" # != %s,\n", _f($b->{$key}));
78             }
79             }
80             } else {
81 3         9 $self->_inserted("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
82             }
83             }
84 3         207 for my $key (sort keys %$b) {
85 8 100       45 next if exists $a->{$key};
86 3         8 $self->_deleted("%s => %s,\n", $self->ddf($key), $self->ddf($b->{$key}));
87             }
88             }
89 3         158 $self->_print("}\n");
90 3         134 return;
91             } else {
92 1         3 $self->_inserted("%s\n", $self->ddf($a));
93 1         60 $self->_deleted("%s\n", $self->ddf($b));
94             }
95             } elsif (ref $a eq 'ARRAY') {
96 5 100       10 if (ref $b eq 'ARRAY') {
97 4         7 $self->_print("[\n");
98             {
99 4         131 local $LEVEL = $LEVEL + 1;
  4         6  
100 4         5 my $alen = 0+@$a;
101 4         4 my $blen = 0+@$b;
102 4         2 my $i = 0;
103 4         4 while (1) {
104 14 100 100     54 if ($i<$alen && $i<$blen) { # both
    100          
    50          
105 8 100       14 if (_f($a->[$i]) eq _f($b->[$i])) {
106 4         77 $self->_print("%s,\n", _f($a->[$i]));
107             } else {
108 4 100 66     151 if (ref($a->[$i]) or ref($b->[$i])) {
109 2         3 local $LEVEL = $LEVEL + 1;
110 2         18 $self->_compare($a->[$i], $b->[$i]);
111             } else {
112 2         6 $self->_updated("%s,", $a->[$i]);
113 2         68 $self->_comment(" # != %s\n", $b->[$i]);
114             }
115             }
116             } elsif ($i<$alen) {
117 2         6 $self->_inserted("%s,\n", _f $a->[$i]);
118             } elsif ($i<$blen) {
119 0         0 $self->_deleted("%s,\n", _f $b->[$i]);
120             } else {
121 4         7 last;
122             }
123 10         253 ++$i;
124             }
125             }
126 4         9 $self->_print("]\n");
127             } else {
128 1         2 $self->_inserted("%s\n", $self->ddf($a));
129 1         29 $self->_deleted("%s\n", $self->ddf($b));
130             }
131             } else {
132 2 100       3 if ($self->ddf($a) eq $self->ddf($b)) {
133 1         21 $self->_print("%s\n", $self->ddf($a));
134             } else {
135 1         22 $self->_inserted("%s\n", $self->ddf($a));
136 1         46 $self->_deleted("%s\n", $self->ddf($b));
137             }
138             }
139             }
140              
141             sub _print {
142 22     22   204 my ($self, @args) = @_;
143 22         62 $BUFFER .= ' 'x($LEVEL*$self->{indent});
144 22         55 $BUFFER .= sprintf colored(['reset'], shift @args), @args;
145             }
146              
147             sub _inserted {
148 8     8   247 my ($self, @args) = @_;
149 8         24 $BUFFER .= ' 'x($LEVEL*$self->{indent});
150 8         16 chomp(my $fmt = shift @args);
151 8         24 $BUFFER .= sprintf colored([$self->{"inserted_color"}], $fmt), @args;
152 8         256 $self->_comment(" # <<<\n");
153             }
154              
155             sub _updated {
156 5     5   104 my ($self, @args) = @_;
157 5         13 $BUFFER .= ' 'x($LEVEL*$self->{indent});
158 5         20 $BUFFER .= sprintf colored([$self->{"updated_color"}], shift @args), @args;
159             }
160              
161             sub _deleted {
162 6     6   170 my ($self, @args) = @_;
163 6         15 $BUFFER .= ' 'x($LEVEL*$self->{indent});
164 6         10 chomp(my $fmt = shift @args);
165 6         17 $BUFFER .= sprintf colored([$self->{"deleted_color"}], $fmt), @args;
166 6         220 $self->_comment(" # >>>\n");
167             }
168              
169             sub _comment {
170 19     19   109 my ($self, @args) = @_;
171 19         154 $BUFFER .= ' 'x($LEVEL*$self->{indent});
172 19         53 $BUFFER .= sprintf colored([$self->{"comment_color"}], shift @args), @args;
173             }
174              
175             1;
176             __END__