srcdiff #16

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


@binary_exts = split(/\n/, <<EOFEOFEOF);
img
tst
crt
exe
a
tdt
stg
mcp
opt
EOFEOFEOF

$binary_exts = join("|", @binary_exts);

# $Id: //guest/richard_geiger/utils/cvs2p4/bin/srcdiff#16 $

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

use Carp;
$| = 1;

use File::Basename;

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

chdir $Mydir || die "chdir $Mydir: $!";
$Mydir = `/bin/pwd`;
chomp $Mydir;
chdir $Here || die "chdir $Here";

$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;


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

  if ((! (-T $f1 && -T $f2)) || $f1 =~ /\.($binary_exts)\$/i)
    {
      $f1 =~ s/"/\\"/g;
      $f2 =~ s/"/\\"/g;

      my $cmd = "/usr/bin/cmp \"$f1\" \"$f2\"";
#      print STDERR "$Myname: binary compare: $cmd\n";
      return ! (system $cmd);
    }

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

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

  $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";

  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) = @_;

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

  &insdir($CVSCLI);

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

  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 p4_checkout
{
  my ($module, $branch, $tag) = @_;

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

  # So, is the server running?
  #
  if (! $p4d_up)
    {
      if (&dosystem("p4 -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 -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");

  open(CLI_O, "p4 -p $P4PORT client -o $P4CLIENT |") || die "can't open p4 client -o";
  open(CLI_I, "| p4 -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
        {  
          my (@tagsflds) = split(/\s+/, $tagsinfo);

          if ($#tagsflds == 1)
            {
              if ($tagsflds[1] eq "UNMAPPED-NOTFOUND")
                { push (@branches, "*"); }
              else
                { push (@branches, $tagsflds[1]); }
            }
          elsif ($#tagsflds == 3)
            {
              $tagsflds[2] =~ s/^\[(.*)\]$/$1/;
              $tagsflds[3] =~ s/^\[(.*)\]$/$1/;
              push(@branches, $tagsflds[2]);
              push(@branches, $tagsflds[3]);
            }
        }
    }
  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 = "";
  foreach my $branch (@branches)
    {
      print STDERR "$Myname: \t$overlay//ip/$branch/$module/... //srcdiff/ip/$branches[0]/$module/...\n";
      print CLI_I "\t$overlay//ip/$branch/$module/... //srcdiff/ip/$branches[0]/$module/...\n";
      $overlay = "+";
    }

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

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

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

  return $branches[0];
}


# 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)
  {
    if (! open(CONFIG, "<$Config"))
      {
        print "$Myname: open \"<$Config\" failed: $!.\n";
        exit 1;
      }

    my $config_pl;
    { local $/; $config_pl = <CONFIG>; }

    close CONFIG;

    my $evret;
    eval $config_pl;
    if ($@)
      {
        print "eval $Config failed: $@\n";
        exit 1;
      }
    print "eval'ed $Config ok.\n";

    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_branch = &p4_checkout($module, $branch, $tag);
        &cvs_checkout($module, $branch, $tag);
        &dosystem("$Mydir/$Myname -cvsdir $CVSCLI/$module -p4dir $P4CLI/ip/$p4_branch/$module");
      }
    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";