p4_synced_at #2

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

use Carp;
use strict;
$| = 1;

my $Myname;
($Myname = $0) =~ s%^.*/%%;

my $Usage = <<LIT;
$Myname: usage: $Myname
LIT


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


sub help
{
  print STDERR <<LIT;
$Usage
$Myname is ... [To Be Written]
LIT
  exit 1;
}


#  The lowest possible change level '...' could be in sync with
#
my $Minchange == 0;

#  The highest possible change level '...' could be in sync with
#
my $Maxchange = 0;

my @Outofheadsync;
my @Notpresent;

# option switch variables get defaults here...

my $P4 = "/auto/tools/bin/p4 -u p4";

#my $Valopt = "default";
my $Verbose = 0;
my $Showmax = 0;
my @Args;
my $Args;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-v")        { $Verbose = 1; shift; next; }
    elsif ($ARGV[0] eq "-a")     { $Showmax = 1; shift; next; }

#    elsif ($ARGV[0] eq "-valopt")
#      {
#        shift; if ($ARGV[0] < 0) { &usage; }
#        $Valopt = $ARGV[0]; shift; next;
#      }

    elsif ($ARGV[0] eq "-help")
      { &help; }
    elsif ($ARGV[0] =~ /^-/) { &usage; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }


#  
#  Note to the esteemed reader:
#  
#  This file is a quick-start template perl script, meant to make it
#  easy to get a new script off the ground. It's _also_ quite
#  possible, therefore, that you're looking at a *descendant* of
#  "perl_template", which might explain certain oddities. (E.g., code
#  with variable names like):
#
#    my $Valopt = "default";
#    my $Boolopt = 0;
#
#  (or other cruft that seems to have nothing to do with the task at
#  hand, or incomplete usage information, and so on. Different script
#  based hereupon will be finished to different levels of goodness,
#  depending on the intended purpose, lifetime, audience, my whims,
#  and the time available for applying a spit-shine.
#


my $Files;

if ($Args > 0)
  { &usage; }
elsif ($#Args == 0)
  { $Files = $Args[0]; }
else
  { $Files = "..."; }

#  OK, this got gruesome! We need this stuff for anding sets of ranges.
#  Here it is.
#

sub s_dump
{
  my($s) = @_;

  if ($Verbose) { print "["; }
  foreach my $c (@$s)
    {
      my ($min, $max) = @$c;
      if (! $Verbose)
        {
          if ($Showmax)
            { print "$max\n"; }
          else
            { print "$min\n"; }
          return;
       }

      print " ($min,$max) ";
    }
  if ($Verbose) { print "]\n"; }
}

sub max { my($a, $b) = @_; if ($a > $b) { return $a; } else { return $b; } }
sub min { my($a, $b) = @_; if ($a < $b) { return $a; } else { return $b; } }

sub s_and
{
  my($o, $n) = @_;

  my $r = (); # the result
  my ($oc, $nc, $rc);
  my ($omin, $omax, $nmin, $nmax);

#print "=====\n"; print "o "; &s_dump($o); print "n "; &s_dump($n);

  while (1)
    {
      if (! defined($nc) && ($#{$n} >= 0)) { $nc = shift(@$n); ($nmin, $nmax) = @$nc; }
      if (! defined($oc) && ($#{$o} >= 0)) { $oc = shift(@$o); ($omin, $omax) = @$oc; }

#print "CHUNKS oc = ($omin,$omax); nc = ($nmin,$nmax)\n";

      if (! defined($nc) || ! defined($oc)) { last; }

      #  OK, now we have two candidate chunks.
      #

      # Is there any overlap?
      #
      if ($omax < $nmin) { undef $oc; next; }
      if ($nmax < $omin) { undef $nc; next; }

#print "OVERLAP oc = ($omin,$omax); nc = ($nmin,$nmax)\n";
      
      $rc = (); @$rc = (&max($omin, $nmin), &min($nmax, $omax)); push(@$r, $rc);

#print "have "; &s_dump($r);

      if ($omax <= $nmax) { undef $oc; next; } else { undef $nc; next; }
      die;
    }

#print "\nreturning "; &s_dump($r);

  return $r;
}


#$o = ();
#$c = (); @$c = (30970, 30983); push(@$o, $c);
#
#$n = ();
#$c = (); @$c = (1,34589); push(@$n, $c);
#$c = (); @$c = (35209,30983); push(@$n, $c);
#$o = &s_and($o, $n);
#
#$n = ();
#$c = (); @$c = (15, 35); push(@$n, $c);
#$c = (); @$c = (65, 220); push(@$n, $c);
#$c = (); @$c = (230, 230); push(@$n, $c);
#$o = &s_and($o, $n);
#
#$n = ();
#$c = (); @$c = (1, 400); push(@$n, $c);
#$o = &s_and($o, $n);
#
#$n = ();
#$c = (); @$c = (17, 229); push(@$n, $c);
#$o = &s_and($o, $n);
#
#exit 0;


sub dofile
{
  my($depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev) = @_;

  if ($haveRev eq $headRev || $headAction eq "delete" && $haveRev eq "")
    {
      # This file is in headsync in this '...'.
      # So '...' *has* to be synced to a *least* this level.
      #
      if ($headChange > $Minchange) { $Minchange = $headChange; }
    }
  else
    {
      # This file is out of headsync in '...'!

      # Save the specs for later use (this is mainly so we can do a single
      # "p4 filelog" to get the log data for all of the out-of-headsync files
      # in one fell swoop, which is much more efficient).

      push(@Outofheadsync,
        "$depotFile\001$clientFile\001$headAction\001$headChange\001$headRev\001$haveRev");
      print FILES "$depotFile\n";
    }
  &resetfile;
}


if ($Verbose)
  { print "*** Phase   I: \"p4 fstat $Files\" and process files synced at the head.\n"; }

open(FSTAT, "$P4 fstat $Files 2>/dev/null |") || die;

my $Filestmp = "/usr/tmp/$Myname.tmp.$$";
my $Filelognptmp = "/usr/tmp/$Myname.np.tmp.$$";

sub unlink_tmps { unlink $Filestmp; unlink $Filelognptmp; }

open(FILES, ">$Filestmp") || die;


my $depotFile;
my $clientFile;
my $headAction;
my $headChange;
my $headRev;
my $haveRev;

sub resetfile
{
  $depotFile = "";
  $clientFile = "";
  $headAction = "";
  $headChange = "";
  $headRev = "";
  $haveRev = "";
}

&resetfile;
while (<FSTAT>)
  {
    if (/^$/) { &dofile($depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev); }
    if (/^\.\.\. depotFile (.*)$/)  { $depotFile = $1; }
    if (/^\.\.\. clientFile (.*)$/) { $clientFile = $1; }
    if (/^\.\.\. headAction (.*)$/) { $headAction = $1; }
    if (/^\.\.\. headChange (.*)$/) { $headChange = $1; }
    if (/^\.\.\. headRev (.*)$/)    { $headRev = $1; }
    if (/^\.\.\. haveRev (.*)$/)    { $haveRev = $1; }
  }
close FILES;

#print "\nMinchange $Minchange\n";
#print "Maxchange $Maxchange\n";

if ($Verbose)
  { print "*** Phase  II: \"p4 filelog\" and process files present in '$Files', not synced at the head.\n"; }

open(FILELOG, "$P4 -x $Filestmp filelog 2>/dev/null |") || die;
open(FILELOGNP, ">$Filelognptmp") || die;

my ($depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev);

my $nextchange;

while (<FILELOG>)
  {
    if (/^\/\//)
      {
	my $line = $_; chop $line;

        # adjust for files not in '...' at changelevels before add

	# This is the start of the next file's log.
        #
        my $info = shift(@Outofheadsync);
        ($depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev) = split(/\001/, $info);

        # OK, what about files we don't have in '...'?  These
        # would be in sync at any change before the first add (Rev
        # #1), or in any window of deletion. Once we've found the
        # (Min,Max) window for files we *do* have in '...', we
        # need to see whether there are *any* changes in this range at
        # which all non-present files are in sync. We can only do this
        # *after* we know the window... so we stash the info for
        # these, for now.

        if ($haveRev eq "") { push(@Notpresent, $info); print FILELOGNP; }
        if ($line ne $depotFile) { die "filelog mismatch <$line> vs. <$depotFile>"; }        
        $nextchange = 0;
      }
    elsif ($haveRev eq "") { print FILELOGNP; }
    elsif (/\.\.\.\ #([0-9]+) change ([0-9]+) ([a-z]+) /)
      {
        # A revision entry.
        #
        my $rev = $1; my $change = $2; my $action = $3;
        if ($rev eq $haveRev)
          {
            # This is the rev in '...' - adjust the (Min,Max) window!
            #
	    if ($nextchange && (! $Maxchange || $nextchange < $Maxchange))
              { $Maxchange = $nextchange; }
            if ($Minchange && $change > $Minchange) { $Minchange = $change; }
          }
        $nextchange = $change - 1;
      }

  }
close FILELOG;
unlink $Filestmp;
close FILELOGNP;

#print "\nMinchange $Minchange\n";
#print "Maxchange $Maxchange\n";

if (($Minchange && $Maxchange) && $Minchange > $Maxchange) 
  {
    if ($Verbose)
      { print "There is no solution\n"; }

#    print " At file $depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev\n";
#    print " Minchange [$Minchange] > Maxchange [$Maxchange]\n";
    &unlink_tmps;
    exit 1;
  }

if ($Minchange == 0) { $Minchange = 1; }
if ($Maxchange == 0) { $Maxchange = $Minchange; }

if ($Verbose)
  { print "*** Phase III: process files not synced at head and not present in '$Files'.\n"; }

# Now, the final pass to account for files not present in '$Files'

# An "s" is a list of chunks; each chunk is a lower and an upper bound.
#

#  The initial set is [ (Minchange,Maxchange) ]
#
my $o = ();
my $c = (); @$c = ($Minchange, $Maxchange); push(@$o, $c);

open(FILELOG, "<$Filelognptmp") || die;

my $n = undef;

while (<FILELOG>)
  {
    if (/^\/\//)
      {
        if ($#{$n} >= 0)
          {
            $o = &s_and($o, $n);
            if ($#{$o} < 0)
              {
                if ($Verbose) { print "There is no solution\n"; }
                &unlink_tmps;
                exit 1;
              }
          }
	my $line = $_; chop $line;

	# This is the start of the next file's log.
        #
        my $info = shift(@Notpresent);
        ($depotFile, $clientFile, $headAction, $headChange, $headRev, $haveRev) = split(/\001/, $info);
        if ($line ne $depotFile) { die "filelog mismatch <$line> vs. <$depotFile>"; }        
        $nextchange = 0;
        $n = ();
      }
    elsif (/\.\.\.\ #([0-9]+) change ([0-9]+) ([a-z]+) /)
      {
        # A revision entry.
        #
        my $rev = $1; my $change = $2; my $action = $3;
        if ($action eq "delete")
          {
            # This gives us a range of changes at which this file is deleted from the view.
            #
            if ($nextchange == 0)
              {
		# We're deleted at the head, so, for the upper bound on this range,
                # We'll use the highest change number presently in the $o set.
                #
                $nextchange = ${${$o}[$#{$o}]}[1];
              }

	    #  Check to make sure that this change is even in the the exiting range
            #  before folding it in...
            #
	    if ($change <= $nextchange) { $c = (); @$c = ($change, $nextchange); unshift(@$n, $c); }
          }
        elsif ($rev == 1)
          { $c = (); @$c = (1, $change-1); unshift(@$n, $c); }

        $nextchange = $change - 1;
      }
  }
close FILELOG;
unlink $Filestmp;

if ($#{$n} >= 0)
  {
    $o = &s_and($o, $n);
    if ($#{$o} < 0)
      { if ($Verbose) { print "There is no solution\n"; } &unlink_tmps; exit 1; }
  }

#  Now, adjust for the case where Maxchange is the most recent change
#  to '...' (i.e., *ANY* changelevel > Maxchange would also get you a
#  correct client)...
#
my $mostrecent = `$P4 changes -m 1 $Files 2>/dev/null`;
if ($mostrecent =~ /^Change ([0-9]+) /)
  {
    my $mostrecent_change = $1;
    my $last_range = ${$o}[$#{$o}];
    my $last_max = $$last_range[1];
    if ($last_max == $mostrecent_change)
      {
        my $last = `$P4 changes -m 1 2>/dev/null`;
        if ($last =~ /^Change ([0-9]+) /)
          { $$last_range[1] = $1; }
      }
  }

if ($Verbose)
  { print "The set of change levels describing the state of '$Files' in this client is:\n"; }

&s_dump($o);

&unlink_tmps;