Permalink
Browse files

initial import

  • Loading branch information...
1 parent b3070c3 commit 529a729ca75228778e62d56b47cb88d11e9bf06b @tokuhirom committed Aug 13, 2012
Showing with 254 additions and 5 deletions.
  1. +1 −0 Build.PL
  2. +20 −0 eg/simple.pl
  3. +174 −5 lib/Data/Difflet.pm
  4. +59 −0 t/01-simple.t
View
@@ -15,6 +15,7 @@ my $build = Module::Build->new(
# 'Exporter' => '0',
'parent' => '0',
# 'Plack' => '0.9949',
+ 'Term::ANSIColor' => 0,
},
no_index => { 'directory' => [ 'inc' ] },
View
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use utf8;
+use 5.010000;
+use autodie;
+
+use Data::Difflet;
+
+my $difflet = Data::Difflet->new();
+$difflet->compare(
+ {
+ a => 2,
+ c => 5,
+ },
+ {
+ a => 3,
+ b => 4,
+ }
+);
View
@@ -3,8 +3,154 @@ use strict;
use warnings;
use 5.008008;
our $VERSION = '0.01';
-
-
+use Term::ANSIColor;
+use Data::Dumper;
+
+our $LEVEL;
+
+sub new {
+ my $class = shift;
+ bless {
+ inserted_color => 'green',
+ deleted_color => 'red',
+ updated_color => 'blue',
+ comment_color => 'cyan',
+ indent => 2,
+ }, $class;
+}
+
+sub _($) { die "Do not call directly"; }
+
+sub compare {
+ my $self = shift;
+ local $LEVEL = 0;
+ no warnings 'redefine';
+ local *_ = sub($) { $self->ddf(@_) };
+ $self->_compare(@_);
+}
+
+# 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 => ", _($key));
+ local $LEVEL = $LEVEL + 1;
+ $self->_compare($a->{$key}, $b->{$key});
+ $self->_print(",\n");
+ } else {
+ $self->_updated("%s => %s,", _($key), _($a->{$key}));
+ $self->_comment(" # != %s,\n", _($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 (_($a->[$i]) eq _($b->[$i])) {
+ $self->_print("%s,\n", _($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", _ $a->[$i]);
+ } elsif ($i<$blen) {
+ $self->_deleted("%s,\n", _ $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) = @_;
+ print(' 'x($LEVEL*$self->{indent}));
+ printf colored(['reset'], shift @args), @args;
+}
+
+sub ddf {
+ my $self = shift;
+ @_==1 or die;
+
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 0;
+ Dumper(@_);
+}
+
+sub _inserted {
+ my ($self, @args) = @_;
+ print(' 'x($LEVEL*$self->{indent}));
+ printf colored([$self->{"inserted_color"}], shift @args), @args;
+}
+
+sub _updated {
+ my ($self, @args) = @_;
+ print(' 'x($LEVEL*$self->{indent}));
+ printf colored([$self->{"updated_color"}], shift @args), @args;
+}
+
+sub _deleted {
+ my ($self, @args) = @_;
+ print(' 'x($LEVEL*$self->{indent}));
+ printf colored([$self->{"deleted_color"}], shift @args), @args;
+}
+
+sub _comment {
+ my ($self, @args) = @_;
+ print(' 'x($LEVEL*$self->{indent}));
+ printf colored([$self->{"comment_color"}], shift @args), @args;
+}
1;
__END__
@@ -13,22 +159,45 @@ __END__
=head1 NAME
-Data::Difflet - A module for you
+Data::Difflet - Ultra special pretty cute diff generator Mark II
=head1 SYNOPSIS
- use Data::Difflet;
+ use Data::Difflet;
+
+ my $difflet = Data::Difflet->new();
+ $difflet->compare(
+ {
+ a => 2,
+ c => 5,
+ },
+ {
+ a => 3,
+ b => 4,
+ }
+ );
=head1 DESCRIPTION
-Data::Difflet is
+Data::Difflet is colorful diff generator for Perl5!
+
+See the following image!
+
+=begin html
+
+<img src="http://gyazo.64p.org/image/a82cb1898b53d51e45e49b21667aec85.png">
+
+=end html
=head1 AUTHOR
Tokuhiro Matsuno E<lt>tokuhirom AAJKLFJEF@ GMAIL COME<gt>
=head1 SEE ALSO
+This module is inspired from node.js library named difflet.
+L<git://github.com/substack/difflet.git>
+
=head1 LICENSE
Copyright (C) Tokuhiro Matsuno
View
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+use utf8;
+use Test::More 0.96;
+
+# Yes, this is silly.
+# please write correct test case and pull-req for me!
+use Data::Difflet;
+
+my $difflet = Data::Difflet->new();
+
+$difflet->compare(+{
+ 1 => 2,
+ 2 => 3,
+ foo => 'bar',
+}, {1 => 2, 2 => 4, 3 => 1});
+
+$difflet->compare(+{
+ 1 => 2,
+ 2 => 3,
+ foo => 'bar',
+}, [1,2,3]);
+
+$difflet->compare(+[
+ 4,
+ 2,
+ 3,
+ 8
+], [1,2,3]);
+
+$difflet->compare(+[1], {});
+$difflet->compare('a', 'b');
+$difflet->compare('a', 'a');
+
+$difflet->compare(
+ +[
+ {
+ 1 => 2,
+ 2 => 3,
+ },
+ ],
+ [ { 2 => 4, 3 => 5 } ]
+);
+
+$difflet->compare(
+ +[
+ {
+ 1 => 2,
+ 2 => 3,
+ foo => [ 3, 4, 7, 8 ]
+ },
+ ],
+ [ { 2 => 4, 3 => 5, foo => [ 3, 4, 5 ] } ]
+);
+
+ok 1;
+
+done_testing;
+

0 comments on commit 529a729

Please sign in to comment.