#!/usr/bin/perl
# $Id: did.pl,v 1.19 2004/11/13 13:00:49 vincent Exp $

use strict;
use Getopt::Std;
use File::Find;

#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub usage {
  print <<"EOF";
   usage: $0 -c <stanza> [-C <file> -x <pattern> -i <pattern> -f -d -l -t -v]

   -C <file>    : configuration file, default ~/.did.cfg
   -c <stanza>  : select a stanza from the configuration file
   -x <pattern> : do not include files matching pattern
   -i <pattern> : only include files matching pattern
   -f           : use the diff command instead of cvs diff
   -l           : show CVS logs
   -d           : produce output suitable for patch(1)
   -t           : together with -d or -l, shows (CVS)-commands
   -v           : be verbose
EOF
  exit(0);
}
# end of usage
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub get_files {
  my ($dir, $files, $opt) = @_;

  File::Find::find( sub {
		      my $old = $_;
		      if (-f $_) {
			my $f = $File::Find::name;
			# skip CVS files
			return if ($f =~ /\/CVS\//);
			# skip files matching exclude pattern
			return if ( (exists($$opt{excl})) &&
				    ($f =~ /$$opt{excl}/) );
			# skip files not asked for
			return if ( (exists($$opt{incl})) &&
				    ($f !~ /$$opt{incl}/) );
			$f =~ s!^$dir/!!;
			push(@$files, $f);
		      }
		      $_ = $old;
		    }, $dir);
}
# end of get_files
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub get_cvsid {
  my ($base, $files, $re, $versions, $idx) = @_;

  for my $f (@$files) {
    open FIL, "$base/$f" or die "!E: can not fork opening $f: $!\n";
    while (<FIL>) {
      if (/$re/) {
	$$versions{$f}{$idx} = $1;
	last;
      }
    }
    close FIL or die "!E: can not open file $f: $!\n";
  }
}
# end of get_cvsid
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub do_cmd {
  my ($cmd, $kidding) = @_;

  unless($kidding) {
    system($cmd);
  } else {
    print "I: execute $cmd\n";
  }
}
# end of do_cmd
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub do_diff {
  my ($f, $target, $rev1, $rev2, $base, $usediff, $kidding) = @_;

  my ($cmd);

  if ((-d "${target}/CVS") && (! $usediff)){
    $f =~ s!^/(.*)!$1!;
    $cmd = 'cvs -f diff -u -r ' . $rev1 . ' -r ' . $rev2 . ' ' . $f;
    chdir($target) && do_cmd($cmd, $kidding);
  } else {
    if (-d "$base") {
      $cmd = "diff -u $base/$f $target/$f";
      do_cmd($cmd, $kidding);
    } else {
      print STDERR "W: do not know how to compare file $f\n";
    }
  }
}
# end of do_diff
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

sub do_log {
  my ($f, $target, $rev1, $rev2, $kidding) = @_;

  my ($cmd);

  if (-d "${target}/CVS") {
    $f =~ s!^/(.*)!$1!;
    $cmd = 'cvs -f log -N -r' . $rev1 . '::' . $rev2 . ' ' . $f;
    chdir($target) && do_cmd($cmd, $kidding);
  } else {
    print STDERR "!E: can not show logs on non-CVS files.\n";
  }
}
# end of do_log
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7
sub get_cfg {
  my ($opt, $cfg) = @_;

  my $stanza = '';

  open FIL, "$$opt{file}" or die "!E: can not fork opening $$opt{file}: $!\n";
    while (<FIL>) {
      if (/^\s*$/) { next; }
      if (/^\s*#/) { next; }
      if (/^\s*(\S+)\s*$/) {
	# make the first stanza the default one
	unless($stanza || $$opt{compare}) { $$opt{compare} = $1 };
	$stanza=$1;
      }
      if (/^\s*(\S+)\s*=\s*(\S+)\s*$/) {
	if ($stanza) {
	  $$cfg{$stanza}{$1} = $2;
	} else {
	  print STDERR "!W: no stanza for $_\n";
	}
      }
    }
  close FIL or die "!E: can not open file $$opt{file}: $!\n";

  unless($stanza) {
    die "!E: no valid stanzas found in $$opt{file}\n";
  }
}
# end of get_cfg
#---*----1----*----2----*----3----*----4----*----5----*----6----*----7

$|=1;

my %cfg = ();
my %opt = ();

$opt{compare} = '';
$opt{file}    = $ENV{HOME} . '/.did.cfg';
$opt{kidding} = 0;
$opt{cvslog}  = 0;
$opt{usediff} = 0;

&getopts('vc:x:i:dfltC:') or die usage();
if (defined($Getopt::Std::opt_h)) { usage(); }
$opt{verbose} = $Getopt::Std::opt_v if $Getopt::Std::opt_v;
$opt{compare} = $Getopt::Std::opt_c if $Getopt::Std::opt_c;
$opt{file}    = $Getopt::Std::opt_C if $Getopt::Std::opt_C;
$opt{diff}    = $Getopt::Std::opt_d if $Getopt::Std::opt_d;
$opt{excl}    = $Getopt::Std::opt_x if $Getopt::Std::opt_x;
$opt{incl}    = $Getopt::Std::opt_i if $Getopt::Std::opt_i;
$opt{kidding} = $Getopt::Std::opt_t if $Getopt::Std::opt_t;
$opt{cvslog}  = $Getopt::Std::opt_l if $Getopt::Std::opt_l;
$opt{usediff} = $Getopt::Std::opt_f if $Getopt::Std::opt_f;

get_cfg(\%opt, \%cfg);

unless($opt{compare}) { usage(); }

for my $k ('re1', 'dir1', 're2', 'dir2',) {
  unless($cfg{$opt{compare}}{$k}) {
    die "!E: Variable $k not defined in stanza $opt{compare}.\n";
  }
}

# debug
#for my $s (keys(%cfg)) {
#  for my $k (keys(%{$cfg{$s}})) {
#    print "$k\t$cfg{$s}{$k}\n";
#  }
#}

$opt{base1} = $cfg{$opt{compare}}{dir1};
$opt{base2} = $cfg{$opt{compare}}{dir2};
$opt{re1}   = $cfg{$opt{compare}}{re1};
$opt{re2}   = $cfg{$opt{compare}}{re2};

unless(-d $opt{base1}) { die "!E: no such directory $opt{base1}"; }
unless(-d $opt{base2}) { die "!E: no such directory $opt{base2}"; }

print "comparing $opt{base1} with $opt{base2}\n" if $opt{verbose};
my @list = ();
get_files($opt{base1}, \@list, \%opt);
my %versions = ();
get_cvsid($opt{base1}, \@list, $opt{re1}, \%versions, 'alt');
my @list = ();
get_files($opt{base2}, \@list, \%opt);
get_cvsid($opt{base2}, \@list, $opt{re2}, \%versions, 'neu');

for my $f (keys(%versions)) {
  # file exists in both trees and version number extracted
  if ((exists($versions{$f}{alt})) && (exists($versions{$f}{neu}))) {
    my $alt = $versions{$f}{alt};
    my $neu = $versions{$f}{neu};
    if ($alt ne $neu) {
      if ($opt{diff}) {
        do_diff($f, $opt{base1}, $neu, $alt, $opt{base2},
		$opt{usediff}, $opt{kidding});
      } else {
        printf "%-10s %-10s %s\n", $alt, $neu, $f;
      }
      if ($opt{cvslog}) {
        do_log($f, $opt{base1}, $neu, $alt, $opt{kidding});
      }
    }   # different versions
  # only found on BE
  } elsif (exists($versions{$f}{alt})) {
    printf "%-10s %s only in %s\n", $versions{$f}{alt}, $f, $opt{base1}
      if $opt{verbose};
  # only found on target
  #} elsif (exists($versions{$f}{neu})) {
  #  printf "%-10s %s only in %s\n", $versions{$f}{neu}, $f, $target
  #    if $opt{verbose};
  }
}
