#!/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 = <= 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 (($headAction eq "delete" && $haveRev eq "") || ($haveRev eq $headRev)) { # 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 () { 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 '...', 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 () { 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 '...'.\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 () { 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;