xapian-maintainer-tools/svn-ci

   1 #! /usr/bin/perl -w
   2 # Wrap "svn ci" and help generate ChangeLog entries.
   3 #
   4 # This script takes an optional list of files and/or directories, just like
   5 # "svn ci".
   6 #
   7 # If you save this somewhere on your PATH, you can just run "svn-ci" instead
   8 # of "svn ci" when you want to check in a change to the Xapian tree.
   9
  10 require 5.000;
  11 use strict;
  12 use POSIX;
  13
  14 # Set these if you don't like the default values
  15 my $email;
  16 my $realname;
  17
  18 ###############################################################################
  19
  20 if (defined $ARGV[0] && $ARGV[0] eq '--help') {
  21     print <<END;
  22 Syntax: $0 [FILE]...
  23
  24 The default is to check in all changed files in the current directory or
  25 its subdirectories.
  26
  27 If there is no ChangeLog in the current directory, $0 will look for one
  28 in the parent directory and above.
  29
  30 If ChangeLog has already been updated and doesn't contain evidence of
  31 conflicts or diff fragments, check in the requested files plus ChangeLog.
  32
  33 If ChangeLog hasn't updated, a suitable entry header is prepended, plus
  34 the diffs between CVS and the files to be checked in, and the user is
  35 prompted to edit it.
  36
  37 If ChangeLog contains evidence of conflicts or diff fragments, the user
  38 is prompted to edit it.
  39 END
  40     exit 0;
  41 }
  42
  43 # Set default values if the user hasn't set their own above...
  44 my @passwd = getpwuid(getuid());
  45 unless ($email) {
  46     $email = $passwd[0];
  47     if ($email eq 'olly') {
  48         $email = 'olly@survex.com';
  49     } elsif ($email eq 'richard') {
  50         $email = 'richard@tartarus.org';
  51     } elsif ($email eq 'kosei') {
  52         $email = 'cou929@gmail.com';
  53     } else {
  54         my $host = `hostname -d`;
  55         chomp($host);
  56         $email = $passwd[0] . '@' . $host;
  57     }
  58 }
  59 $realname ||= (split /,/, $passwd[6])[0];
  60
  61 # Revert ChangeLog?
  62 my $revert_changelog = 0;
  63 if (scalar @ARGV && $ARGV[0] eq '--revert') {
  64     shift @ARGV;
  65     $revert_changelog = 1;
  66 }
  67
  68 # Backport?
  69 my $backport = 0;
  70 if (scalar @ARGV && $ARGV[0] eq '--backport') {
  71     shift @ARGV;
  72     my $left = (<ChangeLog.merge-left.r?*>)[0];
  73     my $right = (<ChangeLog.merge-right.r?*>)[0];
  74     if (defined $left && defined $right) {
  75         system "diff -c \Q$left\E \Q$right\E > ChangeLog.rej";
  76         system("svn", "revert", "ChangeLog");
  77         system("svn", "up");
  78     } elsif (! -f 'ChangeLog.rej') {
  79         die "--backport specified, but no svn merge telltales and no ChangeLog.rej\n";
  80     }
  81     $backport = 1;
  82 }
  83
  84 # Remove any trailing slashes on directories for consistency.
  85 @ARGV = map {s,/+$,,; $_} @ARGV;
  86
  87 if (! -f "ChangeLog") {
  88     my $path = "";
  89     for (reverse(split m!/!, getcwd())) {
  90         chdir "..";
  91         $path = "$_/$path";
  92         last if -f "ChangeLog";
  93     }
  94     if (scalar @ARGV) {
  95         @ARGV = map {$path.$_} @ARGV;
  96     } else {
  97         chop $path;
  98         push @ARGV, $path;
  99     }
 100 }
 101
 102 my $tmp = "ChangeLog.$$.new";
 103
 104 if (scalar @ARGV) {
 105    push @ARGV, "ChangeLog" unless grep {$_ eq "ChangeLog"} @ARGV;
 106 }
 107
 108 my $edit_cl = 0;
 109 my $add_diff = 1;
 110
 111 # FIXME: ought to search down and then up for one...
 112 # Searching down should check-in with the same message in each subdir
 113 # Searching up should check-in using the first changelog in a parent dir
 114 # but only files below this directory...
 115 if (! -f "ChangeLog") {
 116     die "No ChangeLog found in this directory or a parent directory!\n";
 117 }
 118 if ($revert_changelog) {
 119     system("svn revert ChangeLog");
 120 }
 121
 122 open I, "<ChangeLog" or die $!;
 123 while (<I>) {
 124     # conflicts, or diff fragments
 125     if (/^[-<>+]/) {
 126         $edit_cl = 1;
 127         $add_diff = 0;
 128         last;
 129     }
 130 }
 131 close I;
 132
 133 # See if the ChangeLog is in conflict, and automatically resolve it if it is.
 134 if (`svn status ChangeLog` =~ /^C/) {
 135     print "Automatically merging conflicts in 'ChangeLog'\n";
 136     system("svn resolved ChangeLog");
 137     open I, "<ChangeLog" or die $!;
 138     open O, ">ChangeLog.$$.tmp" or die $!;
 139     while (<I>) {
 140         # Strip out the conflict markers.
 141         next if /^[<=>]{7}/;
 142         print O $_;
 143     }
 144     close I;
 145     close O or die $!;
 146     rename "ChangeLog.$$.tmp", "ChangeLog" or die $!;
 147     $edit_cl = 1;
 148 }
 149
 150 if (!$edit_cl) {
 151     system("svn diff ChangeLog");
 152     my $exit = ($? >> 8);
 153     if ($exit != 0 && $exit != 1) {
 154         die "svn diff failed ($?)\n";
 155     }
 156     if ($exit == 0) {
 157         $edit_cl = 1;
 158     }
 159     if (!$edit_cl) {
 160         # FIXME: ChangeLog changed - check if they want to edit it ?
 161     }
 162 }
 163
 164 if ($edit_cl) {
 165     if ($backport) {
 166         open CHANGELOGREJ, 'ChangeLog.rej' or die $!;
 167         my $entry = '';
 168         my $change_count = 0;
 169         while (<CHANGELOGREJ>) {
 170             next unless s/^\+ //;
 171             if (/^[A-Z]/) {
 172                 ++$change_count;
 173                 next;
 174             }
 175             next if /^$/;
 176             $entry .= $_;
 177         }
 178         close CHANGELOGREJ;
 179         if ($change_count == 0) {
 180             die "No entries found in ChangeLog.rej!\n";
 181         }
 182         if ($change_count > 1) {
 183             $entry = "\t* Backport changes from trunk:\n".$entry;
 184         } else {
 185             $entry = "\t* Backport change from trunk:\n".$entry;
 186         }
 187         add_new_changelog_entry($entry);
 188     } elsif ($add_diff) {
 189         # ChangeLog unchanged - add diff to top
 190         open CI, "svn diff ".join(" ", map quotemeta, @ARGV)."|";
 191         my @files;
 192         my $diff = '';
 193         my $whitespace = '';
 194         my $fnm;
 195         # Property changes don't have an "Index: [...]" line.
 196         my $want_tabs = -1;
 197         while (<CI>) {
 198             $diff .= $_;
 199             if (/^Index: (.*)/) {
 200                 $fnm = $1;
 201                 push @files, $fnm;
 202                 if ($fnm =~ /\.(?:cc|[ch])$/) {
 203                     $want_tabs = 1;
 204                 } elsif ($fnm =~ /\.py(?:\.in)?$/) {
 205                     $want_tabs = 0;
 206                 } else {
 207                     # Don't know!
 208                     $want_tabs = -1;
 209                 }
 210             } elsif (/^\+.*[ \t]$/) {
 211                 $whitespace .= $fnm;
 212                 $whitespace .= ": added/changed line has trailing whitespace:\n";
 213                 $whitespace .= $_;
 214             } elsif (/^\+.* \t/) {
 215                 $whitespace .= $fnm;
 216                 $whitespace .= ": added/changed line has space before tab:\n";
 217                 $whitespace .= $_;
 218             } elsif ($want_tabs == 1 and /^\+\t* {8}/) {
 219                 $whitespace .= $fnm;
 220                 $whitespace .= ": added/changed line uses spaces for indentation rather than tab:\n";
 221                 $whitespace .= $_;
 222             } elsif (!$want_tabs and /^\+ *\t/) {
 223                 $whitespace .= $fnm;
 224                 $whitespace .= ": added/changed line uses tab for indentation rather than spaces:\n";
 225                 $whitespace .= $_;
 226             }
 227         }
 228         my $d = "";
 229         my @newfiles;
 230         my @d;
 231         for (sort @files) {
 232             my $dir = $d;
 233             if (m!^(.+/)!) {
 234                 $d = $1;
 235                 if ($d eq $dir) {
 236                     push @d, $_;
 237                     next;
 238                 }
 239             } else {
 240                 $d = "";
 241             }
 242             if (scalar @d > 3 && length $dir) {
 243                 push @newfiles, $dir;
 244             } else {
 245                 push @newfiles, @d;
 246             }
 247             if (length $d) {
 248                 @d = ($_);
 249             } else {
 250                 @d = ();
 251                 push @newfiles, $_;
 252             }
 253         }
 254         if (scalar @d > 3) {
 255             push @newfiles, $d;
 256         } else {
 257             push @newfiles, @d;
 258         }
 259         if (scalar @newfiles == 0) {
 260             die "No modified files found to commit!\n";
 261         }
 262         my $filelist = "\t* ";
 263         my $line = join ',', @newfiles;
 264         while (length($line) >= 68 && $line =~ s/^(.{1,68},)//) {
 265             $filelist .= "$1\n\t  ";
 266         }
 267         $diff = "$filelist$line:\n\n$whitespace\n$diff";
 268         add_new_changelog_entry($diff);
 269     }
 270     system(($ENV{VISUAL}||$ENV{EDITOR}||'vi'), "ChangeLog");
 271     ($? >> 8 == 0) || die "$?\n";
 272     if ($backport) {
 273         unlink "ChangeLog.rej";
 274     }
 275 }
 276
 277 my $msg = '';
 278
 279 open CI, "<ChangeLog" or die $!;
 280 while (<CI>) {
 281     # conflicts, or diff fragments
 282     if (/^[-<+]/) {
 283         bad_cl();
 284     }
 285     last if /^$/;
 286 }
 287 while (<CI>) {
 288     # conflicts, or diff fragments
 289     if (/^[-<+]/) {
 290         bad_cl();
 291     }
 292     last if /^\w/;
 293     $msg .= $_;
 294 }
 295 while (<CI>) {
 296     # conflicts, or diff fragments
 297     if (/^[-<+]/) {
 298         bad_cl();
 299     }
 300 }
 301 close CI;
 302 $msg =~ s/\s+$//s;
 303 $msg =~ s/^\s+(?:\* \b)?//mg;
 304 die "No changelog entry" if length($msg) == 0;
 305 my $newclentry = "ChangeLog.newentry.$$";
 306 open M, ">$newclentry" or die $!;
 307 print M $msg;
 308 close M;
 309 # Use a temporary file and -F rather than -m to avoid any risk of overflowing
 310 # limits on command line length.
 311 system("svn", "ci", "-F", $newclentry, @ARGV);
 312 unlink $newclentry;
 313
 314 sub add_new_changelog_entry {
 315     my ($entry) = @_;
 316     open CO, ">$tmp" or die $!;
 317     print CO strftime("%a %h %d %H:%M:%S GMT %Y", gmtime);
 318     print CO "  $realname <$email>\n\n";
 319     print CO "$entry\n";
 320     open CI, "<ChangeLog" or die $!;
 321     while (<CI>) {
 322         print CO;
 323     }
 324     close CI;
 325     close CO;
 326     rename $tmp, "ChangeLog";
 327 }
 328
 329 sub bad_cl {
 330     if (/^</) {
 331         print STDERR "Unresolved conflicts in ChangeLog\n";
 332     } else {
 333         print STDERR "Diff fragments in ChangeLog\n";
 334     }
 335     print STDERR "Rerunning the ci command will give you a chance to edit ChangeLog\n";
 336     exit 1;
 337 }