Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

initial import

  • Loading branch information...
commit 529a729ca75228778e62d56b47cb88d11e9bf06b 1 parent b3070c3
Tokuhiro Matsuno authored
1  Build.PL
@@ -15,6 +15,7 @@ my $build = Module::Build->new(
15 15 # 'Exporter' => '0',
16 16 'parent' => '0',
17 17 # 'Plack' => '0.9949',
  18 + 'Term::ANSIColor' => 0,
18 19 },
19 20
20 21 no_index => { 'directory' => [ 'inc' ] },
20 eg/simple.pl
... ... @@ -0,0 +1,20 @@
  1 +#!/usr/bin/env perl
  2 +use strict;
  3 +use warnings;
  4 +use utf8;
  5 +use 5.010000;
  6 +use autodie;
  7 +
  8 +use Data::Difflet;
  9 +
  10 +my $difflet = Data::Difflet->new();
  11 +$difflet->compare(
  12 + {
  13 + a => 2,
  14 + c => 5,
  15 + },
  16 + {
  17 + a => 3,
  18 + b => 4,
  19 + }
  20 +);
179 lib/Data/Difflet.pm
@@ -3,8 +3,154 @@ use strict;
3 3 use warnings;
4 4 use 5.008008;
5 5 our $VERSION = '0.01';
6   -
7   -
  6 +use Term::ANSIColor;
  7 +use Data::Dumper;
  8 +
  9 +our $LEVEL;
  10 +
  11 +sub new {
  12 + my $class = shift;
  13 + bless {
  14 + inserted_color => 'green',
  15 + deleted_color => 'red',
  16 + updated_color => 'blue',
  17 + comment_color => 'cyan',
  18 + indent => 2,
  19 + }, $class;
  20 +}
  21 +
  22 +sub _($) { die "Do not call directly"; }
  23 +
  24 +sub compare {
  25 + my $self = shift;
  26 + local $LEVEL = 0;
  27 + no warnings 'redefine';
  28 + local *_ = sub($) { $self->ddf(@_) };
  29 + $self->_compare(@_);
  30 +}
  31 +
  32 +# TODO: recursion detection
  33 +sub _compare {
  34 + my ($self, $a, $b) = @_;
  35 + if (ref $a eq 'HASH') { # dump hash
  36 + if (ref $b eq 'HASH') {
  37 + $self->_print("{\n");
  38 + {
  39 + local $LEVEL = $LEVEL + 1;
  40 + for my $key (sort keys %$a) {
  41 + if (exists $b->{$key}) {
  42 + if ($self->ddf($b->{$key}) eq $self->ddf($a->{$key})) {
  43 + $self->_print("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
  44 + } else {
  45 + if (ref($a->{$key}) or ref($b->{$key})) {
  46 + $self->_print("%s => ", _($key));
  47 + local $LEVEL = $LEVEL + 1;
  48 + $self->_compare($a->{$key}, $b->{$key});
  49 + $self->_print(",\n");
  50 + } else {
  51 + $self->_updated("%s => %s,", _($key), _($a->{$key}));
  52 + $self->_comment(" # != %s,\n", _($b->{$key}));
  53 + }
  54 + }
  55 + } else {
  56 + $self->_inserted("%s => %s,\n", $self->ddf($key), $self->ddf($a->{$key}));
  57 + }
  58 + }
  59 + for my $key (sort keys %$b) {
  60 + next if exists $a->{$key};
  61 + $self->_deleted("%s => %s,\n", $self->ddf($key), $self->ddf($b->{$key}));
  62 + }
  63 + }
  64 + $self->_print("}\n");
  65 + return;
  66 + } else {
  67 + $self->_inserted("%s\n", $self->ddf($a));
  68 + $self->_deleted("%s\n", $self->ddf($b));
  69 + }
  70 + } elsif (ref $a eq 'ARRAY') {
  71 + if (ref $b eq 'ARRAY') {
  72 + $self->_print("[\n");
  73 + {
  74 + local $LEVEL = $LEVEL + 1;
  75 + my $alen = 0+@$a;
  76 + my $blen = 0+@$b;
  77 + my $i = 0;
  78 + while (1) {
  79 + if ($i<$alen && $i<$blen) { # both
  80 + if (_($a->[$i]) eq _($b->[$i])) {
  81 + $self->_print("%s,\n", _($a->[$i]));
  82 + } else {
  83 + if (ref($a->[$i]) or ref($b->[$i])) {
  84 + local $LEVEL = $LEVEL + 1;
  85 + $self->_compare($a->[$i], $b->[$i]);
  86 + } else {
  87 + $self->_updated("%s,", $a->[$i]);
  88 + $self->_comment(" # != %s\n", $b->[$i]);
  89 + }
  90 + }
  91 + } elsif ($i<$alen) {
  92 + $self->_inserted("%s,\n", _ $a->[$i]);
  93 + } elsif ($i<$blen) {
  94 + $self->_deleted("%s,\n", _ $b->[$i]);
  95 + } else {
  96 + last;
  97 + }
  98 + ++$i;
  99 + }
  100 + }
  101 + $self->_print("]\n");
  102 + } else {
  103 + $self->_inserted("%s\n", $self->ddf($a));
  104 + $self->_deleted("%s\n", $self->ddf($b));
  105 + }
  106 + } else {
  107 + if ($self->ddf($a) eq $self->ddf($b)) {
  108 + $self->_print("%s\n", $self->ddf($a));
  109 + } else {
  110 + $self->_inserted("%s\n", $self->ddf($a));
  111 + $self->_deleted("%s\n", $self->ddf($b));
  112 + }
  113 + }
  114 +}
  115 +
  116 +sub _print {
  117 + my ($self, @args) = @_;
  118 + print(' 'x($LEVEL*$self->{indent}));
  119 + printf colored(['reset'], shift @args), @args;
  120 +}
  121 +
  122 +sub ddf {
  123 + my $self = shift;
  124 + @_==1 or die;
  125 +
  126 + local $Data::Dumper::Terse = 1;
  127 + local $Data::Dumper::Indent = 0;
  128 + Dumper(@_);
  129 +}
  130 +
  131 +sub _inserted {
  132 + my ($self, @args) = @_;
  133 + print(' 'x($LEVEL*$self->{indent}));
  134 + printf colored([$self->{"inserted_color"}], shift @args), @args;
  135 +}
  136 +
  137 +sub _updated {
  138 + my ($self, @args) = @_;
  139 + print(' 'x($LEVEL*$self->{indent}));
  140 + printf colored([$self->{"updated_color"}], shift @args), @args;
  141 +}
  142 +
  143 +sub _deleted {
  144 + my ($self, @args) = @_;
  145 + print(' 'x($LEVEL*$self->{indent}));
  146 + printf colored([$self->{"deleted_color"}], shift @args), @args;
  147 +}
  148 +
  149 +sub _comment {
  150 + my ($self, @args) = @_;
  151 + print(' 'x($LEVEL*$self->{indent}));
  152 + printf colored([$self->{"comment_color"}], shift @args), @args;
  153 +}
8 154
9 155 1;
10 156 __END__
@@ -13,15 +159,35 @@ __END__
13 159
14 160 =head1 NAME
15 161
16   -Data::Difflet - A module for you
  162 +Data::Difflet - Ultra special pretty cute diff generator Mark II
17 163
18 164 =head1 SYNOPSIS
19 165
20   - use Data::Difflet;
  166 + use Data::Difflet;
  167 +
  168 + my $difflet = Data::Difflet->new();
  169 + $difflet->compare(
  170 + {
  171 + a => 2,
  172 + c => 5,
  173 + },
  174 + {
  175 + a => 3,
  176 + b => 4,
  177 + }
  178 + );
21 179
22 180 =head1 DESCRIPTION
23 181
24   -Data::Difflet is
  182 +Data::Difflet is colorful diff generator for Perl5!
  183 +
  184 +See the following image!
  185 +
  186 +=begin html
  187 +
  188 +<img src="http://gyazo.64p.org/image/a82cb1898b53d51e45e49b21667aec85.png">
  189 +
  190 +=end html
25 191
26 192 =head1 AUTHOR
27 193
@@ -29,6 +195,9 @@ Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>
29 195
30 196 =head1 SEE ALSO
31 197
  198 +This module is inspired from node.js library named difflet.
  199 +L<git://github.com/substack/difflet.git>
  200 +
32 201 =head1 LICENSE
33 202
34 203 Copyright (C) Tokuhiro Matsuno
59 t/01-simple.t
... ... @@ -0,0 +1,59 @@
  1 +use strict;
  2 +use warnings;
  3 +use utf8;
  4 +use Test::More 0.96;
  5 +
  6 +# Yes, this is silly.
  7 +# please write correct test case and pull-req for me!
  8 +use Data::Difflet;
  9 +
  10 +my $difflet = Data::Difflet->new();
  11 +
  12 +$difflet->compare(+{
  13 + 1 => 2,
  14 + 2 => 3,
  15 + foo => 'bar',
  16 +}, {1 => 2, 2 => 4, 3 => 1});
  17 +
  18 +$difflet->compare(+{
  19 + 1 => 2,
  20 + 2 => 3,
  21 + foo => 'bar',
  22 +}, [1,2,3]);
  23 +
  24 +$difflet->compare(+[
  25 + 4,
  26 + 2,
  27 + 3,
  28 + 8
  29 +], [1,2,3]);
  30 +
  31 +$difflet->compare(+[1], {});
  32 +$difflet->compare('a', 'b');
  33 +$difflet->compare('a', 'a');
  34 +
  35 +$difflet->compare(
  36 + +[
  37 + {
  38 + 1 => 2,
  39 + 2 => 3,
  40 + },
  41 + ],
  42 + [ { 2 => 4, 3 => 5 } ]
  43 +);
  44 +
  45 +$difflet->compare(
  46 + +[
  47 + {
  48 + 1 => 2,
  49 + 2 => 3,
  50 + foo => [ 3, 4, 7, 8 ]
  51 + },
  52 + ],
  53 + [ { 2 => 4, 3 => 5, foo => [ 3, 4, 5 ] } ]
  54 +);
  55 +
  56 +ok 1;
  57 +
  58 +done_testing;
  59 +

0 comments on commit 529a729

Please sign in to comment.
Something went wrong with that request. Please try again.