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