1#!/usr/local/bin/perl 2use warnings; 3use strict; 4use feature qw/switch say/; 5 6use v5.10.0; # needed for $^V 7 8# The given/when smartmatch facility, introduced in Perl v5.10, was made 9# experimental and "subject to change" in v5.18 (see perl5180delta). Every 10# use of it now triggers a warning. 11# 12# As of Perl v5.30.0, the semantics of given/when provided by Perl are 13# compatible with those expected by the script, so disable the warning for 14# those Perls. But don't try to disable the the warning category on Perls 15# that don't know that category, since that breaks compilation. 16no if (v5.17.0 le $^V and $^V le v5.30.0), 17 warnings => 'experimental::smartmatch'; 18 19# Licensed to the Apache Software Foundation (ASF) under one 20# or more contributor license agreements. See the NOTICE file 21# distributed with this work for additional information 22# regarding copyright ownership. The ASF licenses this file 23# to you under the Apache License, Version 2.0 (the 24# "License"); you may not use this file except in compliance 25# with the License. You may obtain a copy of the License at 26# 27# http://www.apache.org/licenses/LICENSE-2.0 28# 29# Unless required by applicable law or agreed to in writing, 30# software distributed under the License is distributed on an 31# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 32# KIND, either express or implied. See the License for the 33# specific language governing permissions and limitations 34# under the License. 35 36use Carp qw/croak confess carp cluck/; 37use Digest (); 38use Term::ReadKey qw/ReadMode ReadKey/; 39use File::Basename qw/basename dirname/; 40use File::Copy qw/copy move/; 41use File::Temp qw/tempfile/; 42use IO::Select (); 43use IPC::Open3 qw/open3/; 44use POSIX qw/ctermid strftime/; 45use Text::Wrap qw/wrap/; 46use Tie::File (); 47 48############### Start of reading values from environment ############### 49 50# Programs we use. 51# 52# TODO: document which are interpreted by sh and which should point to binary. 53my $SVN = $ENV{SVN} || 'svn'; # passed unquoted to sh 54$SVN .= " --config-option=config:miscellany:log-encoding=UTF-8"; 55my $SHELL = $ENV{SHELL} // '/bin/sh'; 56my $VIM = 'vim'; 57my $EDITOR = $ENV{SVN_EDITOR} // $ENV{VISUAL} // $ENV{EDITOR} // 'ed'; 58my $PAGER = $ENV{PAGER} // 'less' // 'cat'; 59 60# Mode flags. 61package Mode { 62 use constant { 63 AutoCommitApproveds => 1, # used by nightly commits (svn-role) 64 Conflicts => 2, # used by the hourly conflicts-detection buildbot 65 Interactive => 3, 66 }; 67}; 68my $YES = ($ENV{YES} // "0") =~ /^(1|yes|true)$/i; # batch mode: eliminate prompts, add sleeps 69my $MAY_COMMIT = ($ENV{MAY_COMMIT} // "false") =~ /^(1|yes|true)$/i; 70my $MODE = ($YES ? ($MAY_COMMIT ? Mode::AutoCommitApproveds : Mode::Conflicts ) 71 : Mode::Interactive ); 72 73# Other knobs. 74my $VERBOSE = 0; 75my $DEBUG = (exists $ENV{DEBUG}); # 'set -x', etc 76 77# Force all these knobs to be usable via @sh. 78my @sh = qw/false true/; 79die if grep { ($sh[$_] eq 'true') != !!$_ } $DEBUG, $MAY_COMMIT, $VERBOSE, $YES; 80 81# Username for entering votes. 82my $SVN_A_O_REALM = '<https://svn.apache.org:443> ASF Committers'; 83my ($AVAILID) = $ENV{AVAILID} // do { 84 local $_ = `$SVN auth svn.apache.org:443 2>/dev/null`; # TODO: pass $SVN_A_O_REALM 85 ($? == 0 && /Auth.*realm: \Q$SVN_A_O_REALM\E\nUsername: (.*)/) ? $1 : undef 86} // do { 87 local $/; # slurp mode 88 my $fh; 89 my $dir = "$ENV{HOME}/.subversion/auth/svn.simple/"; 90 my $filename = Digest->new("MD5")->add($SVN_A_O_REALM)->hexdigest; 91 open $fh, '<', "$dir/$filename" 92 and <$fh> =~ /K 8\nusername\nV \d+\n(.*)/ 93 ? $1 94 : undef 95}; 96 97unless (defined $AVAILID) { 98 unless ($MODE == Mode::Conflicts) { 99 warn "Username for commits (of votes/merges) not found; " 100 ."it will be possible to review nominations but not to commit votes " 101 ."or merges.\n"; 102 warn "Press the 'any' key to continue...\n"; 103 die if $MODE == Mode::AutoCommitApproveds; # unattended mode; can't prompt. 104 ReadMode 'cbreak'; 105 ReadKey 0; 106 ReadMode 'restore'; 107 } 108} 109 110############## End of reading values from the environment ############## 111 112# Constants. 113my $STATUS = './STATUS'; 114my $STATEFILE = './.backports1'; 115my $BRANCHES = '^/subversion/branches'; 116my $TRUNK = '^/subversion/trunk'; 117$ENV{LC_ALL} = "C"; # since we parse 'svn info' output 118 119# Globals. 120my %ERRORS = (); 121# TODO: can $MERGED_SOMETHING be removed and references to it replaced by scalar(@MERGES_TODAY) ? 122# alternately, does @MERGES_TODAY need to be purged whenever $MERGED_SOMETHING is reset? 123# The scalar is only used in interactive runs, but the array is used in 124# svn-role batch mode too. 125my @MERGES_TODAY; 126my $MERGED_SOMETHING = 0; 127my $SVNq; 128 129# Derived values. 130my $SVNvsn = do { 131 my ($major, $minor, $patch) = `$SVN --version -q` =~ /^(\d+)\.(\d+)\.(\d+)/; 132 1e6*$major + 1e3*$minor + $patch; 133}; 134$SVN .= " --non-interactive" if $YES or not defined ctermid; 135$SVNq = "$SVN -q "; 136$SVNq =~ s/-q// if $DEBUG; 137 138 139my $BACKPORT_OPTIONS_HELP = <<EOF; 140y: Run a merge. It will not be committed. 141 WARNING: This will run 'update' and 'revert -R ./'. 142l: Show logs for the entries being nominated. 143v: Show the full entry (the prompt only shows an abridged version). 144q: Quit the "for each entry" loop. If you have entered any votes or 145 approvals, you will be prompted to commit them. 146±1: Enter a +1 or -1 vote 147 You will be prompted to commit your vote at the end. 148±0: Enter a +0 or -0 vote 149 You will be prompted to commit your vote at the end. 150a: Move the entry to the "Approved changes" section. 151 When both approving and voting on an entry, approve first: for example, 152 to enter a third +1 vote, type "a" "+" "1". 153e: Edit the entry in \$EDITOR, which is '$EDITOR'. 154 You will be prompted to commit your edits at the end. 155N: Move to the next entry. Do not prompt for the current entry again, even 156 in future runs, unless the STATUS nomination has been modified (e.g., 157 revisions added, justification changed) in the repository. 158 (This is a local action that will not affect other people or bots.) 159 : Move to the next entry. Prompt for the current entry again in the next 160 run of backport.pl. 161 (That's a space character, ASCII 0x20.) 162?: Display this list. 163EOF 164 165my $BACKPORT_OPTIONS_MERGE_OPTIONS_HELP = <<EOF; 166y: Open a shell. 167d: View a diff. 168N: Move to the next entry. 169?: Display this list. 170EOF 171 172sub backport_usage { 173 my $basename = basename $0; 174 print <<EOF; 175backport.pl: a tool for reviewing, merging, and voting on STATUS entries. 176 177Normally, invoke this with CWD being the root of the stable branch (e.g., 1781.8.x): 179 180 Usage: test -e \$d/STATUS && cd \$d && \\ 181 backport.pl [PATTERN] 182 (where \$d is a working copy of branches/1.8.x) 183 184Alternatively, invoke this via a symlink named "b" placed at the same directory 185as the STATUS file, in which case the CWD doesn't matter (the script will cd): 186 187 Usage: ln -s /path/to/backport.pl \$d/b && \\ 188 \$d/b [PATTERN] 189 (where \$d is a working copy of branches/1.8.x) 190 191In either case, the ./STATUS file should be at HEAD. If it has local mods, 192they will be preserved through 'revert' operations but included in 'commit' 193operations. 194 195If PATTERN is provided, only entries which match PATTERN are considered. The 196sense of "match" is either substring (fgrep) or Perl regexp (with /msi). 197 198In interactive mode (the default), you will be prompted once per STATUS entry. 199At a prompt, you have the following options: 200 201$BACKPORT_OPTIONS_HELP 202 203After running a merge, you have the following options: 204 205$BACKPORT_OPTIONS_MERGE_OPTIONS_HELP 206 207To commit a merge, you have two options: either answer 'y' to the second prompt 208to open a shell, and manually run 'svn commit' therein; or set \$MAY_COMMIT=1 209in the environment before running the script, in which case answering 'y' 210to the first prompt will not only run the merge but also commit it. 211 212There are two batch modes. The first mode is used by the nightly svn-role 213mergebot. It is enabled by setting \$YES and \$MAY_COMMIT to '1' in the 214environment. In this mode, the script will iterate the "Approved changes:" 215section and merge and commit each entry therein. To prevent an entry from 216being auto-merged, veto it or move it to a new section named "Approved, but 217merge manually:". 218 219The second batch mode is used by the hourly conflicts detector bot. It is 220triggered by having \$YES defined in the environment to '1' and \$MAY_COMMIT 221undefined. In this mode, the script will locally merge every nomination 222(including unapproved and vetoed ones), and complain to stderr if the merge 223failed due to a conflict. This mode never commits anything. 224 225The hourly conflicts detector bot turns red if any entry produced a merge 226conflict. When entry A depends on entry B for a clean merge, put a "Depends:" 227header on entry A to instruct the bot not to turn red due to A. (The header 228is not parsed; only its presence or absence matters.) 229 230Both batch modes also perform a basic sanity-check on entries that declare 231backport branches (via the "Branch:" header): if a backport branch is used, but 232at least one of the revisions enumerated in the entry title had neither been 233merged from $TRUNK to the branch root, nor been committed 234directly to the backport branch, the hourly bot will turn red and 235nightly bot will skip the entry and email its admins. (The nightly bot does 236not email the list on failure, since it doesn't use buildbot.) 237 238The 'svn' binary defined by the environment variable \$SVN, or otherwise the 239'svn' found in \$PATH, will be used to manage the working copy. 240EOF 241} 242 243sub nominate_usage { 244 my $availid = $AVAILID // "(your username)"; 245 my $basename = basename $0; 246 print <<EOF; 247nominate.pl: a tool for adding entries to STATUS. 248 249Usage: $0 "r42, r43, r45" "\$Some_justification" 250 251Will add: 252 * r42, r43, r45 253 (log message of r42) 254 Justification: 255 \$Some_justification 256 Votes: 257 +1: $availid 258to STATUS. Backport branches are detected automatically. 259 260The revisions argument may contain arbitrary text (besides the revision 261numbers); it will be ignored. For example, 262 $0 "Committed revision 42." "\$Some_justification" 263will nominate r42. 264 265Revision numbers within the last thousand revisions may be specified using 266the last three digits only. 267 268The justification can be an arbitrarily-long string; if it is wider than the 269available width, this script will wrap it for you (and allow you to review 270the result before committing). 271 272The STATUS file in the current directory is used (unless argv[0] is "n", in 273which case the STATUS file in the directory of argv[0] is used; the intent 274is to create a symlink named "n" in the branch wc root). 275 276EOF 277# TODO: Optionally add a "Notes" section. 278# TODO: Look for backport branches named after issues. 279# TODO: Do a dry-run merge on added entries. 280# TODO: Do a dry-run merge on interactively-edited entries in backport.pl 281} 282 283# If $AVAILID is undefined, warn about it and return true. 284# Else return false. 285# 286# $_[0] is a string for inclusion in generated error messages. 287sub warned_cannot_commit { 288 my $caller_error_string = shift; 289 return 0 if defined $AVAILID; 290 291 warn "$0: $caller_error_string: unable to determine your username via \$AVAILID or svnauth(1) or ~/.subversion/auth/"; 292 return 1; 293} 294 295sub digest_string { 296 Digest->new("MD5")->add(@_)->hexdigest 297} 298 299sub digest_entry($) { 300 # Canonicalize the number of trailing EOLs to two. This matters when there's 301 # on empty line after the last entry in Approved, for example. 302 local $_ = shift; 303 s/\n*\z// and $_ .= "\n\n"; 304 digest_string($_) 305} 306 307sub prompt { 308 print $_[0]; shift; 309 my %args = @_; 310 my $getchar = sub { 311 my $answer; 312 do { 313 ReadMode 'cbreak'; 314 $answer = (ReadKey 0); 315 ReadMode 'normal'; 316 die if $@ or not defined $answer; 317 # Swallow terminal escape codes (e.g., arrow keys). 318 unless ($answer =~ m/^(?:[[:print:]]+|\s+)$/) { 319 $answer = (ReadKey -1) while defined $answer; 320 # TODO: provide an indication that the keystroke was sensed and ignored. 321 } 322 } until defined $answer and ($answer =~ m/^(?:[[:print:]]+|\s+)$/); 323 print $answer; 324 return $answer; 325 }; 326 327 die "$0: called prompt() in non-interactive mode!" if $YES; 328 my $answer = $getchar->(); 329 $answer .= $getchar->() if exists $args{extra} and $answer =~ $args{extra}; 330 say "" unless $args{dontprint}; 331 return $args{verbose} 332 ? $answer 333 : ($answer =~ /^y/i) ? 1 : 0; 334} 335 336# Bourne-escape a string. 337# Example: 338# >>> shell_escape(q[foo'bar]) eq q['foo'\''bar'] 339# True 340sub shell_escape { 341 my (@reply) = map { 342 local $_ = $_; # the LHS $_ is mutable; the RHS $_ may not be. 343 s/\x27/'\\\x27'/g; 344 "'$_'" 345 } @_; 346 wantarray ? @reply : $reply[0] 347} 348 349sub shell_safe_path_or_url($) { 350 local $_ = shift; 351 return (m{^[A-Za-z0-9._:+/-]+$} and !/^-|^[+]/); 352} 353 354# Shell-safety-validating wrapper for File::Temp::tempfile 355sub my_tempfile { 356 my ($fh, $fn) = tempfile(); 357 croak "Tempfile name '$fn' not shell-safe; aborting" 358 unless shell_safe_path_or_url $fn; 359 return ($fh, $fn); 360} 361 362# The first argument is a shell script. Run it and return the shell's 363# exit code, and stdout and stderr as references to arrays of lines. 364sub run_in_shell($) { 365 my $script = shift; 366 my $pid = open3 \*SHELL_IN, \*SHELL_OUT, \*SHELL_ERR, qw#/bin/sh#; 367 # open3 raises exception when it fails; no need to error check 368 369 print SHELL_IN $script; 370 close SHELL_IN; 371 372 # Read loop: tee stdout,stderr to arrays. 373 my $select = IO::Select->new(\*SHELL_OUT, \*SHELL_ERR); 374 my (@readable, $outlines, $errlines); 375 while (@readable = $select->can_read) { 376 for my $fh (@readable) { 377 my $line = <$fh>; 378 $select->remove($fh) if eof $fh or not defined $line; 379 next unless defined $line; 380 381 if ($fh == \*SHELL_OUT) { 382 push @$outlines, $line; 383 print STDOUT $line; 384 } 385 if ($fh == \*SHELL_ERR) { 386 push @$errlines, $line; 387 print STDERR $line; 388 } 389 } 390 } 391 waitpid $pid, 0; # sets $? 392 return $?, $outlines, $errlines; 393} 394 395 396# EXPECTED_ERROR_P is subref called with EXIT_CODE, OUTLINES, ERRLINES, 397# expected to return TRUE if the error should be considered fatal (cause 398# backport.pl to exit non-zero) or not. It may be undef for default behaviour. 399sub merge { 400 my %entry = %{ +shift }; 401 my $expected_error_p = shift // sub { 0 }; # by default, errors are unexpected 402 my $parno = $entry{parno} - scalar grep { $_->{parno} < $entry{parno} } @MERGES_TODAY; 403 404 my ($logmsg_fh, $logmsg_filename) = my_tempfile(); 405 my (@mergeargs); 406 407 my $shell_escaped_branch = shell_escape($entry{branch}) 408 if defined($entry{branch}); 409 410 if ($entry{branch}) { 411 if ($SVNvsn >= 1_008_000) { 412 @mergeargs = shell_escape "$BRANCHES/$entry{branch}"; 413 say $logmsg_fh "Merge $entry{header}:"; 414 } else { 415 @mergeargs = shell_escape qw/--reintegrate/, "$BRANCHES/$entry{branch}"; 416 say $logmsg_fh "Reintegrate $entry{header}:"; 417 } 418 say $logmsg_fh ""; 419 } elsif (@{$entry{revisions}}) { 420 @mergeargs = shell_escape( 421 ($entry{accept} ? "--accept=$entry{accept}" : ()), 422 (map { "-c$_" } @{$entry{revisions}}), 423 '--', 424 '^/subversion/trunk', 425 ); 426 say $logmsg_fh 427 "Merge $entry{header} from trunk", 428 $entry{accept} ? ", with --accept=$entry{accept}" : "", 429 ":"; 430 say $logmsg_fh ""; 431 } else { 432 die "Don't know how to call $entry{header}"; 433 } 434 say $logmsg_fh $_ for @{$entry{entry}}; 435 close $logmsg_fh or die "Can't close $logmsg_filename: $!"; 436 437 my $reintegrated_word = ($SVNvsn >= 1_008_000) ? "merged" : "reintegrated"; 438 my $script = <<"EOF"; 439#!/bin/sh 440set -e 441if $sh[$DEBUG]; then 442 set -x 443fi 444$SVNq up 445$SVNq merge @mergeargs 446if [ "`$SVN status -q | wc -l`" -eq 1 ]; then 447 if [ -z "`$SVN diff | perl -lne 'print if s/^(Added|Deleted|Modified): //' | grep -vx svn:mergeinfo`" ]; then 448 # This check detects STATUS entries that name non-^/subversion/ revnums. 449 # ### Q: What if we actually commit a mergeinfo fix to trunk and then want 450 # ### to backport it? 451 # ### A: We don't merge it using the script. 452 echo "Bogus merge: includes only svn:mergeinfo changes!" >&2 453 exit 2 454 fi 455fi 456if $sh[$MAY_COMMIT]; then 457 # Remove the approved entry. The sentinel is important when the entry being 458 # removed is the very last one in STATUS, and in that case it has two effects: 459 # (1) keeps STATUS from ending in a run of multiple empty lines; 460 # (2) makes the \x{7d}k motion behave the same as in all other cases. 461 # 462 # Use a tempfile because otherwise backport_main() would see the "sentinel paragraph". 463 # Since backport_main() has an open descriptor, it will continue to see 464 # the STATUS inode that existed when control flow entered backport_main(); 465 # since we replace the file on disk, when this block of code runs in the 466 # next iteration, it will see the new contents. 467 cp $STATUS $STATUS.t 468 (echo; echo; echo "sentinel paragraph") >> $STATUS.t 469 $VIM -e -s -n -N -i NONE -u NONE -c ':0normal! $parno\x{7d}kdap' -c wq $STATUS.t 470 $VIM -e -s -n -N -i NONE -u NONE -c '\$normal! dap' -c wq $STATUS.t 471 mv $STATUS.t $STATUS 472 $SVNq commit -F $logmsg_filename 473elif ! $sh[$YES]; then 474 echo "Would have committed:" 475 echo '[[[' 476 $SVN status -q 477 echo 'M STATUS (not shown in the diff)' 478 cat $logmsg_filename 479 echo ']]]' 480fi 481EOF 482 483 if ($MAY_COMMIT) { 484 # STATUS has been edited and the change has been committed 485 push @MERGES_TODAY, \%entry; 486 } 487 488 $script .= <<"EOF" if $entry{branch}; 489reinteg_rev=\`$SVN info $STATUS | sed -ne 's/Last Changed Rev: //p'\` 490if $sh[$MAY_COMMIT]; then 491 # Sleep to avoid out-of-order commit notifications 492 if $sh[$YES]; then sleep 15; fi 493 $SVNq rm $BRANCHES/$shell_escaped_branch -m "Remove the '"$shell_escaped_branch"' branch, $reintegrated_word in r\$reinteg_rev." 494 if $sh[$YES]; then sleep 1; fi 495elif ! $sh[$YES]; then 496 echo "Would remove $reintegrated_word '"$shell_escaped_branch"' branch" 497fi 498EOF 499 500 # Include the time so it's easier to find the interesting backups. 501 my $backupfile = strftime "backport_pl.%Y%m%d-%H%M%S.$$.tmp", localtime; 502 die if -s $backupfile; 503 system("$SVN diff > $backupfile") == 0 504 or die "Saving a backup diff ($backupfile) failed ($?): $!"; 505 if (-z $backupfile) { 506 unlink $backupfile; 507 } else { 508 warn "Local mods saved to '$backupfile'\n"; 509 } 510 511 # If $MAY_COMMIT, then $script will edit STATUS anyway. 512 revert(verbose => 0, discard_STATUS => $MAY_COMMIT); 513 514 $MERGED_SOMETHING++; 515 my ($exit_code, $outlines, $errlines) = run_in_shell $script; 516 unless ($! == 0) { 517 die "system() failed to spawn subshell ($!); aborting"; 518 } 519 unless ($exit_code == 0) { 520 warn "$0: subshell exited with code $exit_code (in '$entry{header}') " 521 ."(maybe due to 'set -e'?)"; 522 523 # If we're committing, don't attempt to guess the problem and gracefully 524 # continue; just abort. 525 if ($MAY_COMMIT) { 526 die "Lost track of paragraph numbers; aborting"; 527 } 528 529 # Record the error, unless the caller wants not to. 530 $ERRORS{$entry{id}} = [\%entry, "subshell exited with code $exit_code"] 531 unless $expected_error_p->($exit_code, $outlines, $errlines); 532 } 533 534 unlink $logmsg_filename unless $exit_code; 535} 536 537# Input formats: 538# "1.8.x-r42", 539# "branches/1.8.x-r42", 540# "branches/1.8.x-r42/", 541# "subversion/branches/1.8.x-r42", 542# "subversion/branches/1.8.x-r42/", 543# "^/subversion/branches/1.8.x-r42", 544# "^/subversion/branches/1.8.x-r42/", 545# Return value: 546# "1.8.x-r42" 547# Works for any branch name that doesn't include slashes. 548sub sanitize_branch { 549 local $_ = shift; 550 s/^\s*//; 551 s/\s*$//; 552 s#/*$##; 553 s#.*/##; 554 return $_; 555} 556 557sub logsummarysummary { 558 my $entry = shift; 559 join "", 560 $entry->{logsummary}->[0], ('[...]' x (0 < $#{$entry->{logsummary}})) 561} 562 563# TODO: may need to parse other headers too? 564sub parse_entry { 565 my $raw = shift; 566 my $parno = shift; 567 my @lines = @_; 568 my $depends; 569 my $accept; 570 my (@revisions, @logsummary, $branch, @votes); 571 # @lines = @_; 572 573 # strip spaces to match up with the indention 574 $_[0] =~ s/^( *)\* //; 575 my $indentation = ' ' x (length($1) + 2); 576 s/^$indentation// for @_; 577 578 # Ignore trailing spaces: it is not significant on any field, and makes the 579 # regexes simpler. 580 s/\s*$// for @_; 581 582 # revisions 583 $branch = sanitize_branch $1 584 and shift 585 if $_[0] =~ /^(\S*) branch$/ or $_[0] =~ m#branches/(\S+)#; 586 while ($_[0] =~ /^(?:r?\d+[,; ]*)+$/) { 587 push @revisions, ($_[0] =~ /(\d+)/g); 588 shift; 589 } 590 591 # summary 592 do { 593 push @logsummary, shift 594 } until $_[0] =~ /^\s*[A-Z][][\w]*:/ or not defined $_[0]; 595 596 # votes 597 unshift @votes, pop until $_[-1] =~ /^\s*Votes:/ or not defined $_[-1]; 598 pop; 599 600 # depends, branch, notes 601 # Ignored headers: Changes[*] 602 while (@_) { 603 given (shift) { 604 when (/^Depends:/) { 605 $depends++; 606 } 607 if (s/^Branch:\s*//) { 608 $branch = sanitize_branch ($_ || shift || die "Branch header found without value"); 609 } 610 if (s/^Notes:\s*//) { 611 my $notes = $_; 612 $notes .= shift while @_ and $_[0] !~ /^\w/; 613 my %accepts = map { $_ => 1 } ($notes =~ /--accept[ =]([a-z-]+)/g); 614 given (scalar keys %accepts) { 615 when (0) { } 616 when (1) { $accept = [keys %accepts]->[0]; } 617 default { 618 warn "Too many --accept values at '", 619 logsummarysummary({ logsummary => [@logsummary] }), 620 "'"; 621 } 622 } 623 } 624 } 625 } 626 627 # Compute a header. 628 my ($header, $id); 629 if ($branch) { 630 $header = "the $branch branch"; 631 $id = $branch; 632 } elsif (@revisions == 1) { 633 $header = "r$revisions[0]"; 634 $id = "r$revisions[0]"; 635 } elsif (@revisions) { 636 $header = "the r$revisions[0] group"; 637 $id = "r$revisions[0]"; 638 } else { 639 die "Entry '$raw' has neither revisions nor branch"; 640 } 641 my $header_start = ($header =~ /^the/ ? ucfirst($header) : $header); 642 643 warn "Entry has both branch '$branch' and --accept=$accept specified\n" 644 if $branch and $accept; 645 646 return ( 647 revisions => [@revisions], 648 logsummary => [@logsummary], 649 branch => $branch, 650 header => $header, 651 header_start => $header_start, 652 depends => $depends, 653 id => $id, 654 votes => [@votes], 655 entry => [@lines], 656 accept => $accept, 657 raw => $raw, 658 digest => digest_entry($raw), 659 parno => $parno, # $. from backport_main() 660 ); 661} 662 663sub edit_string { 664 # Edits $_[0] in an editor. 665 # $_[1] is used in error messages. 666 die "$0: called edit_string() in non-interactive mode!" if $YES; 667 my $string = shift; 668 my $name = shift; 669 my %args = @_; 670 my $trailing_eol = $args{trailing_eol}; 671 my ($fh, $fn) = my_tempfile(); 672 print $fh $string; 673 $fh->flush or die $!; 674 system("$EDITOR -- $fn") == 0 675 or warn "\$EDITOR failed editing $name: $! ($?); " 676 ."edit results ($fn) ignored."; 677 my $rv = `cat $fn`; 678 $rv =~ s/\n*\z// and $rv .= ("\n" x $trailing_eol) if defined $trailing_eol; 679 $rv; 680} 681 682sub vote { 683 my ($state, $approved, $votes) = @_; 684 # TODO: use votesarray instead of votescheck 685 my (%approvedcheck, %votescheck); 686 my $raw_approved = ""; 687 my @votesarray; 688 return unless %$approved or %$votes; 689 690 # If $AVAILID is undef, we can only process 'edit' pseudovotes; handle_entry() is 691 # supposed to prevent numeric (±1,±0) votes from getting to this point. 692 die "Assertion failed" if not defined $AVAILID 693 and grep { $_ ne 'edit' } map { $_->[0] } values %$votes; 694 695 my $had_empty_line; 696 697 $. = 0; 698 open STATUS, "<", $STATUS; 699 open VOTES, ">", "$STATUS.$$.tmp"; 700 while (<STATUS>) { 701 $had_empty_line = /\n\n\z/; 702 my $key = digest_entry $_; 703 704 $approvedcheck{$key}++ if exists $approved->{$key}; 705 $votescheck{$key}++ if exists $votes->{$key}; 706 707 unless (exists $votes->{$key} or exists $approved->{$key}) { 708 print VOTES; 709 next; 710 } 711 712 unless (exists $votes->{$key}) { 713 push @votesarray, { 714 entry => $approved->{$key}, 715 approval => 1, 716 digest => $key, 717 }; 718 $raw_approved .= $_; 719 next; 720 } 721 722 # We have a vote, and potentially an approval. 723 724 my ($vote, $entry) = @{$votes->{$key}}; 725 push @votesarray, { 726 entry => $entry, 727 vote => $vote, 728 approval => (exists $approved->{$key}), 729 digest => $key, 730 }; 731 732 if ($vote eq 'edit') { 733 local $_ = $entry->{raw}; 734 $votesarray[-1]->{digest} = digest_entry $_; 735 (exists $approved->{$key}) ? ($raw_approved .= $_) : (print VOTES); 736 next; 737 } 738 739 s/^(\s*\Q$vote\E:.*)/"$1, $AVAILID"/me 740 or s/(.*\w.*?\n)/"$1 $vote: $AVAILID\n"/se; 741 $_ = edit_string $_, $entry->{header}, trailing_eol => 2 742 if $vote ne '+1'; 743 $votesarray[-1]->{digest} = digest_entry $_; 744 (exists $approved->{$key}) ? ($raw_approved .= $_) : (print VOTES); 745 } 746 close STATUS; 747 print VOTES "\n" if $raw_approved and !$had_empty_line; 748 print VOTES $raw_approved; 749 close VOTES; 750 warn "Some vote chunks weren't found: ", 751 join ',', 752 map $votes->{$_}->[1]->{id}, 753 grep { !$votescheck{$_} } keys %$votes 754 if scalar(keys %$votes) != scalar(keys %votescheck); 755 warn "Some approval chunks weren't found: ", 756 join ',', 757 map $approved->{$_}->{id}, 758 grep { !$approvedcheck{$_} } keys %$approved 759 if scalar(keys %$approved) != scalar(keys %approvedcheck); 760 prompt "Press the 'any' key to continue...\n", dontprint => 1 761 if scalar(keys %$approved) != scalar(keys %approvedcheck) 762 or scalar(keys %$votes) != scalar(keys %votescheck); 763 move "$STATUS.$$.tmp", $STATUS; 764 765 my $logmsg = do { 766 my @sentences = map { 767 my $words_vote = ", approving" x $_->{approval}; 768 my $words_edit = " and approve" x $_->{approval}; 769 exists $_->{vote} 770 ? ( 771 ( $_->{vote} eq 'edit' 772 ? "Edit$words_edit the $_->{entry}->{id} entry" 773 : "Vote $_->{vote} on $_->{entry}->{header}$words_vote" 774 ) 775 . "." 776 ) 777 : # exists only in $approved 778 "Approve $_->{entry}->{header}." 779 } @votesarray; 780 (@sentences == 1) 781 ? "* STATUS: $sentences[0]" 782 : "* STATUS:\n" . join "", map " $_\n", @sentences; 783 }; 784 785 system "$SVN diff -- $STATUS"; 786 printf "[[[\n%s%s]]]\n", $logmsg, ("\n" x ($logmsg !~ /\n\z/)); 787 if (prompt "Commit these votes? ") { 788 my ($logmsg_fh, $logmsg_filename) = my_tempfile(); 789 print $logmsg_fh $logmsg; 790 close $logmsg_fh; 791 system("$SVN commit -F $logmsg_filename -- $STATUS") == 0 792 or warn("Committing the votes failed($?): $!") and return; 793 unlink $logmsg_filename; 794 795 # Add to state votes that aren't '+0' or 'edit' 796 $state->{$_->{digest}}++ for grep 797 +($_->{approval} or $_->{vote} =~ /^(-1|-0|[+]1)$/), 798 @votesarray; 799 } 800} 801 802sub check_local_mods_to_STATUS { 803 if (`$SVN status -q $STATUS`) { 804 die "Local mods to STATUS file $STATUS" if $YES; 805 warn "Local mods to STATUS file $STATUS"; 806 system "$SVN diff -- $STATUS"; 807 prompt "Press the 'any' key to continue...\n", dontprint => 1; 808 return 1; 809 } 810 return 0; 811} 812 813sub renormalize_STATUS { 814 my $vimscript = <<'EOVIM'; 815:"" Strip trailing whitespace before entries and section headers, but not 816:"" inside entries (e.g., multi-paragraph Notes: fields). 817:"" 818:"" Since an entry is always followed by another entry, section header, or EOF, 819:"" there is no need to separately strip trailing whitespace from lines following 820:"" entries. 821:%s/\v\s+\n(\s*\n)*\ze(\s*[*]|\w)/\r\r/g 822 823:"" Ensure there is exactly one blank line around each entry and header. 824:"" 825:"" First, inject a new empty line above and below each entry and header; then, 826:"" squeeze runs of empty lines together. 827:0/^=/,$ g/^ *[*]/normal! O 828:g/^=/normal! o 829:g/^=/-normal! O 830: 831:%s/\n\n\n\+/\r\r/g 832 833:"" Save. 834:wq 835EOVIM 836 open VIM, '|-', $VIM, qw/-e -s -n -N -i NONE -u NONE --/, $STATUS 837 or die "Can't renormalize STATUS: $!"; 838 print VIM $vimscript; 839 close VIM or warn "$0: renormalize_STATUS failed ($?): $!)"; 840 841 system("$SVN commit -m '* STATUS: Whitespace changes only.' -- $STATUS") == 0 842 or die "$0: Can't renormalize STATUS ($?): $!" 843 if $MAY_COMMIT; 844} 845 846sub revert { 847 my %args = @_; 848 die "Bug: \$args{verbose} undefined" unless exists $args{verbose}; 849 die "Bug: unknown argument" if grep !/^(?:verbose|discard_STATUS)$/, keys %args; 850 851 copy $STATUS, "$STATUS.$$.tmp" unless $args{discard_STATUS}; 852 system("$SVN revert -q $STATUS") == 0 853 or die "revert failed ($?): $!"; 854 system("$SVN revert -R ./" . (" -q" x !$args{verbose})) == 0 855 or die "revert failed ($?): $!"; 856 move "$STATUS.$$.tmp", $STATUS unless $args{discard_STATUS}; 857 $MERGED_SOMETHING = 0; 858} 859 860sub maybe_revert { 861 # This is both a SIGINT handler, and the tail end of main() in normal runs. 862 # @_ is 'INT' in the former case and () in the latter. 863 delete $SIG{INT} unless @_; 864 revert verbose => 1 if !$YES and $MERGED_SOMETHING and prompt 'Revert? '; 865 (@_ ? exit : return); 866} 867 868sub signal_handler { 869 my $sig = shift; 870 871 # Clean up after prompt() 872 ReadMode 'normal'; 873 874 # Fall back to default action 875 delete $SIG{$sig}; 876 kill $sig, $$; 877} 878 879sub warning_summary { 880 return unless %ERRORS; 881 882 warn "Warning summary\n"; 883 warn "===============\n"; 884 warn "\n"; 885 for my $id (keys %ERRORS) { 886 my $title = logsummarysummary $ERRORS{$id}->[0]; 887 warn "$id ($title): $ERRORS{$id}->[1]\n"; 888 } 889} 890 891sub read_state { 892 # die "$0: called read_state() in non-interactive mode!" if $YES; 893 894 open my $fh, '<', $STATEFILE or do { 895 return {} if $!{ENOENT}; 896 die "Can't read statefile: $!"; 897 }; 898 899 my %rv; 900 while (<$fh>) { 901 chomp; 902 $rv{$_}++; 903 } 904 return \%rv; 905} 906 907sub write_state { 908 my $state = shift; 909 open STATE, '>', $STATEFILE or warn("Can't write state: $!"), return; 910 say STATE for keys %$state; 911 close STATE; 912} 913 914sub exit_stage_left { 915 my $state = shift; 916 maybe_revert; 917 warning_summary if $YES; 918 vote $state, @_; 919 write_state $state; 920 exit scalar keys %ERRORS; 921} 922 923# Given an ENTRY, check whether all ENTRY->{revisions} have been merged 924# into ENTRY->{branch}, if it has one. If revisions are missing, record 925# a warning in $ERRORS. Return TRUE If the entry passed the validation 926# and FALSE otherwise. 927sub validate_branch_contains_named_revisions { 928 my %entry = @_; 929 return 1 unless defined $entry{branch}; 930 my %present; 931 932 return "Why are you running so old versions?" # true in boolean context 933 if $SVNvsn < 1_005_000; # doesn't have the 'mergeinfo' subcommand 934 935 my $shell_escaped_branch = shell_escape($entry{branch}); 936 %present = do { 937 my @present = `$SVN mergeinfo --show-revs=merged -- $TRUNK $BRANCHES/$shell_escaped_branch && 938 $SVN mergeinfo --show-revs=eligible -- $BRANCHES/$shell_escaped_branch`; 939 chomp @present; 940 @present = map /(\d+)/g, @present; 941 map +($_ => 1), @present; 942 }; 943 944 my @absent = grep { not exists $present{$_} } @{$entry{revisions}}; 945 946 if (@absent) { 947 $ERRORS{$entry{id}} //= [\%entry, 948 sprintf("Revisions '%s' nominated but not included in branch", 949 (join ", ", map { "r$_" } @absent)), 950 ]; 951 } 952 return @absent ? 0 : 1; 953} 954 955sub handle_entry { 956 my $in_approved = shift; 957 my $approved = shift; 958 my $votes = shift; 959 my $state = shift; 960 my $raw = shift; 961 my $parno = shift; 962 my $skip = shift; 963 my %entry = parse_entry $raw, $parno, @_; 964 my @vetoes = grep /^\s*-1:/, @{$entry{votes}}; 965 966 my $match = defined($skip) ? ($raw =~ /\Q$skip\E/ or $raw =~ /$skip/msi) : 0 967 unless $YES; 968 969 if ($YES) { 970 # Run a merge if: 971 unless (@vetoes) { 972 if ($MAY_COMMIT and $in_approved) { 973 # svn-role mode 974 merge \%entry if validate_branch_contains_named_revisions %entry; 975 } elsif (!$MAY_COMMIT) { 976 # Scan-for-conflicts mode 977 978 # First, sanity-check the entry. We ignore the result; even if it 979 # failed, we do want to check for conflicts, in the remainder of this 980 # block. 981 validate_branch_contains_named_revisions %entry; 982 983 # E155015 is SVN_ERR_WC_FOUND_CONFLICT 984 my $expected_error_p = sub { 985 my ($exit_code, $outlines, $errlines) = @_; 986 ($exit_code == 0) 987 or 988 (grep /svn: E155015:/, @$errlines) 989 }; 990 merge \%entry, ($entry{depends} ? $expected_error_p : undef); 991 992 my $output = `$SVN status`; 993 994 # Pre-1.6 svn's don't have the 7th column, so fake it. 995 $output =~ s/^(......)/$1 /mg if $SVNvsn < 1_006_000; 996 997 my (@conflicts) = ($output =~ m#^(?:C......|.C.....|......C)\s(.*)#mg); 998 if (@conflicts and !$entry{depends}) { 999 $ERRORS{$entry{id}} //= [\%entry, 1000 sprintf "Conflicts on %s%s%s", 1001 '[' x !!$#conflicts, 1002 (join ', ', 1003 map { basename $_ } 1004 @conflicts), 1005 ']' x !!$#conflicts, 1006 ]; 1007 say STDERR "Conflicts merging $entry{header}!"; 1008 say STDERR ""; 1009 say STDERR $output; 1010 system "$SVN diff -- " . join ' ', shell_escape @conflicts; 1011 } elsif (!@conflicts and $entry{depends}) { 1012 # Not a warning since svn-role may commit the dependency without 1013 # also committing the dependent in the same pass. 1014 print "No conflicts merging $entry{header}, but conflicts were " 1015 ."expected ('Depends:' header set)\n"; 1016 } elsif (@conflicts) { 1017 say "Conflicts found merging $entry{header}, as expected."; 1018 } 1019 revert verbose => 0; 1020 } 1021 } 1022 } elsif (defined($skip) ? not $match : $state->{$entry{digest}}) { 1023 print "\n\n"; 1024 my $reason = defined($skip) ? "doesn't match pattern" 1025 : "remove $STATEFILE to reset"; 1026 say "Skipping $entry{header} ($reason):"; 1027 say logsummarysummary \%entry; 1028 } elsif ($match or not defined $skip) { 1029 # This loop is just a hack because 'goto' panics. The goto should be where 1030 # the "next PROMPT;" is; there's a "last;" at the end of the loop body. 1031 PROMPT: while (1) { 1032 say ""; 1033 say "\n\e\x5b32m>>> $entry{header_start}:\e\x5b0m"; 1034 say join ", ", map { "r$_" } @{$entry{revisions}} if @{$entry{revisions}}; 1035 say "$BRANCHES/$entry{branch}" if $entry{branch}; 1036 say "--accept=$entry{accept}" if $entry{accept}; 1037 say ""; 1038 say for @{$entry{logsummary}}; 1039 say ""; 1040 say for @{$entry{votes}}; 1041 say ""; 1042 say "Vetoes found!" if @vetoes; 1043 1044 # See above for why the while(1). 1045 QUESTION: while (1) { 1046 my $key = $entry{digest}; 1047 given (prompt 'Run a merge? [y,l,v,±1,±0,q,e,a, ,N,?] ', 1048 verbose => 1, extra => qr/[+-]/) { 1049 when (/^y/i) { 1050 # TODO: validate_branch_contains_named_revisions %entry; 1051 merge \%entry; 1052 while (1) { 1053 given (prompt "Shall I open a subshell? [ydN?] ", verbose => 1) { 1054 when (/^y/i) { 1055 # TODO: if $MAY_COMMIT, save the log message to a file (say, 1056 # backport.logmsg in the wcroot). 1057 system($SHELL) == 0 1058 or warn "Creating an interactive subshell failed ($?): $!" 1059 } 1060 when (/^d/) { 1061 system("$SVN diff | $PAGER") == 0 1062 or warn "diff failed ($?): $!"; 1063 next; 1064 } 1065 when (/^[?]/i) { 1066 print $BACKPORT_OPTIONS_MERGE_OPTIONS_HELP; 1067 next; 1068 } 1069 when (/^N/i) { 1070 # fall through. 1071 } 1072 default { 1073 next; 1074 } 1075 } 1076 revert verbose => 1; 1077 next PROMPT; 1078 } 1079 # NOTREACHED 1080 } 1081 when (/^l/i) { 1082 if ($entry{branch}) { 1083 system "$SVN log --stop-on-copy -v -g -r 0:HEAD -- " 1084 .shell_escape("$BRANCHES/$entry{branch}")." " 1085 ."| $PAGER"; 1086 } elsif (@{$entry{revisions}}) { 1087 system "$SVN log ".(join ' ', map { "-r$_" } @{$entry{revisions}}) 1088 ." -- ^/subversion | $PAGER"; 1089 } else { 1090 die "Assertion failed: entry has neither branch nor revisions:\n", 1091 '[[[', (join ';;', %entry), ']]]'; 1092 } 1093 next PROMPT; 1094 } 1095 when (/^v/i) { 1096 say ""; 1097 say for @{$entry{entry}}; 1098 say ""; 1099 next QUESTION; 1100 } 1101 when (/^q/i) { 1102 exit_stage_left $state, $approved, $votes; 1103 } 1104 when (/^a/i) { 1105 $approved->{$key} = \%entry; 1106 next PROMPT; 1107 } 1108 when (/^([+-][01])\s*$/i) { 1109 next QUESTION if warned_cannot_commit "Entering a vote failed"; 1110 $votes->{$key} = [$1, \%entry]; 1111 say "Your '$1' vote has been recorded." if $VERBOSE; 1112 last PROMPT; 1113 } 1114 when (/^e/i) { 1115 prompt "Press the 'any' key to continue...\n" 1116 if warned_cannot_commit "Committing this edit later on may fail"; 1117 my $original = $entry{raw}; 1118 $entry{raw} = edit_string $entry{raw}, $entry{header}, 1119 trailing_eol => 2; 1120 # TODO: parse the edited entry (empty lines, logsummary+votes, etc.) 1121 $votes->{$key} = ['edit', \%entry] # marker for the 2nd pass 1122 if $original ne $entry{raw}; 1123 last PROMPT; 1124 } 1125 when (/^N/i) { 1126 $state->{$entry{digest}}++; 1127 last PROMPT; 1128 } 1129 when (/^\x20/) { 1130 last PROMPT; # Fall off the end of the given/when block. 1131 } 1132 when (/^[?]/i) { 1133 print $BACKPORT_OPTIONS_HELP; 1134 next QUESTION; 1135 } 1136 default { 1137 say "Please use one of the options in brackets (q to quit)!"; 1138 next QUESTION; 1139 } 1140 } 1141 last; } # QUESTION 1142 last; } # PROMPT 1143 } else { 1144 # NOTREACHED 1145 die "Unreachable code reached."; 1146 } 1147 1148 1; 1149} 1150 1151 1152sub backport_main { 1153 my %approved; 1154 my %votes; 1155 my $state = read_state; 1156 my $renormalize; 1157 1158 if (@ARGV && $ARGV[0] eq '--renormalize') { 1159 $renormalize = 1; 1160 shift; 1161 } 1162 1163 backport_usage, exit 0 if @ARGV > ($YES ? 0 : 1) or grep /^--help$/, @ARGV; 1164 backport_usage, exit 0 if grep /^(?:-h|-\?|--help|help)$/, @ARGV; 1165 my $skip = shift; # maybe undef 1166 # assert not defined $skip if $YES; 1167 1168 open STATUS, "<", $STATUS or (backport_usage, exit 1); 1169 1170 # Because we use the ':normal' command in Vim... 1171 die "A vim with the +ex_extra feature is required for --renormalize and " 1172 ."\$MAY_COMMIT modes" 1173 if ($renormalize or $MAY_COMMIT) and `${VIM} --version` !~ /[+]ex_extra/; 1174 1175 # ### TODO: need to run 'revert' here 1176 # ### TODO: both here and in merge(), unlink files that previous merges added 1177 # When running from cron, there shouldn't be local mods. (For interactive 1178 # usage, we preserve local mods to STATUS.) 1179 system("$SVN info $STATUS >/dev/null") == 0 1180 or die "$0: svn error; point \$SVN to an appropriate binary"; 1181 1182 check_local_mods_to_STATUS; 1183 renormalize_STATUS if $renormalize; 1184 1185 # Skip most of the file 1186 $/ = ""; # paragraph mode 1187 while (<STATUS>) { 1188 last if /^Status of \d+\.\d+/; 1189 } 1190 1191 $SIG{INT} = \&maybe_revert unless $YES; 1192 $SIG{TERM} = \&signal_handler unless $YES; 1193 1194 my $in_approved = 0; 1195 while (<STATUS>) { 1196 my $lines = $_; 1197 my @lines = split /\n/; 1198 1199 given ($lines[0]) { 1200 # Section header 1201 when (/^[A-Z].*:$/i) { 1202 say "\n\n\e\x5b33m\e\x5b1m=== $lines[0]\e\x5b0m" unless $YES; 1203 $in_approved = $lines[0] =~ /^Approved changes/; 1204 } 1205 # Comment 1206 when (/^[#\x5b]/i) { 1207 next; 1208 } 1209 # Separator after section header 1210 when (/^=+$/i) { 1211 break; 1212 } 1213 # Backport entry? 1214 when (/^ *\*/) { 1215 warn "Too many bullets in $lines[0]" and next 1216 if grep /^ *\*/, @lines[1..$#lines]; 1217 handle_entry $in_approved, \%approved, \%votes, $state, $lines, $., 1218 $skip, 1219 @lines; 1220 } 1221 default { 1222 warn "Unknown entry '$lines[0]'"; 1223 } 1224 } 1225 } 1226 1227 exit_stage_left $state, \%approved, \%votes; 1228} 1229 1230sub nominate_main { 1231 my $had_local_mods; 1232 1233 local $Text::Wrap::columns = 79; 1234 1235 $had_local_mods = check_local_mods_to_STATUS; 1236 1237 # Argument parsing. 1238 nominate_usage, exit 0 if @ARGV != 2; 1239 my (@revnums) = (+shift) =~ /(\d+)/g; 1240 my $justification = shift; 1241 1242 die "Unable to proceed." if warned_cannot_commit "Nominating failed"; 1243 1244 # To save typing, require just the last three digits if they're unambiguous. 1245 my $BASE_revision = `$SVN info --show-item=revision` + 0; 1246 if ($BASE_revision > 1000) { 1247 my $residue = $BASE_revision % 1000; 1248 my $thousands = $BASE_revision - $residue; 1249 @revnums = map { 1250 $_ >= 1000 1251 ? $_ 1252 : $thousands + $_ - 1000 * ($_ > $residue) 1253 } 1254 @revnums; 1255 } 1256 1257 # Deduplicate and sort 1258 @revnums = sort { $a <=> $b } keys %{{ map { $_ => 1 } @revnums }}; 1259 die "No revision numbers specified" unless @revnums; 1260 1261 # Determine whether a backport branch exists 1262 my ($URL) = `$SVN info` =~ /^URL: (.*)$/m; 1263 die "Can't retrieve URL of cwd" unless $URL; 1264 1265 die unless shell_safe_path_or_url $URL; 1266 system "$SVN info -- $URL-r$revnums[0] 2>/dev/null"; 1267 my $branch = ($? == 0) ? basename("$URL-r$revnums[0]") : undef; 1268 1269 # Construct entry. 1270 my $logmsg = `$SVN propget --revprop -r $revnums[0] --strict svn:log '^/'`; 1271 die "Can't fetch log message of r$revnums[0]: $!" unless $logmsg; 1272 1273 unless ($logmsg =~ s/^(.*?)\n\n.*/$1/s) { 1274 # "* file\n (symbol): Log message." 1275 1276 # Strip before and after the first symbol's log message. 1277 $logmsg =~ s/^.*?: //s; 1278 $logmsg =~ s/^ \x28.*//ms; 1279 1280 # Undo line wrapping. (We'll re-do it later.) 1281 $logmsg =~ s/\s*\n\s+/ /g; 1282 } 1283 1284 my @lines; 1285 warn "Wrapping [$logmsg]\n" if $DEBUG; 1286 push @lines, wrap " * ", ' 'x3, join ', ', map "r$_", @revnums; 1287 push @lines, wrap ' 'x3, ' 'x3, split /\n/, $logmsg; 1288 push @lines, " Justification:"; 1289 push @lines, wrap ' 'x5, ' 'x5, $justification; 1290 push @lines, " Branch: $branch" if defined $branch; 1291 push @lines, " Votes:"; 1292 push @lines, " +1: $AVAILID"; 1293 push @lines, ""; 1294 my $raw = join "", map "$_\n", @lines; 1295 1296 # Open the file in line-mode (not paragraph-mode). 1297 my @STATUS; 1298 tie @STATUS, "Tie::File", $STATUS, recsep => "\n"; 1299 my ($index) = grep { $STATUS[$_] =~ /^Veto|^Approved/ } (0..$#STATUS); 1300 die "Couldn't find where to add an entry" unless $index; 1301 1302 # Add an empty line if needed. 1303 if ($STATUS[$index-1] =~ /\S/) { 1304 splice @STATUS, $index, 0, ""; 1305 $index++; 1306 } 1307 1308 # Add the entry. 1309 splice @STATUS, $index, 0, @lines; 1310 1311 # Save. 1312 untie @STATUS; 1313 1314 # Done! 1315 system "$SVN diff -- $STATUS"; 1316 if (prompt "Commit this nomination? ") { 1317 my $header = join ', ', map "r$_", @revnums; 1318 system "$SVN commit -m '* STATUS: Nominate $header.' -- $STATUS"; 1319 exit $?; 1320 } 1321 elsif (!$had_local_mods or prompt "Revert STATUS (destroying local mods)? ") { 1322 # TODO: we could be smarter and just un-splice the lines we'd added. 1323 system "$SVN revert -- $STATUS"; 1324 exit $?; 1325 } 1326 1327 exit 0; 1328} 1329 1330# Dispatch to the appropriate main(). 1331given (basename($0)) { 1332 when (/^b$|backport/) { 1333 chdir dirname $0 or die "Can't chdir: $!" if /^b$/; 1334 &backport_main(@ARGV); 1335 } 1336 when (/^n$|nominate/) { 1337 chdir dirname $0 or die "Can't chdir: $!" if /^n$/; 1338 &nominate_main(@ARGV); 1339 } 1340 default { 1341 &backport_main(@ARGV); 1342 } 1343} 1344