App-ccdiff
view release on metacpan or search on metacpan
if ($no_colors) {
$ENV{CLICOLOR_FORCE} and $no_colors = 0;
}
elsif (defined $cli_color) {
# true $cli_color is the default for ccdiff
!$cli_color || !-t and $no_colors = 1;
}
unless (caller) {
$ENV{CCDIFF_OPTIONS} and unshift @ARGV, split m/\s+/ => $ENV{CCDIFF_OPTIONS};
GetOptions (
"help|?" => sub { usage (0); },
"V|version" => sub { say "$CMD [$VERSION]"; exit 0; },
"man" => sub { pod_nroff (); },
"info" => sub { pod_text (); },
"U|utf-8!" => \$opt_U,
"dc|diff-class=s" => \$diff_class,
"pp!" => sub { $diff_class = "PP" },
my $m = $no_colors ? "Pod::Text" : "Pod::Text::Color";
my $p = $m->new ();
open my $fh, ">", \my $out;
$p->parse_from_file ($0, $fh);
close $fh;
print $out;
exit 0;
} # pod_text
sub pod_nroff {
first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();
require Pod::Man;
my $p = Pod::Man->new ();
open my $fh, "|-", "nroff", "-man";
$p->parse_from_file ($0, $fh);
close $fh;
exit 0;
} # pod_nroff
# Color initialization
<$fh>;
};
my @d2 = ref $f2 eq "ARRAY" ? @$f2 : $f2 eq "-" ? <STDIN> : do {
open my $fh, "<", $f2 or die "$f2: $!\n";
$opt_U and binmode $fh, ":encoding(utf-8)";
<$fh>;
};
if ($opt_H) {
my $hc = "";
if ($opt_H =~ m/^\w\w+/) {
my ($hfg, $hbg) = split m/_?(?=on_)/ => lc $opt_H =~ s/\s+/_/gr;
$hfg && defined $clr{$hfg} and $hc .= $clr{$hfg};
$hbg && defined $clr{$hbg} and $hc .= $clr{$hbg};
}
my $nl = max length $f1, length $f2, 7;
my $sl = $hc ? ($ENV{COLUMNS} || 80) - 4 - $nl : 1;
my $hi = -1;
my @hi = ($old_label, $new_label);
my @h = map { $hi++; -f $_
? { tag => "",
name => $_,
}
if ($fh) {
select STDOUT;
close $fh;
}
} # ccdiff
sub subdiff {
my ($old, $new, $heu) = @_;
my $d = $diff_class->new (map { [ map { split m// } @$_ ] } $old, $new);
my ($d1, $d2, $x1, $x2, @h1, @h2) = ("", "", "", "");
my ($cml, $cmr) = $opt_v < 2 ? ("", "") : ($chr_cml, $chr_cmr);
my ($cmd, $cma) = ($chr_old, $chr_new);
@{$heu}{qw( old new same )} = (1, 1, 1); # prevent div/0
while ($d->Next) {
my @c = map {[ $d->Items ($_) ]} 1, 2;
my @co = @{$c[0]};
my @cn = @{$c[1]};
if ($d->Same) {
$heu->{same} += scalar @co;
my $e = $chr_eli;
my $c = join "" => @co;
if ($opt_e) {
my $join = "";
foreach my $sc (split m/\n/ => $c) {
$_ .= $join for $d1, $d2, $x1, $x2;
$join = "\n";
my $l = length $sc; # The length of this "same" chunck
my $le = $l - 2 * $opt_e; # The length of the text replaces with ellipsis
my $ee = $opt_v <= 1 ? $e : $e =~ s/^.\K(?=.$)/$le/r;
if ($le > length $ee) {
my $lsc = substr $sc, 0, $opt_e;
$d1 .= $lsc;
$d2 .= $lsc;
$lsc =~ s/\S/$chr_eql/g;
if (@cn) {
$heu->{new} += scalar @cn;
$d2 .= $cml.$clr_new;
$d2 .= s/\n/$reset\n$clr_new/gr for @cn;
$d2 .= $reset.$cmr;
$x2 .= $_ for map { s/[^\t\r\n]/$cma/gr } @cn;
$opt_v and push @h2, map { $opt_U ? charnames::viacode (ord) : unpack "H*"; } @cn;
}
}
$heu->{pct} = ($heu->{old} + $heu->{new}) / (2 * $heu->{same});
my @d = map { [ split m/(?<=\n)/ => s/\n*\z/\n/r ] } $d1, $d2;
if ($opt_m) {
$opt_v > 1 and s/(\S+)/ $1 /g for $x1, $x2;
s/[ \t]*\n*\z/\n/ for $x1, $x2;
my @x = map { /\S/ ? [ split m/(?<=\n)/ ] : [] } $x1, $x2;
foreach my $n (0, 1) {
@{$x[$n]} and $d[$n] = [ map {( $d[$n][$_], $x[$n][$_] // "" )} 0 .. (scalar @{$d[$n]} - 1) ];
}
}
if ($opt_v) {
$opt_U && $opt_v > 2 and $_ .= sprintf " (U+%06X)", charnames::vianame ($_) for @h1, @h2;
@h1 and push @{$d[0]}, sprintf " -- ${clr_dbg}verbose$reset : %s\n", join ", " => map { $clr_old.$_.$reset } @h1;
@h2 and push @{$d[1]}, sprintf " -- ${clr_dbg}verbose$reset : %s\n", join ", " => map { $clr_new.$_.$reset } @h2;
}
@d;
lib/App/ccdiff.pm view on Meta::CPAN
if ($no_colors) {
$ENV{CLICOLOR_FORCE} and $no_colors = 0;
}
elsif (defined $cli_color) {
# true $cli_color is the default for ccdiff
!$cli_color || !-t and $no_colors = 1;
}
unless (caller) {
$ENV{CCDIFF_OPTIONS} and unshift @ARGV, split m/\s+/ => $ENV{CCDIFF_OPTIONS};
GetOptions (
"help|?" => sub { usage (0); },
"V|version" => sub { say "$CMD [$VERSION]"; exit 0; },
"man" => sub { pod_nroff (); },
"info" => sub { pod_text (); },
"U|utf-8!" => \$opt_U,
"dc|diff-class=s" => \$diff_class,
"pp!" => sub { $diff_class = "PP" },
lib/App/ccdiff.pm view on Meta::CPAN
my $m = $no_colors ? "Pod::Text" : "Pod::Text::Color";
my $p = $m->new ();
open my $fh, ">", \my $out;
$p->parse_from_file ($0, $fh);
close $fh;
print $out;
exit 0;
} # pod_text
sub pod_nroff {
first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();
require Pod::Man;
my $p = Pod::Man->new ();
open my $fh, "|-", "nroff", "-man";
$p->parse_from_file ($0, $fh);
close $fh;
exit 0;
} # pod_nroff
# Color initialization
lib/App/ccdiff.pm view on Meta::CPAN
<$fh>;
};
my @d2 = ref $f2 eq "ARRAY" ? @$f2 : $f2 eq "-" ? <STDIN> : do {
open my $fh, "<", $f2 or die "$f2: $!\n";
$opt_U and binmode $fh, ":encoding(utf-8)";
<$fh>;
};
if ($opt_H) {
my $hc = "";
if ($opt_H =~ m/^\w\w+/) {
my ($hfg, $hbg) = split m/_?(?=on_)/ => lc $opt_H =~ s/\s+/_/gr;
$hfg && defined $clr{$hfg} and $hc .= $clr{$hfg};
$hbg && defined $clr{$hbg} and $hc .= $clr{$hbg};
}
my $nl = max length $f1, length $f2, 7;
my $sl = $hc ? ($ENV{COLUMNS} || 80) - 4 - $nl : 1;
my $hi = -1;
my @hi = ($old_label, $new_label);
my @h = map { $hi++; -f $_
? { tag => "",
name => $_,
lib/App/ccdiff.pm view on Meta::CPAN
}
if ($fh) {
select STDOUT;
close $fh;
}
} # ccdiff
sub subdiff {
my ($old, $new, $heu) = @_;
my $d = $diff_class->new (map { [ map { split m// } @$_ ] } $old, $new);
my ($d1, $d2, $x1, $x2, @h1, @h2) = ("", "", "", "");
my ($cml, $cmr) = $opt_v < 2 ? ("", "") : ($chr_cml, $chr_cmr);
my ($cmd, $cma) = ($chr_old, $chr_new);
@{$heu}{qw( old new same )} = (1, 1, 1); # prevent div/0
while ($d->Next) {
my @c = map {[ $d->Items ($_) ]} 1, 2;
my @co = @{$c[0]};
my @cn = @{$c[1]};
if ($d->Same) {
$heu->{same} += scalar @co;
my $e = $chr_eli;
my $c = join "" => @co;
if ($opt_e) {
my $join = "";
foreach my $sc (split m/\n/ => $c) {
$_ .= $join for $d1, $d2, $x1, $x2;
$join = "\n";
my $l = length $sc; # The length of this "same" chunck
my $le = $l - 2 * $opt_e; # The length of the text replaces with ellipsis
my $ee = $opt_v <= 1 ? $e : $e =~ s/^.\K(?=.$)/$le/r;
if ($le > length $ee) {
my $lsc = substr $sc, 0, $opt_e;
$d1 .= $lsc;
$d2 .= $lsc;
$lsc =~ s/\S/$chr_eql/g;
lib/App/ccdiff.pm view on Meta::CPAN
if (@cn) {
$heu->{new} += scalar @cn;
$d2 .= $cml.$clr_new;
$d2 .= s/\n/$reset\n$clr_new/gr for @cn;
$d2 .= $reset.$cmr;
$x2 .= $_ for map { s/[^\t\r\n]/$cma/gr } @cn;
$opt_v and push @h2, map { $opt_U ? charnames::viacode (ord) : unpack "H*"; } @cn;
}
}
$heu->{pct} = ($heu->{old} + $heu->{new}) / (2 * $heu->{same});
my @d = map { [ split m/(?<=\n)/ => s/\n*\z/\n/r ] } $d1, $d2;
if ($opt_m) {
$opt_v > 1 and s/(\S+)/ $1 /g for $x1, $x2;
s/[ \t]*\n*\z/\n/ for $x1, $x2;
my @x = map { /\S/ ? [ split m/(?<=\n)/ ] : [] } $x1, $x2;
foreach my $n (0, 1) {
@{$x[$n]} and $d[$n] = [ map {( $d[$n][$_], $x[$n][$_] // "" )} 0 .. (scalar @{$d[$n]} - 1) ];
}
}
if ($opt_v) {
$opt_U && $opt_v > 2 and $_ .= sprintf " (U+%06X)", charnames::vianame ($_) for @h1, @h2;
@h1 and push @{$d[0]}, sprintf " -- ${clr_dbg}verbose$reset : %s\n", join ", " => map { $clr_old.$_.$reset } @h1;
@h2 and push @{$d[1]}, sprintf " -- ${clr_dbg}verbose$reset : %s\n", join ", " => map { $clr_new.$_.$reset } @h2;
}
@d;
t/01-no-color.t view on Meta::CPAN
binmode STDOUT, ":encoding(utf-8)";
binmode STDERR, ":encoding(utf-8)";
binmode DATA, ":encoding(utf-8)";
# localtime will differ on other machines
my %stamp = map { s{^Files/}{}r => "$_ ".localtime ((stat)[9]) } glob "Files/*";
local $/ = "** EOT **\n";
while (<DATA>) {
chomp;
my ($dsc, $f1, $f2, $opt, $exp) = split m/\n/, $_, 5;
$exp =~ s/STAMP:1/$stamp{$f1}/g;
$exp =~ s/STAMP:2/$stamp{$f2}/g;
#diag "Description: $dsc";
#diag "Options: $opt";
my @cmd = ($^X, "ccdiff", "--utf-8", "--no-color", "Files/$f1", "Files/$f2");
$opt and push @cmd, split m/ / => $opt;
#diag "@cmd";
my ($out, $err, $exit) = capture { system @cmd; };
is ($out, $exp, $dsc);
is ($err, "", "No error");
is ($exit, 0, "Success");
}
done_testing;
__END__
( run in 0.487 second using v1.01-cache-2.11-cpan-f5b5a18a01a )