srcdiff #1

#!/usr/bin/perl
# -*-Fundamental-*-

# $Id: //guest/daniel_sherwood/cvs2p4/bin/srcdiff#1 $

select STDERR; $| = 1; select STDOUT; $| = 1;

require 5.000;
require "timelocal.pl";

use Carp; # ...or flounder. (This will fail unless 'perl' is a perl5!)

#use bytes;

use File::Basename;

($Myname = $0) =~ s%^.*/%%;
$Mydir = dirname($0);
$Here = `/bin/pwd`; chomp $Here;

if ($Mydir ne ".") { chdir "$Mydir" || die "$Myname: can't chdir \"$Mydir\": $!"; }
chdir ".." || die "$Myname: can't chdir \"..\": $!";
$Mydir = `/bin/pwd`; chop $Mydir;
chdir $Here || die "$Myname: can't chdir \"$Here\": $!";

my $revpat;

require "$Mydir/lib/util.pl";

#  A default EXT list; will be overlayed with the list in in the "config" file,
#  if present.
#
$EXT = <<EXTS;
a
bin
bmp
class
coff
com
crt
dll
doc
dvi
dwarf
exe
fm
gif
gz
ico
img
jar
jpg
lib
mcp
o
obj
opt
pdf
ps
rsrc
stg
tar
tdt
xbm
xls
zip
z
EXTS

@EXT = split(/\n/, $EXT); foreach my $ext (@EXT) { $EXT{$ext} = 1; }

$Usage = <<LIT;
$Myname: usage:
  $Myname -cvsdir cvsdir -p4dir p4dir [-tracelev n] [-repint n]
  $Myname -config <file>  [-tracelev n] [-repint n]
  $Myname -help
LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage

"repint" is the reporting interval - print a progress report after
comparing every n files.

LIT
  exit 1;
}

$First = ".";
$Go = 1;


$ren_hack = "_reTUrn_";

sub same
{
  my ($f1, $f2) = @_;

  my ($f1_ext) = ($f1 =~ /\.([^\.]+)$/);
  $f1_ext =~ tr/A-Z/a-z/;

  if ((! (-T $f1 && -T $f2)) || defined($EXTS{$f1_ext}) || defined($NOKEYEXP_PATHNAME{$f1}))
    {
      $f1 =~ s/"/\\"/g;
      $f2 =~ s/"/\\"/g;

      # This awful hack is because I can't get the perl open function to
      # open a file with a \r in the filename! I'm sorry!
      #
      $f2nam = $f2;
      if ($f2 =~ m/\r/)
        {  
          $f2nam =~ s/\r/$ren_hack/g;
          rename($f2, $f2nam) || die "rename \$f2, \$f2nam";
        }

      my $cmd = "/usr/bin/cmp \"$f1\" \"$f2nam\"";

      # Alas, the fall foul of the shell!:
      #
      $cmd =~ s/\$/\\\$/g;

#print STDERR "$Myname: binary compare: $cmd\n";
      return ! (system "$cmd");

      # Flip the name back, after the compare:
      #
      if ($f2nam =~ /$ren_hack/o)
        { rename($f2nam, $f2) || die "rename \$f2nam, \$f2"; }

    }

#print STDERR "$Myname: text compare: $f1 $f2\n";

  if (! open(Y, "<$f1"))
    { print STDERR "$Myname: can't open \"$f1\": $!\n"; exit 1; return 0; }

  # This awful hack is because I can't get the perl open function to
  # open a file with a \r in the filename! I'm sorry!
  #
  $f2nam = $f2;
  if ($f2 =~ m/\r/)
    {  
      $f2nam =~ s/\r/$ren_hack/g;
      rename($f2, $f2nam) || die "rename \$f2, \$f2nam";
    }

  if (! open(T, "<$f2nam"))
    { close Y; print STDERR "$Myname: can't open \"$f2nam\": $!\n"; exit 1; return 0; }

  # Flip the name back, after the compare:
  #
  if ($f2nam =~ /$ren_hack/o)
    { rename($f2nam, $f2) || die "rename \$f2nam, \$f2"; }

  $tstash = "";
  line: while (<Y>)
    {
      $y_ = $_;
      if ($tstash)
        { $t = $tstash; $tstash = ""; }
      else
        { $t = <T>; }

      $t_ = $t;
      
      # This is to handle a special case noticed in IronPort's
      # cvsroot/doug/ata/freebsd/sys/contrib/dev/oltr (Perhaps from
      # using Log in a file checked in from Windows?)  Anyway, I'm
      # pretty confident this will detect and correctly handle this
      # case, without perturbing the "normal" cases.
      #
      if ($y_ =~ /\r$/ && $t_ !~ /\r$/)
        { $use_cr = 1; }
      else
        { $use_cr = 0; }

      $y_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State)\b[^\$]*\$\r?/\$XXX\$/g;
      $t_ =~ s/\$(Author|Date|Header|Id|Locker|Log|Name|RCSfile|Revision|Source|State)\b[^\$]*\$\r?/\$XXX\$/g;

      # Similar to the special case noted above...
      # We only do this if we see $XXX$ (likely from the replacement above),
      # so that we'll still catch any other line-end mismatches.
      #
#      $t_ =~ s/\$XXX\$\r$/\$XXX\$/;
#      $t_ =~ s/\$XXX\$\r/\$XXX\$/;

      if ($y_ ne $t_)
        {
          close Y;
          close T;
          return 0;
        }

      if ($t =~ /\$Log\b[^\$]*\$/)
        {
          <T>; 
          while ($t_ = <T>)
            {
              $last = 0;
              if ($use_cr)
                { if ($t_ =~ /\*\r/) { next line; } } # Drop the *\r in this case!
              elsif ($t_ =~ /Revision/ || $t_ =~ /\*[\/]/)
                { $tstash = $t_; next line; }
            }
        }

    }

  $t_ = <T>;

  close Y; close T;
  if ($t_ eq "") { return 1; } else { return 0; }
}


sub traverse
{
  local($dir, $lev, $onfile, $ondir, $onsymlink) = @_;
  
  local($dirent);
  local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks);

  local($dirhandle) = "dh$lev";

  opendir($dirhandle, $dir);

  while (($dirent = readdir($dirhandle)))
    {
      if ($dirent eq "." || $dirent eq "..") { next; }
      ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks) = lstat("$dir/$dirent");
      typsw:
        {
          -f _ && do
            { 
              if ($Go && defined(&$onfile)) { &$onfile("$dir", "$dirent", $lev); }
              last typsw;
            } ;
          -d _ && do
            {
              if (defined(&$ondir)) { &$ondir("$dir", "$dirent", $lev); }
              if ($lev == 0 && $dirent =~ /$First/) { $Go = 1; }
              if ($Go) { do traverse("$dir/$dirent", $lev+1, $onfile, $ondir, $onsymlink) if -d _; }
              last typsw;
            } ;
          -l "$dir/$dirent" && do
            {
              if ($Go && defined(&$onsymlink)) { &$onsymlink("$dir", "$dirent", $lev); }
              last typsw;
            } ;
        }
    }
  closedir($dirhandle);
}


$Ndiff = 0;
$Nchecked = 0;

sub dir
{
  my($dir, $file, $lev) = @_;

  if ($file eq "CVS") { return; }

  my($path) = "$dir/$file";
  $path =~ s/^\.\///;
  my($rpath) = "$Here/$path";

  if ($lev < $Tracelev) { printf STDERR "$Myname: checking in $path\n"; }
}


sub check
{
  my($dir, $file, $lev) = @_;

  my $dirbase;
  ($dirbase = $dir) =~ s%^.*/%%;

  if ($dirbase eq "CVS") 	{ return; }

  if ($file =~ /\.o$/) 		{ return; }
  if ($file eq ".cvsignore") 	{ return; }

  if ($file =~ /\.cvsignore$/) { return; }

  my($path) = "$dir/$file";
  $path =~ s/^\.\///;

  my($rpath) = "$P4CLI/$path";

  # Handle special pathname cases...
  #
  $rpath =~ s/\r/%0d/g;
  $rpath =~ s/\.\.\./,,,/g;

  $rpath = &p4_esc($rpath, 1);

  if (! -e $rpath)
    {
      print STDOUT "$Myname: *** Missing: $rpath\n";
      $Ndiff++;
    }
  elsif (! &same("$rpath", "$path"))
    {
      print STDOUT "$Myname: different: $rpath\n";
      $Ndiff++;
    }
#  else
#    { print STDOUT "$Myname: OK: $rpath\n"; }

  $Nchecked++;
  if (($Nchecked % $Repint) == 0) { &report("progress"); }
}

sub ts
{
  my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  return sprintf("%04d/%02d/%02d_%02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec); }


sub report
{
  my ($status) = @_;

  if ($status) { $status .= " "; }

  printf STDERR "$Myname: $status: %s checked $Nchecked files; found $Ndiff diffs.\n", &ts;
 }


sub mkd
{
  my($dir, $mode) = @_;
  mkdir($dir, $mode) || &fail("can't mkdir \"$dir\": $!\n");
  printf(STDERR "> mkdir %s, %04o\n", $dir, $mode);
}


#  insure that the directory(s) required to store path "$dir" exist.
#  if $dir" or any require parent in the $dir pathname do not exist,
#  created them with the specified mode.
#
sub insdir
{
  my($dir, $insmode) = @_;

  if (! $insmode) { $insmode = 0775; }

  if (! -e $dir)
    {
      &insdir(&dirname($dir), $insmode);
      &mkd($dir, $insmode);
      return;
    }

  # So, it already exists, is it a dir?

  if (! -d $dir) { die("existing \"$dir\" is not a directory\n"); }

  if (! $insmode) { return; }

  # Last thing to insure is the mode...

  my(@stat) = stat($dir) || die("can't stat \"$dir\": $!\n");

  if (($stat[2] & 0777) == $insmode) { return; }

  chmod $insmode, $dir || die("can't chmod \"$dir\": $!\n");
}


sub dosystem
{
  my ($cmd, $cont) = @_;
  my $sts;

  print "$Myname> $cmd\n";
  if ($sts = system($cmd))
    {
      if (! $cont) { die "$Myname: dosystem(): command <$cmd> returned nonzero"; }
    }

  return $sts;
}


sub cvs_checkout
{
  my ($module, $branch, $tag) = @_;

  $branch =~ s/^import\///;

  if ($tag eq "-") { $tag = ""; }

  &insdir($CVSCLI);

  chdir $CVSCLI || die "chdir $CVSCLI";

  $cotag = "";
  if ($tag)
    { $cotag = " -r$tag"; }
  elsif ($branch && $branch ne "main")
    { $cotag = " -r$branch"; }

  &dosystem("/bin/rm -rf *");
  &dosystem("CVSROOT=$CVSROOT cvs checkout$cotag $module >/dev/null 2>&1");
}

my $p4d_up;


sub depot_for
{
  my ($module) = @_;

  my $depot = $P4_DEPOT;
  if (defined($Depotmap{$module}))
    { $depot = $Depotmap{$module}; }
  $depot =~ s/^\/\///;

  return $depot;
}


sub p4_checkout
{
  my ($module, $branch, $tag) = @_;

  if ($tag eq "-") { $tag = ""; }

  # So, is the server running?
  #
  if (! $p4d_up)
    {
      if (&dosystem("p4 -u $P4USER -p $P4PORT info >/dev/null 2>&1", 1))
        {
          chdir($P4ROOT) || die "chdir $P4ROOT";
          &dosystem("p4d -p $P4PORT -d -q -L log -J journal");
          print STDERR "Started Perforce server.\n";
        }
      $p4d_up = 1;
    }

  &insdir($P4CLI);

  chdir $P4CLI || die "chdir $CVSCLI";

  &dosystem("p4 -u $P4USER -p $P4PORT client -d -f $P4CLIENT >/dev/null 2>&1", 1);
  &dosystem("rm -rf *");
  &dosystem("/bin/echo P4PORT=$P4PORT > P4ENV");
  &dosystem("/bin/echo P4CLIENT=$P4CLIENT >> P4ENV");
  &dosystem("/bin/echo P4USER=$P4USER >> P4ENV");

  open(CLI_O, "p4 -u $P4USER -p $P4PORT client -o $P4CLIENT |") || die "can't open p4 client -o";
  open(CLI_I, "| p4 -u $P4USER -p $P4PORT client -i") || die "can't open p4 client -o";

  my @branches;

  # This gotta learn to love tags!:
  #
  if ($tag)
    {
      my $tagsinfo = `/usr/bin/grep ^$tag $TAGS 2>&1`;
      chomp $tagsinfo;

      if (! $tagsinfo)
        {
          print STDERR "$Myname: WARNING: tag \"$tag\" not found in $TAGS.\n".
                       "$Myname:   all branches will be mapped in the client.\n";
          push(@branches, "*");
        }
      else
        {  
print "TAGSINFO $tagsinfo\n";

          my (@tagsflds) = split(/\s+/, $tagsinfo);

          my @tbranches = split(/\001/, $tagsflds[1]);

#print "\$#tbranches = $#tbranches\n";
#foreach my $b (@tbranches)
#{ print "  b = $b\n"; }
#die;

          if ($#tbranches == 0 && $tbranches[0] eq "UNMAPPED")
            { push(@branches, "*"); }
          else
            {
              foreach my $branch (@tbranches)
                {
                  if ($branch ne "UNMAPPED")  { push(@branches, $branch); }
                }
            }
        }
    }
  else
    { push(@branches, $branch); }

  while (<CLI_O>)
    {
      if (/^Root:/) { print CLI_I "Root: $P4CLI\n"; next; }
      if (/^View:/) { last; }       
      print CLI_I;
    }
  close CLI_O;

  print CLI_I "View:\n";
  print STDERR "$Myname: View:\n";

  my $overlay = "";
  my $rhs_path;
  foreach my $branch (@branches)
    {
      my $depot;

      if ($branch =~ /^import\//)
        {
          $depot = "import";
          $branch =~ s/^import\///;
          $module = "";
          $mslash = "";
        }
      else
        {
          $depot = &depot_for($module);
          $mslash = "/";
        }

      if (! $rhs_path) { $rhs_path = "$depot/$branch"; }

      print STDERR "$Myname: \t$overlay//$depot/$branch/$module$mslash... //srcdiff/$rhs_path/$module$mslash...\n";
      print CLI_I "\t$overlay//$depot/$branch/$module$mslash... //srcdiff/$rhs_path/$module$mslash...\n";

      $overlay = "+";
    }

  close CLI_I;
  if ($?) { die "p4 client -i"; }

  if ($tag)
    { $spec = "\@$tag"; }
  else
    { $spec = "#head"; }

  &dosystem("p4 -u $P4USER -p $P4PORT -c $P4CLIENT sync //...$spec >/dev/null");

  my $ret = "$rhs_path";
  if ($module) { $ret .= "/$module"; }

  return $ret;
}


# option switch variables get defaults here...

(@pwent) = getpwuid($<);
if ($#pwent < 7)
  {
    print STDERR "$Myname: can't get your passwd file entry.\n";
    exit 1;
  }
$Username = $pwent[0];

$P4CLI = "";
$CVSCLI =".";

$Repint = 1000;
$Tracelev = 0;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-boolopt")    { $Boolopt = 1; shift; next; }
    elsif ($ARGV[0] eq "-repint")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $Repint = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-tracelev")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $Tracelev = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-cvsdir")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $CVSCLI = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-p4dir")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $P4CLI = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-config")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $Config = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-help")
      { &help; }
    elsif ($ARGV[0] =~ /^-/) { &usage; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }

$Here = `/bin/pwd`; chop $Here;

if ($Config)
  {
    my $Configdir = &dirname($Config);

    require "$Configdir/config";

    require "$Config";

    foreach $_ (@Cases)
      {
        chomp $case;
        if (/^\s*#/ || /^\s*$/) { next; }
        my ($module, $branch, $tag) = split(/\s+/, $_);

        print STDERR "\n$Myname: ===== module $module ===== branch $branch ===== tag $tag =====\n";

        my $p4_path = &p4_checkout($module, $branch, $tag);
        &cvs_checkout($module, $branch, $tag);

        &dosystem("$Mydir/bin/$Myname -cvsdir $CVSCLI/$module -p4dir $P4CLI/$p4_path");
      }
    exit 0;
  }


if (! -d $P4CLI) { print "No directory <$P4CLI>\n"; &usage; }
chdir $P4CLI || die "Can't chdir $P4CLI: $!";
$P4CLI = `/bin/pwd`;
chomp($P4CLI);

chdir $Here  || die "Can't chdir $Here: $!";

print STDERR "$Myname: starting...\n";

chdir "$CVSCLI" || die "Can't chdir $CVSCLI: $!";

&traverse(".", 0, "check", "dir", undef);

&report(" summary");

print STDERR "$Myname: done.\n";