syncedat #2

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

#  perl_template - please see the comment at the end!

#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

use Carp;
use strict;
$| = 1;

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

my $Usage = <<LIT;
$Myname: usage: $Myname [-v]
LIT


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


sub help
{
  print STDERR <<LIT;
$Usage

With "-v", option, the output is somewhat verbose.

$Myname determines what change level a Perforce workspace (or subset
thereof) is synced to.

In most cases, the technique described in

  Perforce Tech Note 051: What changelist is my workspace synced to?
  http://www.perforce.com/perforce/technotes/note051.html

will yield the right answer, but there are a couple of significant
exceptions;

 1) If the latest changelist affecting the client is purely deletes,
    it will not be considered to "affect any file in the workspace",
    and hence will _not_ be reflected in the answer you get.

 2) It's quite possible for a workspace to not *be* in sync to some
    single change - i.e., for there not to -be- any correct answer;
    however, the technique shown in Tech Note 051 won't detect this,
    and will always yield an answer, even if a wrong answer.
  
If you are using the technique in Tech Note 051, you might want to
get in the habit of always checking the answer it gives, "p4 sync -n
@<changelist>"; if the system indicates that any files would be
synced, you know the answer was bogus because of (1) or (2).

This script, while much more compute intensive on the client machine,
will handle the corner cases listed above. 

LIT
  exit 1;
}


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

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

my @Outofheadsync;
my @Notpresent;

# option switch variables get defaults here...

#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.
#

# dump a set of ranges
#
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); # DEBUG

  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"; # DEBUG

      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"; # DEBUG
      
      $rc = (); @$rc = (&max($omin, $nmin), &min($nmax, $omax)); push(@$r, $rc);

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

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

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

  return $r;
}


# a small "test suite" for the s_* functions:

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

#print "depotFile <$depotFile> "; # DEBUG

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

      # This file is out of headsync in the workspace!

      # 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; # "NP" == "Not Present"

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

my $nextchange;

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

        # adjust for files not in the workspace 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 any rev of?  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 the workspace, 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;
      }

    # Collect the entire filelog entry for "not present" files in the
    # temp file:
    #
    elsif ($haveRev eq "") { print FILELOGNP; }
    
    # Otherwise, look for the filelog info on the rev we have:
    #
    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 we have in the workspace; 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"; # DEBUG 
#print "Maxchange $Maxchange\n"; # DEBUG 

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 '...'.\n"; }

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

# 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 ... 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 '...' in this client is:\n"; }

&s_dump($o);

&unlink_tmps;