- #!/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;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#2 | 5156 | Richard Geiger | (Manually integrates a change to the DD version:) This change fixes a bug qhich prevented... correct operation when an argument is given to override the default "..." scope. It also tweaks the -v messages to account for such an argument. « |
19 years ago | |
#1 | 4956 | Richard Geiger | This is //tools/main/toolsbin/p4_synced_at#1 in the Data Domain depotdom. Just plopping i...t here for reference by anybody with an interest. « |
20 years ago |