dochanges #3

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH
# -*-Fundamental-*-

require 5.000;

#  $Id: //guest/thomas_quinot/perforce/utils/cvs2p4/bin/dochanges#3 $
#
#  Richard Geiger
#
#  These re's specify the set of expected messages from various p4
#  operations which are successful. I.e., if a message is seen that
#  doe *not* match one of these, it's considered an error.
#
#     ... for "p4 submit"s:
#
$check_submits = <<MSGS;
Change [0-9]+ created with [0-9]+ open file\\(s\\).
^Change [0-9]+ submitted.\$
^Locking [0-9]+ files ...\$
^Submitting change [0-9]+.\$
^(add|branch|edit|delete) //.+#[0-9]+\$
^//.+ - refreshing\$
MSGS
@check_submits = split(/\n/, $check_submits);

#
#     ... for "p4 change -f"s:
#
$check_changefs = <<MSGS;
Change [0-9]+ updated.\$
MSGS
@check_changefs = split(/\n/, $check_changefs);

#print "\@check_submits:\n";
#foreach $c (@check_submits) { print "$c\n"; }
#obs##print "\n\@check_changes:\n";
#obs##foreach $c (@check_changes) { print "$c\n"; }
#print "\n\@check_changefs:\n";
#foreach $c (@check_changefs) { print "$c\n"; }
#exit 1;

sub dirname
{
  local($dir) = @_;
  $dir =~ s%^$%.%; $dir = "$dir/";
  if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
  if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
  { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
  return ".";
}

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

($Myname = $0) =~ s%^.*/%%;
$Mydir = &dirname($0);
$Here = `/bin/pwd`; chop $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\": $!";

#obs#use IPC::Open2;
require "$Mydir/lib/util.pl";

$Convclient = "cvs2p4";

$Usage = <<LIT;
$Myname: usage: $Myname [-v <n>] [-s <start_change_group>] <conversiondir>
LIT


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


sub help
{
  print STDERR <<LIT;
$Usage
$Myname <to be written>
LIT
  exit 1;
}


#  Guarantee that the name directory (may be multiple levels deep)
#  exists; create intermediate directories as needed (like mkdir -p)
#
sub insuredir
{
  my($d) = @_;
  if (! -d $d)
    {
      my($p) = &dirname($d);
      &insuredir($p);
      mkdir $d, 0755;
    }
}


sub path
{
  my($prefix, $file_dir, $file_name) = @_;
  my($path);
  $path = "$prefix";
  if ($file_dir) { $path .= "$file_dir/"; }
  $path .= "$file_name";
  return $path;
}


#  Check a message; if it matches any of the expected ones on @res,
#  it's OK; otherwise, declare a problem and rithlessly exit.  We
#  demand perfection!
#
sub checkmsg
{
  my($msg, $from, @res) = @_;
  chop $msg;
  foreach $re (@res)
    { if ($msg =~ /$re/) { return; } }
  print "$Myname: checkmsg: *** $from *** $msg\n";
  exit 1;
}  

# A temp file used to hold p4 command output
#
$tmpout = "/tmp/p4_submit_out.$$";

#  A convenient switch for disabling actual exection of commands.
#
$Do = 1;

#  Submit the current default change.
#  $msg is the log message to use.
#  $who is the original author of the RCS revision(s)
#  $time is the original time of the RCS revsision(s)
#  $files is the file list for the change.
#  @change is the change set; required for building revmap
#    (Used to construct the map of RCS revisions -> p4 changes.
#
sub p4submit
{
  my($msg, $who, $time, $files, @change) = @_;
  my $changenum;

  #  This bit is to allow us to pass multiple arrays.
  #  Hipper folks would use refs to arrays, I know.
  #  I must be as old as Larry Wall's Mom.
  #
  my (@files) = split(/\001/, $files);

  #  Start the submit...
  #
  $p4submit = "$P4 submit -i >$tmpout 2>&1";
  if ($V > 0) { print "$Myname: ...| $p4submit\n"; }
  if (! open(SUBMITW, "| $p4submit"))
    {
      print "$Myname: open \"| $p4submit\" failed: $!.\n";
      exit 1;
    }
 
  $P1 = <<P1;
Change:\tnew

Client:\t$Convclient

User:\t$Username

Status:\tnew

Description:
P1
  if ($V > 1) { my $vl; foreach $vl (split(/\n/, $P1)) { print "->SUBMITW: $vl\n"; } }
  print SUBMITW $P1;

  #  Insert the log message...
  #
  if ($LOGNOTE)
    { 
      my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
      my($ts) = sprintf("%04d/%02d/%02d %02d:%02d:%02d",
                         $year+1900, $mon+1, $mday, $hour, $min, $sec);
      $msg .= "\n[imported from CVS by $Convclient at $ts]\n";
    }

  @msg = split(/\n/, $msg);
  foreach $line (@msg)
    {
      if ($V > 1) { print "->SUBMITW:\t$line\n"; }
      print SUBMITW "\t$line\n";
    }

  $P2 = <<P2;

Files:
P2
  if ($V > 1) { my $vl; foreach $vl (split(/\n/, $P2)) { print "->SUBMITW: $vl\n"; } }
  print SUBMITW $P2;

  #  Insert the files list...
  #
  foreach $file (@files)
    {
      if ($V > 1) { print "->SUBMITW:\t$file\n"; }
      print SUBMITW "$file\n";
    }
     
  close SUBMITW;

  # OK, now we inspect the output from "p4 submit".  (Hey, we used to
  # use open2, but it kept leaving zombies around, and I got tired of
  # trying to understand why...)
  #
  if (! open(SUBMITR, "<$tmpout"))
    {
      print "$Myname: open \"<$tmpout\" failed: $!.\n";
      exit 1;
    }

  #  Build %chrevs - the whole first field of the change line, indexed
  #  by the file path part.
  #
  foreach $chrev (@change)
    {
      ($revinfo = $chrev) =~ s/ .*//; chop $revinfo;
      $revinfo =~ m%^$CVS_MODULE/(.*)/([0-9\.]+)%;
      $chrev{$1} = $revinfo;
    }

  while (<SUBMITR>)
    {
      if ($V > 0) { print "SUBMITR->:$_"; }
      &checkmsg($_, "p4 submit", @check_submits);

      #  Now update the rev map for each Perforce rev we see...
      #
      if (/^(add|branch|delete|edit) $P4_DEPOT\/[^\/]+\/(.*)#([0-9]+)$/)
        {
	  $chpath = $2;
          $p4rev = $_; chop $p4rev; $p4rev =~ s/^.* //;
          $cvsrev = $chrev{$chpath};
	  $REVMAP{$p4rev} = $cvsrev;
        }          

      if ($_ =~ /^Change ([0-9]+) submitted\.$/) { $changenum = $1; }
    } 
  close SUBMITR;

  #  Now we spoof the change to appear as done by $who at $time:
  #
  if ($changenum !~ /[0-9]+/)
    { print "$Myname: assert: didn't see change number <$changenum>.\n"; exit 1; }

  #  Start "p4 change -i -f"
  #
  $p4changef = "$P4 change -i -f >$tmpout 2>&1";
  if ($V > 0) { print "$Myname: ...| $p4changef\n"; }
  if (! open(CHANGEW, "| $p4changef"))
    {
      print "$Myname: open \"| $p4submit\" failed: $!.\n";
      exit 1;
    }

my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
$Date = sprintf("%4d/%02d/%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec);

$C1 = <<C1;
Change:\t$changenum

Date:\t$Date

Client:\t$Convclient

User:\t$who

Status:\tsubmitted

Description:
C1
  if ($V > 1) { my $vl; foreach $vl (split(/\n/, $C1)) { print "->CHANGEW: $vl\n"; } }
  print CHANGEW $C1;

  #  Insert the log message. Again.
  #
  foreach $line (@msg)
    {
      if ($V > 1) { print "->CHANGEW:\t$line\n"; }
      print CHANGEW "\t$line\n";
    }
  close CHANGEW;

  #  Now inspect the p4 output for errors...
  #
  if (! open(CHANGER, "<$tmpout"))
    {
      print "$Myname: open \"<$tmpout\" failed: $!.\n";
      exit 1;
    }

  while (<CHANGER>)
    {
      if ($V > 0) { print "SUBMITR->:$_"; }
      &checkmsg($_, "p4 change -f", @check_changefs);
    } 
  close CHANGER;
  unlink $tmpout;
}


$ext = <<EXTS;
a
bin
bmp
class
coff
com
dll
doc
dvi
dwarf
exe
fm
gif
gz
ico
jar
jpg
lib
o
obj
pdf
ps
tar
xbm
xls
zip
z
EXTS

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

sub is_binary_file
{
  my ($path) = @_;
  my ($filename) = $path;
  $filename =~ s/^.*\///;
  my $fileext;
  $filename =~ m/\.([^\.]+)$/;
  $fileext = $1;
  $fileext =~ tr/A-Z/a-z/;
  if (defined($ext{$fileext})) { return 1; }
  return 0;
}

#if (&is_binary_file($ARGV[0]))
#  { print "BINARY\n"; } else { print "TEXT\n"; }
#exit 1;

#  Determine whether the depot already has this file on this code line.
#  (Used to determine when we need to branch).
#
sub depot_has
{
  my($clientfile) = @_;
  my($line);

  $p4files = "$P4 files '$clientfile' 2>&1";
  print "$Myname: $p4files |...\n";
  if (! open(FILES, "$p4files |"))
    {
      print "$Myname: open \"$p4files |\" failed: $!.\n";
      exit 1;
    }
  $line = <FILES>;
#print $line; while(<FILES>) { print $_; }
  close FILES;
  if ($line =~ /- no such file\(s\)\./
        || $line =~ / - file\(s\) not in client view./
        || $line =~ / - delete change /)
    { return 0; }
  else
    { return 1; }
}

  
#  Process one "change" from RCS.
#  Called with the set of RCS files/revs to process in @change
#
sub dochange
{
  my @map;

  print "\n========== change group $do_change_num\n";

  if ($V > 0)
    {
      foreach $c (@change)
        {
          ($filerev, $time, $who, $state, $line, $branches, $prevrev, $options) = split(/$S/, $c);
          @filerev = split(/\//, $filerev);
          $rev = pop(@filerev);
          $file = join("/", @filerev);
         print "$who $time $filerev $state $line $branches\n";
       }
    }

  #  Get the 
  #

  # Do the revisions...
  #
  print "=== deletes\n";
  $nc = 0; undef $files;
  foreach $c (@change)
    {
      ($filerev, $time, $who, $state, $line, $branches, $prevrev, $options) = split(/$S/, $c);
      if ($line eq "$TRUNKLINE") { $line = "main"; }
      @filerev = split(/\//, $filerev);
      $rev = pop(@filerev);
      $file = join("/", @filerev);

      ($file_dir = &dirname($file)) =~ s/^$CVS_MODULE//;
      $file_dir =~ s/^\///;
      ($file_name = $file) =~ s%^.*/%%;

      $Depotfile = &path("$P4_DEPOT/$line/", $file_dir, $file_name);
      $Clientfile = &path("$Client/$line/", $file_dir, $file_name);

      &insuredir(&dirname($Clientfile));

      if ($state eq "dead")
        {
          $Exists_in_depot = &depot_has($Clientfile);
          if ($Exists_in_depot)
            {
	      if (! -e $Clientfile)
                {
		  # Create a dummy one to remove (p4/ must be stateless)
                  #
		  if (! open(C, ">$Clientfile"))
                    {
                      print "$Myname: can't create \"$Clientfile\": $!.\n";
                      exit 1;
                    }
                  close C;
                }
              if ($sts = &s("$P4 delete '$Clientfile'", $Do)) { exit $sts; } $nc++;
	      if ($files) { $files .= "\001"; }
              $files .= "\t$Depotfile\t# Delete";
            }
        }
    }
  if ($nc > 0) { &p4submit("Deleting\n", $who, $time, $files, @change); }

  print "===adds/edits===\n";
  $nc = 0; undef $files;
  foreach $c (@change)
    {
      ($filerev, $time, $who, $state, $line, $branches, $prevrev, $options) = split(/$S/, $c);
      if ($line eq "$TRUNKLINE") { $line = "main"; }
      @filerev = split(/\//, $filerev);
      $rev = pop(@filerev);
      $file = join("/", @filerev);

      ($file_dir = &dirname($file)) =~ s/^$CVS_MODULE//;
      $file_dir =~ s/^\///;
      ($file_name = $file) =~ s%^.*/%%;

      $Depotfile = &path("$P4_DEPOT/$line/", $file_dir, $file_name);
      $Clientfile = &path("$Client/$line/", $file_dir, $file_name);

      $Rcsfile = "$file,v";
      if (! -f $Rcsfile)
        {
          $Rcsfile = &path("$CVS_MODULE/", $file_dir, "Attic/$file_name,v");
          if (! -f $Rcsfile)
            { print "$Myname: can't find RCS ,v file for \"$file\".\n"; exit 1; }
        }
              
      &insuredir(&dirname($Clientfile));

      # Note: we assume binary files never become text files or vice versa
      #

      if ($state ne "dead")
        {
          $Exists_in_depot = &depot_has($Clientfile);

          if ($Exists_in_depot)
            {
              if (($sts = &rm($Clientfile)) || ($sts = &s("$CO -p$rev '$Rcsfile' >'$Clientfile'", $Do)))
                { exit $sts; }

              if ($sts = &s("$P4 edit '$Clientfile'", $Do)) { exit $sts; } $nc++;
	      if ($files) { $files .= "\001"; }
              $files .= "\t$Depotfile\t# Edit";
            }
          else
            {
              if (($sts = &rm($Clientfile)) || ($sts = &s("$CO -p$rev '$Rcsfile' >'$Clientfile'", $Do)))
                { exit $sts; }

	      # This is where we decide if this pup is a text or a binary file.
              #
              # We used to just trust the CVS options to tell us when we have
              # a binary... but many times binary files get checked in to CVS
              # and nobody remembers to tell CVS! So.... we now try to be more
              # clever.
              if ($options =~ /[ob]/ || -B $Clientfile || &is_binary_file($Clientfile))
                { $type = "binary" }
              else
                { $type = "text"; }

              if ($options =~ /x/) { $type = "x$type"; }
              if ($type =~ /text/) { $type = "k$type"; }

              if ($sts = &s("$P4 add -t $type '$Clientfile'", $Do)) { exit $sts; } $nc++;
	      if ($files) { $files .= "\001"; }
              $files .= "\t$Depotfile\t# Add";
            }
        }
    }

  if ($nc > 0) { &p4submit($MSGS{$filerev}, $who, $time, $files, @change); }

  print "===branches===\n";
  $nc = 0; undef $files;
  foreach $c (@change)
    {
      ($filerev, $time, $who, $state, $line, $branches, $prevrev, $options) = split(/$S/, $c);
      if ($line eq "$TRUNKLINE") { $line = "main"; }
      if ($state ne "dead" && $branches ne "-")
        {
          @filerev = split(/\//, $filerev);
          $rev = pop(@filerev);
          $file = join("/", @filerev);

          ($file_dir = &dirname($file)) =~ s/^$CVS_MODULE//;
          $file_dir =~ s/^\///;
          ($file_name = $file) =~ s%^.*/%%;

          $Depotfile = &path("$P4_DEPOT/$line/", $file_dir, $file_name);
          $Clientfile = &path("$Client/$line/", $file_dir, $file_name);

          foreach $branch (split(/:/, $branches))
            {
              $Depot_branchfile = &path("$P4_DEPOT/$branch/", $file_dir, $file_name);
              if ($sts = &s("$P4 integrate '$Depotfile' '$Depot_branchfile'", $Do)) { exit $sts; } $nc++;
	      if ($files) { $files .= "\001"; }
              $files .= "\t$Depot_branchfile\t# Branch";
              $Client_branchfile = &path("$Client/$branch/", $file_dir, $file_name);
            }
        } 
    }
  if ($nc > 0) { &p4submit("Branching\n", $who, $time, $files, @change); }
}


#  Expect messages from "p4d checkpoint"
#
$check_checkpoints = <<MSGS;
^command "checkpoint"\$
^p4d_admin> 
^: Checkpointing to 
^: Saving journal to 
^: Truncating 
MSGS
@check_checkpoints = split(/\n/, $check_checkpoints);

sub docheckpoint
{
  my($cmd) = "rsh $P4HOST -l $P4USER /u/p4/bin/p4d_admin port $P4PORTNUM rsh checkpoint 2>&1 </dev/null |";

  print "\n=== checkpoint after $do_change_num\n";

  if (! open(RSH, $cmd))
    {
      print "$Myname: can't open \"$cmd\": $!.\n";
      exit 1;
    }

  print "$Myname: $cmd\n";
  while (<RSH>)
    {
      &checkmsg($_, "p4d_admin rsh checkpoint", @check_checkpoints);
      print "$Myname: CHECKPOINT: $_";
    }
  close RSH;
} 


###### main starts here
#  

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

if ($CHECKPOINT_INTERVAL &&
      -x "/bin/domainname" &&
      `/bin/domainname` =~ /^netapp.com$/)
  { $Docheckpointing = 1; }
else
  { $Docheckpointing = 0; }

# option switch variables get defaults here...

$Metadata = "metadata";

# option switch variables get defaults here...

$Boolopt = 0;
$V = 1;
$Start_at_ch = 1;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-boolopt")    { $Boolopt = 1; shift; next; }
    elsif ($ARGV[0] eq "-v")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $V = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-s")
      {
        shift; if ($ARGV[0] < 0) { &usage; }
        $Start_at_ch = $ARGV[0]; shift; next;
      }
    elsif ($ARGV[0] eq "-help")
      { &help; }
    elsif ($ARGV[0] =~ /^-/) { &usage; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }

if ($#Args ne 0) { &usage; }

$Convdir = $Args[0];
chdir $Convdir || die "$Myname: can't chdir \"$Convdir\": $!";
$Convdir = `/bin/pwd`; chop $Convdir;
chdir $Here || die "$Myname: can't chdir \"$Here\": $!";

$Metadata = "$Convdir/metadata";
$Logmsgs  = "$Convdir/logmsgs";
$Changes  = "$Convdir/changes";
$Revmap   = "$Convdir/revmap";
$Client   = "$Convdir/p4";

$LOGNOTE = 1;

require "$Convdir/config";

if (! defined($P4PORT))
  { print "$Myname: no P4PORT in \"$Convdir/config\".\n"; exit 1; }
else
  { $ENV{"P4PORT"} = $P4PORT; }

($P4HOST = $P4PORT) =~ s/:.*//;
($P4PORTNUM = $P4PORT) =~ s/^.*://;

$P4USER = "p4";

$ENV{"P4CLIENT"} = $Convclient;

# These defaults can be overriden in the config file
#
#  Path the the RCS co command
#
if (! defined($CO)) { $CO = "/usr/local/bin/co"; }
if (! -x ($CO))
  { print "$Myname: No executable \"co\" command at \"$CO\".\n"; exit 1; }

#  Path the the p4 client command
#
if (! defined($P4)) { $P4 = "/usr/local/bin/p4"; }
if (! -x ($P4))
  { print "$Myname: No executable \"p4\" command at \"$P4\".\n"; exit 1; }

if ($Start_at_ch == 1)
  {
    #  We only do this to start (not when restarting from a chackpoint)
    #

    $P4CMD = "$P4 client -i";

    # Remove $Convdir/p4 if it already exists...
    # (This is where the client tree gets build)
    #
    &s("/bin/rm -rf '$Convdir/p4'");

    # Remove any revmap files...
    #  
    &s("/bin/rm -f $Revmap.dir $Revmap.pag");

    # Remove any existing client defined with this name.
    #
    &s("$P4 client -d $Convclient");
    if (! open(P4, "| $P4CMD"))
      {
        print "$Myname: open \"/usr/local/bin/p4 client -i\" failed: $!.\n";
        exit 1;
      }

    print P4 <<CLI;
Client: $Convclient

Root:   $Client

View:
        $P4_DEPOT/...   //$Convclient/...
CLI

    close P4;
    if ($?) { print "$Myname: \"$P4CMD\" failed to create client.\n"; exit 1; }
  }

#  Open the changes file (this is the genchamges output file)
#
if (! open(CHGS, "<$Changes"))
  { print "$Myname: can't open \"$Changes\": $!\n"; exit 1; }

#  Open the REVMAP database...
#
if (! dbmopen(REVMAP, $Revmap, 0666))
  { print "$Myname: can't dbmopen \"$Revmap\": $!\n"; exit 1; }

#  Open the log messages database
#
if (! dbmopen(MSGS, $Logmsgs, 0444))
  { print "$Myname: can't dbmopen \"$Logmsgs\": $!\n"; exit 1; }

$gather_change_num = $do_change_num = 0;
while (<CHGS>)
  {
    if (/^# ([0-9]+)$/)
      {
        $gather_change_num = $1;
        if ($do_change_num)
          {
            &dochange(@change);
            if (($CHECKPOINT_INTERVAL > 0) && (($do_change_num % $CHECKPOINT_INTERVAL) == 0))
              { if ($Docheckpointing) { &docheckpoint; } }
            $do_change_num = 0;
          }
	if ($gather_change_num < $Start_at_ch) { $gather_change_num = 0; next; }

        #  Clear the change
        #
        undef @change;
      }
    elsif ($gather_change_num)
      { push(@change, $_); $do_change_num = $gather_change_num; }
  }
if ($do_change_num) { &dochange(@change); }

#  I like closure...
#
dbmclose MSGS;
close CHGS;
dbmclose REVMAP;

if ($Docheckpointing) { &docheckpoint; }


#  This is the pre- -s capable version...
#  keeping it around a few revs for reference.
#
#  #  Eat the first line of CHGS; it should be a change number...
#  #
#  $_ = <CHGS>;
#  if (/^# ([0-9]+)$/)
#    { $change_num = $1; }
#  else
#    { die "first input line !~ /^# ([0-9]+)\$/...?"; }
#  
#  $n_changes_done = 0;
#  while (! eof CHGS)
#  { 
#    #  Clear the change
#    #
#    undef @change;
#  
#    #  Gather all the revs for this change...
#    #
#    while (<CHGS>)
#      {
#        if (/^# ([0-9]+)/) { $change_num = $1; last; }
#        chop;
#        push(@change, $_);
#      }
#  
#    #  And make it so...
#    #  
#    &dochange(@change);
#    $n_changes_done++;
#  
#    #  Time to checkpoint?
#    #
#    if (($CHECKPOINT_INTERVAL > 0) && (($n_changes_done % $CHECKPOINT_INTERVAL) == 0))
#      { if ($Docheckpointing) { &docheckpoint; } }
#  }