#!/usr/bin/perl
# codiff generated from codiff-0.3/codiff.pl Mar 2026

our $PACKAGE = "codiff";
our $VERSION = "0.3";
our $AUTHOR = "R.Jaksa 2026 GPLv3";
our $SUBVERSION = "";
our $BUILT = "Mar 2026";

our $HELP = <<EOF;

NAME
    codiff - color word/character diff

USAGE
    codiff [OPTIONS] `FILE1` `FILE2`

DESCRIPTION
    Compare two files and highlight changed characters, words or blocks.
    Streams and colors GNU `diff` output on the fly.

    If either FILE1 or FILE2 is a directory, it recursively searches for
    corresponding file within that directory.  If FILE2 is omitted, it
    searches the CWD recursively for a corresponding file.

OPTIONS
        -h  This help.
        -v  Verbose.
        -a  Print all lines.
      -NUM  Print `NUM` lines of context around each change.
  -c/w/b/l  Character/word/block/line mode (`-w` default).
       -nb  No blank lines changes.
       -ns  No whitespace amount changes.
      -nss  Ignore all whitespace changes.

LINE NUMBERS
    Red line numbers refer to `FILE1`, green and black to `FILE2`.

NOTE
    Character-mode produces the most compact output: inserting a single
    character costs one token, while word-mode would show the old word
    removed and new word added.

VERSION
    $PACKAGE-$VERSION$SUBVERSION CK($AUTHOR) CK(built $BUILT)

EOF

# ---------------------------------------------------------------------------------------- ARGV

# included "colors/base.pl"
# colors/base.pl generated from libpl-0.4/src/colors/base.pl Mar 2026 
our $CR_="\033[31m"; # color red
our $CG_="\033[32m"; # color green
our $CY_="\033[33m"; # color yellow
our $CB_="\033[34m"; # color blue
our $CM_="\033[35m"; # color magenta
our $CC_="\033[36m"; # color cyan
our $CW_="\033[37m"; # color white
our $CK_="\033[90m"; # color black
our $CD_="\033[0m";  # color default
# R.Jaksa 2003,2008,2026 GPLv3
# end "colors/base.pl"

# included "array.pl"
# array.pl generated from libpl-0.3f/src/array.pl Mar 2025 
{ # PERL ARRAYS SUPPORT

# inar newgen, returns index+1 instead of simple 0/1
# inar \@a,$s; check whether the string is in the array, return its idx+1 or zero (1st match)
our sub inar {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  for(my $i=0;$i<=$#{$a};$i++) { return $i+1 if $$a[$i] eq $s; }
  return 0; }

# clar \@a,$s; clear the string in the array (1st match), return its idx+1 or zero
our sub clar {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  for(my $i=0;$i<=$#{$a};$i++) {
    if($$a[$i] eq $s) {
      $$a[$i] = "";
      return $i+1; }}
  return 0; }

# pushq \@a,$s; string push unique, only if not there
our sub pushq {
  my $a=$_[0];	# array ref
  my $s=$_[1];	# string
  return if inar $a,$s;
  push @{$a},$s; }

# inar \@a,$s; checks whether the string $s is in an array @a
# sub inar { for(@{$_[0]}) { return 1 if $_ eq $_[1] } return 0 }

# delar \@a,$s; removes 1st instance of the string $s from an array @a, i.e. set it to empty ""
our sub delar { for(@{$_[0]}) { $_="" if $_ eq $_[1] }}

# return the length of array without empty "" elements
our sub lenar { my $i=0; for(@{$_[0]}) { $i++ if $_ ne "" } return $i }

# $prevailing = prevails \@array; returns most prevailing value in array
our sub prevails {
  my %n; $n{$_}++ for @{$_[0]}; # count appearances per value
  my $m=(keys %n)[0]; for(keys %n) { $m=$_ if $n{$_}>$n{$m} } # most prevailing
  return $m }

# remove duplicate elements, reorder according to frequency of elements and they orig. order
# @new = uique \@old;
our sub unique {
  my %n; # per-element counts
  my @o; # original order
  for(@{$_[0]}) {
    if(defined $n{$_}) { $n{$_}++ }
    else { $n{$_}=1; push @o,$_ }}
  # print "$_: $n{$_}x\n" for @o;
  my %r; # reverse per-count elements
  push @{$r{$n{$_}}},$_ for @o;
  my @a; # final array
  push @a,@{$r{$_}} for reverse sort keys %r;
  return @a }

# return the max element of array
our sub max {
  my ($max,@arr) = @_;
  $max=$_>$max?$_:$max for @arr;
  return $max }

# return 1 if all elements in array are the same
our sub allsame {
  my ($first,@arr) = @_;
  for(@arr) { return 0 if $_ != $first }
  return 1 }

} # R.Jaksa 2008,2024 GPLv3
# end "array.pl"

# included "path.pl"
# path.pl generated from libpl-0.4/src/path.pl Mar 2026 
{ # FILESYSTEM PATHS ROUTINES

# return the dirname from the path, or undef
our sub dname {
  return undef if not $_[0] =~ /^.*\/[^\/]*\/*$/;
  return $1 eq '' ? '/' : $1 }

# return filename from path: remove trailing slashes first, then remove directory part
our sub fname {
  return undef if !defined $_[0] or $_[0] eq "" or $_[0]=~/^\/+$/; # "/" is undef, not ""
  return $_[0] =~ s/\/+$//r =~ s/^.*\///r }

# return file suffix, or undef
our sub sx {
  return undef if not defined $_[0];
  return $1 if $_[0] =~ /\.([^.]*)$/;
  return undef }

# just remove the leading "./" from the path
our sub undot {
  return undef if not defined $_[0];
  return $_[0] =~ s/^(?:\.\/)+//r }

# beautify($path,$cwd)
our sub beautify {
  my $qcwd = quotemeta $_[1];								# CWD
  my $p1=$_[1]; $p1=~s/\/*$//; $p1=~s/[^\/]*$//; $p1=~s/\/*$//; my $qp1 = quotemeta $p1;# parent
  my $p2=$p1; $p2=~s/\/*$//; $p2=~s/[^\/]*$//; $p2=~s/\/*$//; my $qp2 = quotemeta $p2;	# grandparent
  my $qh = quotemeta $ENV{HOME};							# home
  my $p = $_[0];
  $p =~ s/^$qcwd\/// if $qcwd;		# /abc/def/ghi -> ghi if cwd=/abc/def
  $p =~ s/^$qp1\//..\// if $qp1;	# /abc/def/ghi -> ../ghi if cwd=/abc/def/xyz
  $p =~ s/^$qp2\//..\/..\// if $qp2;	# /abc/def/ghi -> ../../ghi if cwd=/abc/def/xyz/ijk
  $p =~ s/^$qh\//~\// if $qh;		# /home/abc/xyz -> ~/xyz
  $p =~ s/^\.\///;			# remove the leading "./"
  return $p }

# $path = mindepth @paths; returns the path form the array which has the minimal depth
our sub mindepth {
  my $p; my $d=1000000;
  for my $f (@_) { my $n=$f=~tr/\///; $p=$f and $d=$n if $n<$d }
  return $p }

} # R.Jaksa 2024,2026 GPLv3
# end "path.pl"

# included "printhelp.pl"
# printhelp.pl generated from helpman-0.4/src/printhelp.pl 2026-03-28
{ # PRINT A MAN-STYLE HELP
  # require colors/base.pl

our sub printhelp {
  my $help = $_[0];

  # we will store parsed text elements in this private hash
  my %STR;				# private substitutions content strings
  my $id=0;				# last ID

  # in the text these elements will be repled by this string
  my ($L,$R) = ("\#\#\>","\<\#\#");	# private left/right brace
  my sub REP { return "$L$_[0]$R"; }	# return complete private substitution identifier

  $help =~ s/(\n\#.*)*\n/\n/g;		# skip commented-out lines
  $help =~ s/\\\)/REP "brc2"/eg;	# save escaped bracket

  # C[RGYBMCWKD](text) <- color text
  my $colors = "RGYBMCWKD";
  my $RE1 = qr/(\((([^()]|(?-3))*)\))/x; # () group, $1=withparens, $2=without
  $STR{$id++}=$4 while $help =~ s/([^A-Z0-9])(C[$colors])$RE1/$1.REP("c$2$id")/e;

  # Q[RGYBMCWKD][RGYBMCWKD]("text") <- quoted text 1st=Q 2nd=quote-color 3rd=text-color-optional
  $STR{$id++}=$4 while $help =~ s/([^A-Z0-9])(Q[$colors][$colors]?)$RE1/$1.REP("q$2$id")/e;

  # 'xyz' <- color cyan
  $STR{$id++}="$2" while $help =~ s/([^A-Z0-9])`([^`]+)`/$1.REP("cCC$id")/e;

  # options lists, like -option ...
  $STR{$id++}=$2 while $help =~ s/(\n[ ]*)(-[a-zA-Z0-9_\/-]+(\[?[ =][A-Z]{2,}(x[A-Z]{2,})?\]?)?)([ \t])/$1.REP("op$id").$5/e;

  # bracketed uppercase words, like [WORD]
  $STR{$id++}="$1$2" while $help =~ s/\[([+-])?([A-Z_\/-]+)\]/REP("br$id")/e;

  # plain uppercase words, like sections headers
  $STR{$id++}=$2 while $help =~ s/(\n|[ \t])(([A-Z_\/-]+[ ]?){4,})/$1.REP("pl$id")/e;

  # re-substitute
  $help =~ s/${L}pl([0-9]+)$R/$CC_$STR{$1}$CD_/g;	# plain uppercase words
  $help =~ s/${L}op([0-9]+)$R/$CC_$STR{$1}$CD_/g;	# options
  $help =~ s/${L}br([0-9]+)$R/\[$CC_$STR{$1}$CD_\]/g;	# bracketed words

  # $cc{R} = CR_
  my %cc; $cc{$_} = ${"C".$_."_"} for split //,$colors;

  # CC(text)
  $help =~ s/${L}cC([$colors])([0-9]+)$R/$cc{$1}$STR{$2}$CD_/g;

  # QKR("text")
  while($help =~ /${L}qQ(([$colors])([$colors]?))([0-9]+)$R/) {
    my ($c1,$c2,$s) = ($cc{$2},$cc{$3},$STR{$4});
    my $q=$1 if $s=~/^(.)/; # 1st char
    if($s=~/^$q(.*)$q$/) { $s="$c1$q$c2$1$c1$q$CD_" }
    else                 { $s="$c2$s$CD_" }
    $help =~ s/${L}qQ[$colors][$colors]?[0-9]+$R/$s/ }

  # escapes
  $help =~ s/${L}brc2$R/)/g;

  # star bullets
  $help =~ s/\n(\h\h+)\* /\n$1$CC_\*$CD_ /g;

  print $help; }

} # R.Jaksa 2015,2019,2024 GPLv3
# end "printhelp.pl"

# included "findin.pl"
# findin.pl generated from libpl-0.4/src/findin.pl Mar 2026 
# require undot from path.pl
# find file in the dir, return the path or undef (file can be a subpath itself)
sub findin {
  my ($dir,$file)=@_;
  my $path = "$dir/$file";					# try direct dir/file
  return undot $path if -f $path;
  my $fname = (split "/",$file)[-1];				# may be the same as file
  $path = "$dic/$fname";					# try direct dir/filename
  return undot $path if -f $path;
  my @finds = split /\n/,`find '$dir' -type f -name '$fname'`;	# try recursive
  $path = (sort {($a=~tr|/||)<=>($b=~tr|/||)} @finds)[0];	# shortest path
  return undot $path if $path ne "" and -f $path }		# undef if not found
# R.Jaksa 2026 GPLv3
# end "findin.pl"

sub verbose { printf STDERR "$CC_%11s:$CD_ %s $CK_%s$CD_\n",$_[0],$_[1],$_[2] }
sub error   { printf STDERR "$CR_%11s:$CD_ %s $CK_%s$CD_\n",$_[0],$_[1],$_[2]; exit }

printhelp $HELP and exit if clar \@ARGV,"-h";
$VERBOSE=1 if clar \@ARGV,"-v";

 $NOBLANK=1 if clar \@ARGV,"-nb";  # ignore blank lines
$ANYSPACE=1 if clar \@ARGV,"-ns";  # any space width
$NOSPACES=1 if clar \@ARGV,"-nss"; # ignore spaces

our $ALL=0; # 1=all_lines 0=only_changed
$ALL=1 if clar \@ARGV,"-a";

our $MODE=2; # 1=char 2=word 3=block 0=line
$MODE=1 if clar \@ARGV,"-c";
$MODE=2 if clar \@ARGV,"-w";
$MODE=3 if clar \@ARGV,"-b";
$MODE=0 if clar \@ARGV,"-l";

our $CONTEXT;
for(@ARGV) { ($CONTEXT,$_)=($1,"") and last if $_=~/^-(\d+)$/ }

our $FILE1; for(@ARGV) { ($FILE1,$_)=($_,"") and last if $_ ne "" and -e $_ }
our $FILE2; for(@ARGV) { ($FILE2,$_)=($_,"") and last if $_ ne "" and -e $_ }

# wrong arguments
our @wrong; for(@ARGV) { push @wrong,$_ if $_ ne "" }
verbose "wrong args",join(" ",@wrong) if @wrong;

# initial paths
verbose "arg 1",$FILE1 if $VERBOSE and $FILE1 and not -f $FILE1;
verbose "arg 2",$FILE2 if $VERBOSE and $FILE2 and not -f $FILE2;

# FILE1 missing => fail
# FILE2 missing => look in CWD for the same filename (direct path or recursive)
# FILE1 or FILE2 is directory => look inside (direct or recursive, GNU diff does direct one)
if(not defined $FILE1) {
  error "missing","input files" }
elsif(not defined $FILE2) {
  error "not a file",$FILE1 if not -f $FILE1;
  error "error","$FILE1 is a local file" if not $FILE1=~/^\.\.\// and not $FILE1=~/^\//;
  $FILE2 = findin ".",fname($FILE1);
  error "error","file $FILE1 not found in current working directory" if not -f $FILE2 }
elsif(-f $FILE1 and -d $FILE2) {
  $FILE2 = findin $FILE2,$FILE1;
  error "error","directory $FILE2 doesnt contain $FILE1" if not -f $FILE2 }
elsif(-d $FILE1 and -f $FILE2) {
  $FILE1 = findin $FILE1,$FILE2;
  error "error","directory $FILE1 doesnt contain $FILE2" if not -f $FILE1 }

verbose "file 1",$FILE1 if $VERBOSE;
verbose "file 2",$FILE2 if $VERBOSE;
exit if not defined $FILE1 or not defined $FILE2;

# included "inc/codiff.pl"
# codiff.pl generated from codiff-0.3/src/codiff.pl Mar 2026
{ # -------------------------------------------------------------------------------- COLOR DIFF 
# our $MODE=1;     # 1=char 2=word 3=block 0=line
# our $ALL=0;      # 1=all_lines 0=only_changed
# our $CONTEXT=4;  # 4 lines of context
# our $NOBLANK=1;  # ignore blank lines
# our $ANYSPACE=1; # any space width
# our $NOSPACES=1; # ignore spaces
# TODO: option for "NUM1 -> NUM2" linenumbers instead of just "NUM"
# TODO: maybe +/- is not necessary

# use Algorithm::Diff qw(sdiff); ...choose XS version if available
eval  { require Algorithm::Diff::XS; Algorithm::Diff::XS->import(qw(sdiff)) }
or do { require Algorithm::Diff;     Algorithm::Diff->import(qw(sdiff)) };

# these are ok for programming languages, TODO: identify file type and choose appropriate ones
# TODO: don't break block at {} when it is inside "" string
my $REB = qr/[{};]/;				# blocks separators
my $REW = qr/[(){}\[\];`"'\s,+\-*\/%=&|^~!<>]/;	#  words separators

# use lookbehind/lookahead to obtain: foo(bar) => ['foo','(','bar',')']
my sub tokenise {
  my $s = $_[0];
  if   ($MODE==1) { return split //,$s }
  elsif($MODE==2) { return split /(?<=$REW)|(?=$REW)/,$s }
  elsif($MODE==3) { return split /(?<=$REB)|(?=$REB)/,$s }
  else		  { return $s }}

# i1,i2 = line numbers in file1 and file2
# @del,@add = line arrays, to delete and to add

my sub flush {
  my ($del,$add,$i1,$i2,$w) = @_;
  my $pairs = @$del < @$add ? @$del : @$add;
  for my $j (0 .. $pairs-1) {
    my @d = sdiff([tokenise($del->[$j])],[tokenise($add->[$j])]);
    my ($d,$a,$D,$A) = ("","",0,0); # d=del_rebuilt a=add_rebuilt D=d_changed A=a_changed
    for(@d) {
      my ($t,$o,$n) = @$_; # t=type o=old n=new
      if   ($t eq "u") { $d.="$CK_$o$CD_"; $a.=$n }
      elsif($t eq "c") { $d.="$CR_$o$CD_"; $a.="$CG_$n$CD_"; ($D,$A)=(1,1) }
      elsif($t eq "-") { $d.="$CR_$o$CD_"; $D=1 }
      elsif($t eq "+") { $a.="$CG_$n$CD_"; $A=1 } }
    printf "$CR_%${w}d$CD_ $CR_-$CD_ %s\n",$$i1,$d if $D; # old line with highlights
    printf "$CG_%${w}d$CD_ $CG_+$CD_ %s\n",$$i2,$a if $A; # new line with highlights
    $$i1++; $$i2++ }
  # excess old and new lines
  printf "$CR_%${w}d$CD_ $CR_-$CD_ $CR_%s$CD_\n",$$i1++,$_ for @{$del}[$pairs..$#$del];
  printf "$CG_%${w}d$CD_ $CG_+$CD_ $CG_%s$CD_\n",$$i2++,$_ for @{$add}[$pairs..$#$add]; }

our sub codiff {
  my ($file1,$file2) = @_;
  my ($i1,$i2,@del,@add) = (0,0);
  my $w = length(int((-s $file1)/35)); # line-number length (guessed for average line width 35)

  # -B ignore changes where lines are all blank
  my $o = "-u0";
     $o = "-u999999" if $ALL;
     $o = "-u$CONTEXT" if defined $CONTEXT;
     $o.= " -B" if $NOBLANK;
     $o.= " -b" if $ANYSPACE;
     $o.= " -w" if $NOSPACES;
  my $cmd = "diff $o -- \Q$file1\E \Q$file2\E";
  my $cmx = "diff $o -- $file1 $file2"; # for verbose printout # TODO: quoting if needed
  if($VERBOSE and defined &verbose) { verbose "call","$CM_$cmx$CD_"; print "\n" }
  open my $fh,"$cmd |";

  while (<$fh>) {
    chomp;
    if(/^---|\+\+\+/) {}				# files names
    elsif(/^@@ -(\d+)(,\d+)? \+(\d+)(,\d+)? @@/) {	# lines numbers
      flush(\@del,\@add,\$i1,\$i2,$w);
      ($i1,$i2,@del,@add)=($1,$3) }
    elsif(/^-(.*)/)  { push @del,$1 }			# deleted lines
    elsif(/^\+(.*)/) { push @add,$1 }			# added lines
    elsif(/^ (.*)/) {					# context lines
      flush(\@del,\@add,\$i1,\$i2,$w);
      printf "$CK_%${w}d$CD_   $CK_%s$CD_\n",$i2,$1;
      $i1++; $i2++; (@del,@add)=() }}
  flush(\@del,\@add,\$i1,\$i2,$w);
  close $fh }

# TODO: to ignore comments with -nc use this:
#       similarly real noindent with -ni
# - elsif(/^\+(.*)/) { push @add,$1 }
# + elsif(/^\+(.*)/) { my $a=$1; $a=~s/\h*#.*//; push @add,$a }
# use this to handle full-line comments (as preprocess)
# diff -u0 -I '^\s*#' FILE1 FILE2
} # ------------------------------------------------------------------------ R.Jaksa 2026 GPLv3
# end "inc/codiff.pl"

codiff $FILE1,$FILE2;

# -------------------------------------------------------------------------- R.Jaksa 2026 GPLv3