1# -*-perl-*- 2# 3# Copyright (c) 1996 Network Appliance, Inc. 4# Copyright (c) 2002 PiroNet NDH AG 5# 6# You may distribute under the terms of the Artistic License, as 7# specified in the README file included in the cvslines 8# distribution. 9# 10# Original Author: Richard Geiger for Network Appliance, Inc. 11# Adaption to cvs >=1.11 by Juergen Jatzkowski and Ingo Rockel 12# 13# $Id: cvslines-check,v 1.2 2002/04/19 13:26:39 irockel Exp $ 14 15# This file is used by "cvslines". 16# It is not intended for standalone execution. 17 18# Notes: 19# 20# - We never try to change updates to branch tags that would create a 21# new RCS branch to check-ins on the tip of an existing RCS branch, 22# even when there are no apparent instances of lines with revisions 23# on the tip of the existing branch. This would seem to reduce 24# unnecessary RCS branching, but we have no assurance that some 25# other line that's not active in the cvslines.config file is 26# sitting on the tip of the existing branch. Also, I can't imagine 27# how the tree would have gotton ito this state in the first place, 28# if nothing really occupies the existing branch. 29# 30# - We *do* special-case the situation where a file was added via a 31# cvs import command, and a branched line was created before any 32# local commits have been done. In this case, the file is really 33# undiverged, though it looks to CVS as if it has (i.e., the 34# current rev for a head would be "1.1", but for undiverged 35# branched would be "1.1.1.1". We detect this case, and spoof CVS 36# as if the branch tage was "1.1.0.2", so that we can forstall 37# divergence if the update should also be applied to the head. This 38# also has the effect of having commits that *aren't* wanted on the 39# head being commited to "1.1.2.1" (etc), rather than the (uglier) 40# "1.1.1.1.2.1". You'll still get the uglies if the head has 41# advanced beyond "1.1", but I don't want the extra complication of 42# trying to spoof that at this point. 43# 44 45$Logfrom = "check"; 46 47sub sticky_load 48{ 49 my $line; 50 my $ans; 51 52 if (! open(STICKY, "<$Stickyans")) 53 { $Stickyans = ""; } # revery to unsticky mode 54 else 55 { 56 while (<STICKY>) 57 { 58 chop; 59 ($line, $ans) = split(/ /, $_); 60 $Stickyans{$line} = $ans; 61 } 62 close STICKY; 63 } 64} 65 66 67sub sticky_store 68{ 69 my $line; 70 71 if (! open(STICKY, ">$Stickyans")) 72 { 73 print TTYO "$Mynamebase: can't write \"$Stickyans\": $!\n"; 74 if (! unlink($Stickyans)) 75 { 76 print TTYO "$Mynamebase: can't remove \"$Stickyans\": $!\n"; 77 return 1; 78 } 79 } 80 else 81 { 82 foreach $line (sort(keys(%Stickyans))) 83 { print STICKY "$line $Stickyans{$line}\n"; } 84 close STICKY; 85 } 86} 87 88 89sub is_branch 90{ 91 my ($rev) = @_; 92 return $rev =~ /\.0\.[0-9]+$/; 93} 94 95 96# Given a branch tag revision, return the RCS branch number 97# for revisions on the branch. 98# 99sub branch_t 100{ 101 my ($rev) = @_; 102 $rev =~ /^(.+)\.0\.([0-9]+)$/; 103 $rev = "$1.$2"; 104} 105 106 107# Given an RCS revision, return its branch number. 108# 109sub branch 110{ 111 my ($rev) = @_; 112 $rev =~ s/\.[0-9]+$//; 113 return $rev; 114} 115 116 117sub nextrev 118{ 119 my ($specrev) = @_; 120 my $base; 121 my $rev; 122 123 if ($specrev =~ /^(.+)\.0\.([0-9]+)$/) 124 { 125 $base = "$1.$2"; $rev = "1"; 126 while (defined($RCS_Revs{"$base.$rev"})) { $rev++; } 127 return "$base.$rev"; 128 } 129 elsif ($specrev =~ /^(.+)\.([0-9]+)$/) 130 { 131 $base = $1; $rev = $2; $rev++; 132 return "$base.$rev"; 133 } 134 else 135 { ¬eNbail("nextrev(): internal error: malformed \$specrev \"$specrev\"."); } 136} 137 138# This was added after converting all 139# 140# foreach $line_name (keys(%state)) 's to 141# foreach $line_name (@CVS_lines) 's 142# 143# The latter is preferred, because the order in which the lines will 144# be processed is deterministic (according to the order in which they 145# appear in the cvslines.config file). 146# 147# I added this assertion just to help convince myself that they 148# really are equivalent. The assert can be removed at some point 149# if we've never tripped it and are concerned about performance. 150# 151sub assert_keys 152{ 153 my @K, @L; 154 my $k, $l; 155 156 @K = sort(keys(%state)); 157 @L = sort(@CVS_Lines); 158 159 if ($#K != $#L) { die "assert_keys number K = $#K L = $#L"; } 160 161 while ($#K) 162 { 163 $k = pop(@K); $l = pop(@L); 164 if ($k ne $l) { die "assert_keys value k =<$k> l =<$l>"; } 165 } 166} 167 168 169# This is a debug aid... 170# 171sub dump_state 172{ 173 print TTYO "\n========== states:\n"; 174 &assert_keys; 175 foreach $line_name (@CVS_Lines) 176 { print TTYO " $line_name :: $state{$line_name}\n"; } 177 print TTYO "\n\n"; 178} 179 180 181sub notify_re_tagswap 182{ 183 my ($this_rev) = @_; 184 my $this_branch = $this_rev; 185 186 $this_branch =~ s/\.[0-9]+$//; 187 188 print TTYO <<LIT; 189 190NOTE: 191 192 This check-in would normally (i.e., without $Mynamebase) cause a 193 new RCS branch to be created. 194 195 But, since you also want to apply the revision to all the other 196 non-branched lines that share revision "$this_rev", it will be 197 better to apply the change as a new revision to the "$this_branch" 198 branch, and then update the branch tags for other lines. This will 199 help minimize actual divergence for this file in lines that don't 200 need to diverge yet. This is reflected in the commit plan shown 201 below. 202LIT 203} 204 205 206# Any parameters from cvslines-commit must be passed through the 207# environment, 'cause of the cvs commitinfo interface. 208# 209$Verbose = $ENV{"CVSLINES_VERBOSE"}; 210$Noconfirm = $ENV{"CVSLINES_NOCONFIRM"}; 211$Showall = $ENV{"CVSLINES_SHOWALL"}; 212$Stickyans = $ENV{"CVSLINES_STICKYANS"}; 213$Nolgroups = $ENV{"CVSLINES_NOLGROUPS"}; 214 215# See if we're disabled (used by cvslines_commit to guard against 216# rechecks, or by users who want us to step aside). 217# 218if (defined($ENV{"CVSLINES_NOCHECK"})) 219 { 220 &log("CVSLINES_NOCHECK"); 221 exit 0; 222 } 223 224$here = `/bin/pwd`; chop $here; 225 226if (! &openTTY()) 227 { 228 &log("&openTTY() failed"); # assume it's from a remote checkin 229 exit 0; 230 } 231 232if (! &module_config($here)) 233 { ¬eNbail("no $Mynamebase.config file for this commit."); } 234 235$CVS = "$here/CVS"; 236 237# Check the interlock that insures the user is running via 238# "$Mynamebase commit"... 239# 240if (! defined($ENV{"CVSLINES_PHASE0"})) 241 { 242 if ($Users{$Username} eq "off") { exit 0; } 243 if (! ($Users{ALL} eq "on" || $Users{$Username} eq "on")) { exit 0; } 244 245 print TTYO <<LIT; 246$Mynamebase: 247 248 Commits for this module should be done via the "$Mynamebase commit" 249 command. 250 251 To force a "cvs commit" command from this module without $Mynamebase 252 commit checks, run cvs with \$CVSLINES_NOCHECK set in the environment. 253 254LIT 255 exit 1; 256 } 257 258 259# Check for .disable file... 260# 261if (-f $Configpath_Disable) 262 { 263 system("/bin/cat $Configpath_Disable"); 264 exit 1; 265 } 266 267 268if (defined($ENV{"CVSLINES_BATSEL"})) 269 { 270 my $def; 271 my $exc; 272 my @batsellines; 273 my $batsel; 274 my $line; 275 my $excline; 276 277 $Batsel = 1; 278 $batsel = $ENV{"CVSLINES_BATSEL"}; 279 280 # Now make sure any names lines are valid & set up %Select_ans 281 # 282 if ($batsel =~ /^-all/) 283 { 284 $batsel =~ s/^-all-{0,1}//; 285 $def = "y"; $exc = "n"; 286 @batsellines = split(/-/, $batsel); 287 } 288 elsif ($batsel =~ /^-only/) 289 { 290 $batsel =~ s/^-only\+{0,1}//; 291 $def = "n"; $exc = "y"; 292 @batsellines = split(/\+/, $batsel); 293 } 294 else { die "$Mybasename: internal error: bad CVSLINES_BATSEL value \"$batsel\"." } 295 296 foreach $line (@batsellines) 297 { 298 if (! defined($CVS_Lines_Spec{$line})) 299 { 300 print TTYO "$Mynamebase: unknown line \"$line\".\n"; 301 exit 1; 302 } 303 } 304 305 foreach $line (@CVS_Lines) 306 { 307 $Select_ans{$line} = $def; 308 foreach $excline (@batsellines) 309 { if ($excline eq $line) { $Select_ans{$line} = $exc; } } 310 } 311 } 312else 313 { 314 $Batsel = 0; 315 if ($Stickyans) { &sticky_load; } 316 } 317 318 319# option/arg processing 320# 321if ($#ARGV < 1) { &usage; } 322 323$dir = $ARGV[0]; shift; 324@files = @ARGV; 325 326if (defined($ENV{"CVSLINES_REM"})) 327 { $Remplan = 1; } 328else 329 { $Remplan = 0; } 330 331$rev = "$Revision: 1.2 $_"; 332$rev =~ s/: //; $rev =~ s/ .*//; 333 334($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 335 = localtime(time); 336$mon++; 337 338$cmds = sprintf("# $Mynamebase $rev $here %d/%d/%d %02d:%02d:%02d\n", 339 $mon, $mday, $year, $hour, $min, $sec); 340 341$some_but_not_all = <<LIT; 342In this case, the line(s) that should not get the revision should 343probably be moved onto a branch before applying this revision. 344 345This is a significant operation, which must be applied to all of the 346files in the module. Please consult with Release Engineering before 347proceeding with these changes. 348LIT 349 350$some_but_not_all_msg = <<LIT; 351 352$Mynamebase: problem: 353 354You have indicated that you want some, but not all, of the 355non-branched lines on branch "%s" to get this revision. 356 357$some_but_not_all 358LIT 359 360 361$some_but_not_all_spec_msg = <<LIT; 362 363$Mynamebase: problem: 364 365You have indicated that you want some, but not all, of the 366lines currently specified by "%s" to get this revision. 367 368$some_but_not_all 369LIT 370 371foreach $file (@files) 372 { 373 # Reset all those pesky globals here! 374 # 375 undef %state; 376 undef %CVS_Spoofed; 377 undef %Lines_On_Rev; 378 undef $RCS_Valid; 379 undef %RCS_Tags; 380 undef %RCS_Branchtags; 381 undef %RCS_Revs; 382 undef $RCS_Branch; 383 undef %RCS_Texts; 384 385 $filecmds = "\npath $here/$file\n"; 386 387 &set_Ent($file); 388 389 if ($Verbose || (! $Batsel)) 390 { 391 print TTYO "\n$Mynamebase: making commit plan for:\n". 392 " file: $here/$file\n cvs info: $Ent_Rev/$Ent_Time/$Ent_Opts/$Ent_Tag\n"; 393 } 394 395 &log("$here/$file: $Ent_Rev/$Ent_Time/$Ent_Opts/$Ent_Tag"); 396 397 $this_line = "?"; 398 399 foreach $line_name (@CVS_Lines) 400 { 401 402 ($spec, $state, $specrev) = &setspecs($line_name); 403 if ($spec ne $Ent_Tag) { next; } 404 405 # If > 1 lines match, we need resolution... 406 # 407 if ($this_line ne "?") 408 { $this_line = &this_line_resolve(); last; } 409 410 $this_line = $line_name; 411 } 412 if ($this_line eq "?") 413 { ¬eNbail("problem: couldn't determine this_line for \"$file\"."); } 414 415 $this_lgroup = $CVS_Lines_Lgroups{$this_line}; 416 417 # set up the RCS revs information for this file... 418 # 419 if (&set_RCS_revs($CVS_Repository, $file, 0, 1) 420 && (! &set_RCS_revs($CVS_Repository, $file))) 421 { ¬eNbail("couldn't set RCS revision information for \"$here/$file\""); } 422 423 if (1) 424 { 425 # I had put this in to spoof CVS away from creating a branch 426 # off of the vendor release branch when adding a file to a 427 # local branch, in the spirit of "minimize branching". 428 # 429 # Is it time to play CVS spooferino? 430 # 431 432 # Note: we don't do lgroups-exclusion here, since applying 433 # the spoof should be orthogonal to anything else we do 434 # below... 435 436 foreach $line_name (@CVS_Lines) 437 { 438 ($spec, $state, $specrev) = &setspecs($line_name); 439 $currev = &rev_on_line($spec); 440 441 if ( 442 ($specrev =~ /\.0\.([0-9]+)$/) 443 && (! defined($RCS_Revs{&branch_t($specrev).".1"})) 444 && ($RCS_Texts{$currev} eq "") 445 && (&branch($currev) eq $RCS_Branch) 446 ) 447 { 448 # Pretend that $specrev is an undiverged branch on the 449 # root point of the default branch 450 # 451 $nextry = 2; 452 453 ($br = $RCS_Branch) =~ s/.[0-9]+$//; 454 455 while (defined($RCS_Branchtags{"$br.0.$nextry"})) 456 { $nextry += 2; } 457 458 $RCS_Tags{$spec} = "$br.0.$nextry"; 459 $CVS_Spoofed{$line_name} = 1; 460 } 461 } 462 } 463 464 465 if ($Ent_Rev eq "0") 466 { 467 # This file has been scheduled for addition... 468 # 469 $this_rev = "new"; 470 $this_branch = "new"; 471 472 # What the new head rev would be; "M.n", where "M" is the 473 # same as the highest major revision number of any other file 474 # known to CVS_Entries. (And "n" is the first available minor 475 # number) At least, that's what the cvs source appears to do! 476 # 477 undef $max_rev; undef $E_rev; undef $E_name; 478 $max_rev = 1; 479 foreach $Entry (@CVS_Entries) 480 { 481 ($dummy, $E_name, $E_rev) = split(/\//, $Entry); 482 $E_rev =~ s/\..*//; 483 if ($E_rev > $max_rev) { $max_rev = $E_rev; } 484 } 485 $n_try = 1; 486 while (1) 487 { 488 $n_try_rev = "$max_rev.$n_try"; 489 if (! defined($RCS_Revs{$n_try_rev})) { last; } 490 $n_hi_rev = $n_try_rev; 491 $n_try++; 492 } 493 $this_newrev = $n_try_rev; 494 495 # What the new branch rev would be. Wholly new files will 496 # commit to "1.1.{2,4,6,...}.1" branched from a stub 1.1 497 # (appears to be what cvs does, based on experimentation). 498 # 499 # If the file already exists, new branches will be started at 500 # the first available branch point off of the current head. 501 # 502 if (! $RCS_Valid) 503 { 504 # this is the first ever commit for this file, any line 505 # 506 $this_newbranch = "1.1.2.1"; 507 } 508 else 509 { 510 # If we get here, then we know we have the RCS revs info 511 # from above... 512 # 513 $n_try = 2; 514 while (1) 515 { 516 $n_try_rev = "$n_hi_rev.$n_try.1"; 517 if (! defined($RCS_Revs{$n_try_rev}) 518 && ! defined($RCS_Branchtags{"$n_hi_rev.0.$n_try"})) 519 { last; } 520 $n_try += 2; 521 } 522 $this_newbranch = $n_try_rev; 523 } 524 525 if ($CVS_Tag eq "head") 526 { $this_on_branch = 0; } else { $this_on_branch = 1; } 527 } 528 else 529 { 530 # OK, get some general information about the rev we're working on 531 # in the working tree... $this_* variables refer to this one. 532 # 533 ($spec, $state, $specrev) = &setspecs($this_line); 534 535 if (&is_branch($specrev)) 536 { $this_on_branch = 1; } else { $this_on_branch = 0; } 537 538 $this_rev = &rev_on_line($spec); 539 540 if ($this_rev !~ /^(.+)\.([0-9]+)$/) 541 { ¬eNbail("problem: internal error: malformed \$specrev \"$specrev\"."); } 542 $this_branch = &branch($this_rev); 543 } 544 545 # when we get here, we have... 546 # 547 # $this_line 548 # $this_rev 549 # $this_branch 550 # $this_lgroup 551 # 552 # if $this_rev = "new", we also have... 553 # 554 # $this_newrev 555 # $this_newbranch 556 # $this_on_branch 557 # 558 559 # Summary headings... 560 # 561 562 if ($Verbose) 563 { 564 printf TTYO "\n"; 565 printf TTYO " $Fmt\n", "line", "spec", " ", "spec rev", "cur rev"; 566 printf TTYO " $Fmt\n", $D_Line, $D_Spec, " ", $D_Specrev, $D_Currev; 567 } 568 569 $stsmsg = ""; 570 571 # Keep track of whether all lines sharing a given specrev want 572 # the change (or not). 573 # 574 undef %linespec_wants; 575 undef %linespec_nowants; 576 577 foreach $line_name (@CVS_Lines) 578 { 579 ($spec, $state, $specrev) = &setspecs($line_name); 580 581 if ($line_name eq $this_line) { $linespec_wants{$spec} = 1; } 582 583 $currev = &rev_on_line($spec); 584 585 if ($this_rev eq "new") 586 { 587 if ((! $Nolgroups) && $CVS_Lines_Lgroups{$line_name} ne $this_lgroup) 588 { 589 $state{$line_name} = "n"; 590 if (! $Showall) { $linespec_nowants{$spec} = 1; next; } 591 $stsmsg .= "xx "; 592 } 593 elsif ($line_name eq $this_line) 594 { 595 $stsmsg .= ">> "; 596 $state{$line_name} = "c"; 597 $curbranch &branch($this_newrev); 598 } 599 elsif ($currev eq "none") 600 { 601 $stsmsg .= "a? "; 602 $state{$line_name} = "a?"; 603 $curbranch &branch($this_newbranch); 604 } 605 else 606 { 607 $stsmsg .= " "; 608 $state{$line_name} = "n"; 609 } 610 611 $stsmsg .= sprintf("$Fmt\n", $line_name, $spec, " ", "(none)", "(none)"); 612 next; 613 } 614 615 $curbranch = &branch($currev); 616 617 if ((! $Nolgroups) && $CVS_Lines_Lgroups{$line_name} ne $this_lgroup) 618 { 619 $state{$line_name} = "n"; 620 if (! $Showall) { $linespec_nowants{$spec} = 1; next; } 621 $stsmsg .= "xx "; 622 } 623 elsif ($line_name eq $this_line) 624 { 625 $stsmsg .= ">> "; 626 $state{$line_name} = "c"; 627 } 628 elsif ($currev eq $this_rev) 629 { 630 $stsmsg .= "u? "; 631 $state{$line_name} = "u?"; 632 } 633 elsif ($specrev ne "none") 634 { 635 $stsmsg .= "m? "; 636 $state{$line_name} = "m?"; 637 } 638 else 639 { 640 $stsmsg .= " "; 641 $state{$line_name} = "n"; 642 } 643 644 if ($CVS_Spoofed{$line_name}) { $spoofed = "*"; } else { $spoofed = " "; } 645 $stsmsg .= sprintf("$Fmt\n", $line_name, $spec, $spoofed, $specrev, $currev); 646 if (defined($Lines_On_Rev{$currev})) 647 { $Lines_On_Rev{$currev} .= " $line_name"; } else { $Lines_On_Rev{$currev} = $line_name; } 648 } 649 650 if ($Verbose) { print TTYO $stsmsg; &log($stsmsg); } 651 652 # OK, see if they want these changes to go into any other lines... 653 # 654 $headed = 0; 655 656 $selmsg = "user-selections:\n"; 657 &assert_keys; 658 foreach $line_name (@CVS_Lines) 659 { 660 if ($state{$line_name} =~ /^[aum]\?/) 661 { 662 if (! $Batsel) 663 { 664 if ($Stickyans && defined($Stickyans{$line_name})) 665 { $ans = $Stickyans{$line_name}; } 666 else 667 { 668 if (! $headed) 669 { 670 if ($this_rev eq "new") 671 { print TTYO "\nShould this file be included in...\n"; } 672 else 673 { print TTYO "\nShould these changes also be applied to...\n"; } 674 $headed = 1; 675 } 676 677 $def = "n"; 678 679 # Check for option defaulting this to "y"... 680 # 681 @opts = split(/,/, $CVS_Lines_Opts{$this_line}); 682 if (grep(/^\+$line_name$/, @opts)) { $def = "y"; } 683 $ans = &ask(sprintf(" %-10s", $line_name), $def, "y", "n"); 684 } 685 } 686 else 687 { $ans = $Select_ans{$line_name}; } 688 689 $selmsg .= "$line_name?$ans\n"; 690 ($spec, $state, $specrev) = &setspecs($line_name); 691 692 if ($ans eq "y") 693 { 694 $state{$line_name} =~ s/\?//; 695 $linespec_wants{$spec} = 1; 696 if ($Stickyans) { $Stickyans{$line_name} = "y"; } 697 } 698 else 699 { 700 $state{$line_name} = "n"; 701 $linespec_nowants{$spec} = 1; 702 if ($Stickyans) { $Stickyans{$line_name} = "n"; } 703 } 704 } 705 } 706 &log($selmsg); 707 708 if ($Stickyans) { &sticky_store; } 709 710 # Look for cases where not all lines sharing a specrec want the 711 # change... 712 # 713 foreach $line_name (@CVS_Lines) 714 { 715 ($spec, $state, $specrev) = &setspecs($line_name); 716 if ($linespec_wants{$spec} && $linespec_nowants{$spec}) 717 { 718 printf TTYO $some_but_not_all_spec_msg, $spec; 719 &log("needs branching"); 720 exit 1; 721 } 722 } 723 724 if ($this_rev eq "new") 725 { 726 undef $newrev; 727 728 # First, make sure that if some on the head want it, 729 # all do... 730 # 731 &assert_keys; 732 foreach $line_name (@CVS_Lines) 733 { 734 if ($state{$line_name} eq "n") { next; } 735 ($spec, $state, $specrev) = &setspecs($line_name); 736 737 if ($spec eq "head") 738 { $newrev = $this_newrev; } 739 else 740 { if (! defined($newrev)) { $newrev = $this_newbranch; } } 741 } 742 743 &assert_keys; 744 foreach $line_name (@CVS_Lines) 745 { 746 if ($state{$line_name} eq "n") { next; } 747 ($spec, $state, $specrev) = &setspecs($line_name); 748 749 if ($newrev eq $this_newrev) 750 { 751 if ($spec eq "head") 752 { 753 if ($line_name eq $this_line) 754 { $state{$line_name} = "c:$newrev"; } 755 else 756 { $state{$line_name} = "i:$newrev"; } 757 } 758 else 759 { $state{$line_name} = "a:$newrev"; } 760 } 761 else 762 { 763 if ($line_name eq $this_line) 764 { $state{$line_name} = "c:$newrev"; } 765 else 766 { $state{$line_name} = "a:$newrev"; } 767 } 768 } 769 770 goto plan_for_new; 771 } 772 773#&dump_state(); 774 775 # Now construct the set of unique RCS revisions that want this 776 # mod, in $want_revs... 777 778 undef %want_revs; 779 780 &assert_keys; 781 foreach $line_name (@CVS_Lines) 782 { 783 if ($state{$line_name} eq "n") { next; } 784 ($spec, $state, $specrev) = &setspecs($line_name); 785 786 if ($this_rev eq "new") 787 { 788 if ($spec eq "head") 789 { $currev = $this_newrev; } 790 else 791 { $currev = $this_newbranch; } 792 } 793 else 794 { $currev = &rev_on_line($spec); } 795 if (! defined($want_revs{$currev})) 796 { $want_revs{$currev} = $line_name; } 797 else 798 { $want_revs{$currev} .= " $line_name"; } 799 } 800 801 # OK, now we need to decide what actions to take for each line 802 # in each want_rev. 803 # 804#&dump_state(); 805 806 foreach $rev (keys(%want_revs)) 807 { 808#print TTYO "====== rev<$rev>\n"; 809 810 # makes it easy to tell whether a given lines wants this rev 811 # 812 undef %wanters; 813 814 undef $next_rev; undef $next_branch_rev; 815 816 $wanter_lines = $want_revs{$rev}; 817 @wanter_lines = split(/ /, $wanter_lines); 818 819 # Build $wanters{} 820 # 821 foreach $wanter_line (@wanter_lines) 822 { $wanters{$wanter_line} = 1; } 823 824 # Now, we want to know what the potential next and 825 # newly branched revs would would be for this rev... 826 827 828 if ($this_rev eq "new") 829 { 830 $next_rev = $this_newrev; 831 $next_branch_rev = $this_newbranch; 832 } 833 else 834 { 835 $next_rev = &nextrev($rev); 836 837 undef $min_branch_n; 838 839 # Now, if any specs are undiverged branch revs, we need to 840 # set next_branch_rev appropriately... 841 # 842 foreach $wanter_line (@wanter_lines) 843 { 844 ($spec, $state, $specrev) = &setspecs($wanter_line); 845 if ($specrev =~ /^(.+)\.0\.([0-9]+)$/) 846 { 847#print TTYO "WANTER LINE BRANCHTAG <$wanter_line><$specrev> rev<$rev>\n"; 848 $n = $2; 849 # ...it's a branch rev spec... 850 if ($rev !~ /^$1.$2.[0-9]+$/) 851 { 852#print TTYO "NOT BRANCHED!\n"; 853 # ...and it is not branched. (We know this, 854 # beacause the $rev we're looking at is not on 855 # the indicated branch!) 856 # 857 if (!defined($min_branch_n) || $n < $min_branch_n) 858 { $min_branch_n = $n; } 859 } 860 } 861 } 862 863 if (defined($min_branch_n)) 864 { $next_branch_rev = "$rev.$min_branch_n.1"; } 865 else 866 { } # ??? anything for $next_branch_rev? 867 } 868#print TTYO "NEXT_REV <$next_rev> NEXT_BRANCH_REV <$next_branch_rev>\n"; 869 870 # Next, we look at which lines want what, to determine whether 871 # we're hosed (need to branch an unbranched line), we can 872 # check in to the $next_rev (and update any undiverged branch 873 # tags), or need to check in to a newly diverged branch (and 874 # update other branch tags if necessary). 875 # 876 877 # This needs to see lines that are on this rev, but don't 878 # want it, hence this needs to be a separate loop from the 879 # above! 880 # 881 882 $nb_wanting = 0; # number that are not undiverged branches that want it 883 $nb_not_wanting = 0; # number that are not undiverged branches that don't want it 884 $b_wanting = 0; # number that are undiverged branches that want it 885 $b_not_wanting = 0; # number that are undiverged branches that don't want it 886 887 $lines = $Lines_On_Rev{$rev}; # Going to look at all lines on this rev 888 889 @lines = split(/ /, $lines); 890 foreach $line_name (@lines) 891 { 892 893#print TTYO "line_name <$line_name>\n"; 894 895 ($spec, $state, $specrev) = &setspecs($line_name); 896 897 $b = 0; 898 # Are we a "non-branched" line? 899 # 900 if ($specrev =~ /^(.+)\.0\.([0-9]+)$/) 901 { 902 # We're a branch rev spec... 903 if ($rev !~ /^$1.$2.[0-9]+$/) 904 { $b = 1; } 905 } 906 907 if ($b) 908 { 909 if (defined($wanters{$line_name})) 910 { $b_wanting++; } else { $b_not_wanting++; } 911 } 912 elsif (defined($wanters{$line_name})) 913 { $nb_wanting++; } else { $nb_not_wanting++; } 914 915 } 916 917#print TTYO "\$#lines = <$#lines>\n"; 918#print TTYO "nb_wanting<$nb_wanting> nb_not_wanting<$nb_not_wanting>\n"; 919#print TTYO "b_wanting<$b_wanting> b_not_wanting<$b_not_wanting>\n"; 920 921 if ($nb_wanting > 0 && $nb_not_wanting > 0) 922 { 923 my $branch; 924 ($branch = $rev) =~ s/.[0-9]+$//; 925 printf TTYO $some_but_not_all_msg, $branch; 926 &log("needs branching"); 927 exit 1; 928 } 929 930 # OK, we get here with enough information to know where the 931 # commit for this $rev should go... 932 # 933 if ($nb_wanting) 934 { $new_rev = $next_rev; } else { $new_rev = $next_branch_rev; } 935 936#print TTYO "nb_wanting<$nb_wanting> NEW REV <$new_rev>\n"; 937 938 # OK, now figure out what to do with each line that wants it 939 # 940 foreach $wanter (@wanter_lines) 941 { 942 $state = $state{$wanter}; 943 944 ($spec, $devstate, $specrev) = &setspecs($wanter); 945#print TTYO "WANTER <$wanter> state<$state> spec<$spec> spcrev<$specrev>\n"; 946 947 $b = 0; 948 # Are we an undiverged "branch tag" line? 949 # 950 if ($specrev =~ /^(.+)\.0\.([0-9]+)$/) 951 { 952 # We're a branch rev spec... 953 if ($rev !~ /^$1.$2.[0-9]+$/) 954 { $b = 1; } 955 } 956 957 if ($state =~ /^[cu]/) 958 { 959 # Apparently, not required: 960 961 # if ($b && ($nb_wanting + $nb_not_wanting) == 0) 962 # if ($b && $nb_wanting) 963 # { 964 # $state{$wanter} = "T:$next_rev"; 965 # next; 966 # } 967 968 if (&nextrev($specrev) eq $new_rev) 969 # Then this line's action is a commit... 970 { 971 if ($state =~ /^c/) 972 { $state{$wanter} = "c:$new_rev"; } 973 else 974 { $state{$wanter} = "i:$new_rev"; } 975 } 976 else 977 # Then this lines's action is a branch tag update 978 { 979 if ($state =~ /^c/ && $nb_wanting > 0 && $Verbose) 980 { ¬ify_re_tagswap($rev); } 981 $state{$wanter} = "t:$new_rev"; 982 } 983 next; 984 } 985 986 if ($state =~ /^m/) 987 { 988 if (&nextrev($specrev) eq $new_rev) 989 { $state{$wanter} = "m:$new_rev"; } 990 else 991 { $state{$wanter} = "t:$new_rev"; } 992 next; 993 } 994 995 print TTYO "$Mynamebase: internal error: unexpected state \"$state\"."; 996 exit 1; 997 } 998 } 999 1000#print TTYO "\n 111\n"; 1001#&dump_state(); 1002 1003# { . { . { . { . { . { 1004 1005 1006 # OK, are any "i"'s really "c"'s? 1007 # 1008 # First, note any "this commit" revision we have slated... 1009 # (there can only be one!) 1010 # 1011 undef $this_commit_rev; 1012 &assert_keys; 1013 foreach $line_name (@CVS_Lines) 1014 { 1015 if ($state{$line_name} =~ /^c:(.+)$/) 1016 { 1017 $this_commit_rev = $1; 1018 last; 1019 } 1020 } 1021 1022 # OK, now convert any "i:$this_commit_rev"s to "c"s... 1023 # (or "t"s, if it's a spoofed line!) 1024 &assert_keys; 1025 foreach $line_name (@CVS_Lines) 1026 { 1027 if ($state{$line_name} =~ /^i:(.+)$/) 1028 { 1029 if ($1 eq $this_commit_rev) 1030 { 1031 if ($CVS_Spoofed{$line_name}) 1032 { $state{$line_name} = "t:$this_commit_rev"; } 1033 else 1034 { $state{$line_name} = "c:$this_commit_rev"; } 1035 } 1036 } 1037 } 1038 1039#print TTYO "\n 333\n"; 1040#&dump_state(); 1041 1042 # An element =~ "^c" will get this commit (branching if a natural consequence) 1043 # An element =~ "^a" will be updated with a branch tag creation. 1044 # An element =~ "^t" wants to be a tag update. 1045 # An element =~ "^m" wants a merge 'n commit. 1046 # An element =~ "^i" wants a commit. 1047 # An element =~ "^n" wants no action. 1048 # 1049 # (but we still need to normalize to reflect the current check-in, 1050 # and updates for multiple non-branched lines that are currently 1051 # at the same revision). 1052 # 1053 1054 plan_for_new: 1055 1056 if ($Verbose || (! $Noconfirm)) 1057 { 1058 print TTYO "\nAction plan:\n\n"; 1059 &assert_keys; 1060 foreach $line_name (@CVS_Lines) 1061 { 1062 if ((! $Nolgroups) && ($CVS_Lines_Lgroups{$line_name} ne $this_lgroup 1063 && (! $Showall))) 1064 { next; } 1065 1066 $action = $state{$line_name}; 1067 1068 $msg = sprintf(" %-10s: ", $line_name); 1069 print TTYO $msg; 1070 1071 ($spec, $state, $specrev) = &setspecs($line_name); 1072 if ($action =~ /^c/) 1073 { $msg = "update with this commit"; } 1074 elsif ($action =~ /^a/) 1075 { $msg = "update with a branch tag create"; } 1076 elsif ($action =~ /^t/) 1077 { $msg = "update with a branch tag update"; } 1078 elsif ($action =~ /^m/) 1079 { $msg = "update with a revision merge and commit"; } 1080 elsif ($action =~ /^i/) 1081 { $msg = "update with a commit"; } 1082 elsif ($action =~ /^n/) 1083 { 1084 $msg = "will not be updated"; 1085 if ((! $Nolgroups) && $CVS_Lines_Lgroups{$line_name} ne $this_lgroup) 1086 { $msg .= " (different lines group \"$CVS_Lines_Lgroups{$line_name}\")"; } 1087 } 1088 else 1089 { ¬eNbail("problem: internal error: unresolved action: \"$action\"."); } 1090 1091 print TTYO $msg; 1092 1093 if ($action !~ /^n/) 1094 { 1095 $action =~ m/:(.+)$/; $r = $1; 1096 if ($CVS_Spoofed{$line_name}) 1097 { $msg = " [*$r]"; } else { $msg = " [$r]"; } 1098 print TTYO $msg; 1099 } 1100 1101 $msg = "\n"; print TTYO $msg; 1102 } 1103 } 1104 1105 if ($Noconfirm) 1106 { $ans = "y"; } 1107 else 1108 { 1109 $ans = &ask("\nProceed", "n", "y", "n"); 1110 print TTYO "\n"; 1111 } 1112 1113 if ($ans eq "n") 1114 { 1115 print TTYO <<LIT; 1116$Mynamebase: no "$here/$g_planfile" file written; 1117$Myspacbase no files will be committed from this directory. 1118 1119LIT 1120 &log("not proceeding"); 1121 exit 1; 1122 } 1123 1124 # OK, generate the cvs commands in a script for later execution. 1125 # 1126 undef %ci_revisions; # Tracks revisions we've checked in. 1127 1128 # Note that we do all non-merge updates first, so we never have 1129 # to worry about the working file being some other merged version 1130 # when doing these update 1131 # 1132 # First, do any straight commits... 1133 # 1134 &assert_keys; 1135 foreach $line_name (@CVS_Lines) 1136 { 1137 if ($state{$line_name} =~ /^c:(.+)$/) 1138 { 1139 ($spec, $state, $specrev) = &setspecs($line_name); 1140 if (! defined($ci_revisions{$1})) 1141 { 1142 if ($CVS_Spoofed{$line_name}) 1143 { $r = "$spec:$1"; } else { $r = "$1"; } 1144 $filecmds .= "commit this $r\n"; 1145 $ci_revisions{$1} = 1; 1146 } 1147 #delete($state{$line_name}); 1148 $state{$line_name} =~ s/^./X/; 1149 } 1150 } 1151 1152 # Now, any "not this" commits" (which may be the initial check-in, 1153 # if we punted in favor of branch tagging...) 1154 # 1155 &assert_keys; 1156 foreach $line_name (@CVS_Lines) 1157 { 1158 if ($state{$line_name} =~ /^i:(.+)$/) 1159 { 1160 ($spec, $state, $specrev) = &setspecs($line_name); 1161 if (! defined($ci_revisions{$1})) 1162 { 1163 if ($merge_diffs ne "") 1164 { $filecmds .= "merge $spec\n"; } 1165 else 1166 { $filecmds .= "commit $spec $1\n"; } 1167 $ci_revisions{$1} = 1; 1168 } 1169 #delete($state{$line_name}); 1170 $state{$line_name} =~ s/^./X/; 1171 } 1172 } 1173 1174# # Now, the first "commit plus branch tag update"s, 1175# # if there are any. 1176# # 1177# &assert_keys; 1178# foreach $line_name (@CVS_Lines) 1179# { 1180# if ($state{$line_name} =~ /^T:(.+)$/) 1181# { 1182# ($spec, $state, $specrev) = &setspecs($line_name); 1183# if (! defined($ci_revisions{$1})) 1184# { 1185# $filecmds .= "commitTag $spec $1\n"; 1186# $ci_revisions{$1} = 1; 1187# } 1188# #delete($state{$line_name}); 1189# $state{$line_name} =~ s/^./X/; 1190# } 1191# } 1192 1193 # Now, any plain 'ole merges 1194 # 1195 &assert_keys; 1196 foreach $line_name (@CVS_Lines) 1197 { 1198 if ($state{$line_name} =~ /^m:(.+)$/) 1199 { 1200 ($spec, $state, $specrev) = &setspecs($line_name); 1201 if (! defined($ci_revisions{$1})) 1202 { 1203 $filecmds .= "merge $spec $1\n"; 1204 $ci_revisions{$1} = 1; 1205 } 1206 #delete($state{$line_name}); 1207 $state{$line_name} =~ s/^./X/; 1208 } 1209 } 1210 1211 # Now, any branch tag updates 1212 # (any remaining "T"s are just simple updates at this point) 1213 # 1214 &assert_keys; 1215 foreach $line_name (@CVS_Lines) 1216 { 1217 if ($state{$line_name} =~ /^[atT]:(.+)$/) 1218 { 1219 ($spec, $state, $specrev) = &setspecs($line_name); 1220 $filecmds .= "branchtag $spec $1\n"; 1221 #delete($state{$line_name}); 1222 $state{$line_name} =~ s/^./X/; 1223 } 1224 } 1225 1226 &log($filecmds); 1227 $cmds .= $filecmds; 1228 1229 } 1230 1231 1232if (! open(CMDS, ">$here/$Planfile")) 1233 { ¬eNbail("problem: can't create \"$here/$Planfile\" to write"); } 1234 1235print CMDS $cmds; 1236close CMDS; 1237 1238# OK, if we got here, then we wrote a valid $Planfile 1239# spec - tell the user 1240# 1241print TTYO "$Mynamebase: wrote $here/$Planfile\n"; 1242 1243exit 0; 1244