Pileus Git - ~andy/sunrise/blob - scripts/echangelog

   1 #!/usr/bin/perl -w
   2 #
   3 # echangelog: Update the ChangeLog for an ebuild.  For example:
   4 #
   5 #   $ echangelog 'Add ~alpha to KEYWORDS'
   6 #   4a5,7
   7 #   >   10 Feb 2003; Aron Griffis <agriffis@gentoo.org> oaf-0.6.8-r1.ebuild :
   8 #   >   Add ~alpha to KEYWORDS
   9 #   >
  10
  11 use strict;
  12 use POSIX qw(strftime getcwd setlocale);
  13
  14 # Fix bug 21022 by restricting to C locale
  15 setlocale(&POSIX::LC_ALL, "C");
  16
  17 use Text::Wrap;
  18 $Text::Wrap::columns = 77;
  19 $Text::Wrap::unexpand = 0;
  20
  21 # Global variables
  22 my (@files, @ebuilds, @conflicts, @trivial, @unknown, @new_versions, %actions);
  23 my ($input, $editor, $entry, $user, $date, $text, $version, $year, $vcs);
  24
  25 my %vcs =     ( cvs => { diff => "cvs -f -U0 diff",
  26                          status => "cvs -fn up",
  27                          add => "cvs -f add",
  28                          skip => 6,
  29                          entries => "CVS/Entries" },
  30                 svn => { diff => "svn diff -N",
  31                          status => "svn status",
  32                          add => "svn add",
  33                          skip => 4,
  34                          entries => ".svn/entries" },
  35                 git => { diff => "git diff",
  36                          status => "git up",
  37                          add => "git add",
  38                          skip => 0,
  39                          entries => "wtf" },
  40                 nov => { diff => "",
  41                          status => "",
  42                          add => "",
  43                          skip => 0,
  44                          entries => "wtf" }
  45 );
  46
  47 # Figure out what kind of repo we are in.
  48
  49 if ( -d "CVS" ) {
  50    $vcs = "cvs";
  51 } elsif ( -d '.svn' ) {
  52     $vcs = "svn";
  53 } elsif ( -d '.git' ) {
  54     $vcs = "git";
  55 } else {
  56     print STDERR "** NOTE: No CVS, .git, .svn directories found, cannot know modifications\n";
  57     $vcs = "nov";
  58 }
  59
  60 # Read the current ChangeLog
  61 if (-f 'ChangeLog') {
  62     open I, '<ChangeLog' or die "Can't open ChangeLog for input: $!\n";
  63     { local $/ = undef; $text = <I>; }
  64     close I;
  65 } else {
  66     # No ChangeLog here, maybe we should make one...
  67     if (<*.ebuild>) {
  68         open I, '<../../skel.ChangeLog'
  69             or die "Can't open ../../skel.ChangeLog for input: $!\n";
  70         { local $/ = undef; $text = <I>; }
  71         close I;
  72         my ($cwd) = getcwd();
  73         $cwd =~ m|.*/(\w+-\w+)/([^/]+)|
  74             or die "Can't figure out category/package.. sorry!\n";
  75         my ($category, $package_name) = ($1, $2);
  76         $text =~ s/^\*.*//ms;   # don't need the fake entry
  77         $text =~ s/<CATEGORY>/$category/;
  78         $text =~ s/<PACKAGE_NAME>/$package_name/;
  79     } else {
  80         die "This should be run in a directory with ebuilds...\n";
  81     }
  82 }
  83
  84 # Figure out what has changed around here
  85 open C, $vcs{$vcs}{status}.' 2>&1 |' or die "Can't run ".$vcs{$vcs}{status}.": $!\n";
  86 while (<C>) {
  87     if (/^C\s+\+?\s+(\S+)/) {
  88         push @conflicts, $1;
  89         next;
  90     } elsif (/^\?\s+\+?\s+(\S+)/) {
  91         push @unknown, $1;
  92         $actions{$1} = '+';
  93         next;
  94     } elsif (/^([ARMD])\s+\+?\s+(\S+)/) {
  95         push @files, $2;
  96         ($actions{$2} = $1) =~ tr/ARDM/+--/d;
  97     }
  98 }
  99
 100 # Separate out the trivial files for now
 101 @files = grep {
 102     !/files.digest|Manifest|ChangeLog|^files$|^\.$/ or do { push @trivial, $_; 0; }
 103 } @files;
 104
 105 @unknown = grep {
 106     !/files.digest|Manifest|ChangeLog|^files$|^\.$/ or do { push @trivial, $_; 0; }
 107 } @unknown;
 108
 109 # Don't allow any conflicts
 110 if (@conflicts) {
 111     print STDERR <<EOT;
 112 $vcs reports the following conflicts.  Please resolve them before
 113 running echangelog.
 114 EOT
 115     print STDERR map "C $_\n", @conflicts;
 116     exit 1;
 117 }
 118
 119 # Don't allow unknown files (other than the trivial files that were separated
 120 # out above)
 121 if (@unknown) {
 122     print STDERR <<EOT;
 123 $vcs reports the following unknown files.  Please use "cvs add" before
 124 running echangelog, or remove the files in question.
 125 EOT
 126     print STDERR map "? $_\n", @unknown;
 127     exit 1;
 128 }
 129
 130 # Sort the list of files as portage does.  None of the operations through
 131 # the rest of the script should break this sort.
 132 sub sortfunc($$) {
 133     my ($a, $b) = @_;
 134     (my $va = $a) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
 135     (my $vb = $b) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
 136     my ($na, $sa, $sna, $ra) = ($va =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
 137     my ($nb, $sb, $snb, $rb) = ($vb =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
 138     my (@na) = split /\.|(?<=\d)(?=[^\d\.])/, $na;
 139     my (@nb) = split /\.|(?<=\d)(?=[^\d\.])/, $nb;
 140     my $retval;
 141
 142     #
 143     # compare version numbers first
 144     #
 145     for (my $i = 0; defined $na[$i] or defined $nb[$i]; $i++) {
 146         # def vs. undef
 147         return +1 if defined $na[$i] and !defined $nb[$i];
 148         return -1 if defined $nb[$i] and !defined $na[$i];
 149
 150         # num vs. num
 151         if ($na[$i] =~ /^\d/ and $nb[$i] =~ /^\d/) {
 152             $retval = ($na[$i] <=> $nb[$i]);
 153             return $retval if $retval;
 154             next;
 155         }
 156
 157         # char vs. char
 158         if ($na[$i] =~ /^\D/ and $nb[$i] =~ /^\D/) {
 159             $retval = ($na[$i] cmp $nb[$i]);
 160             return $retval if $retval;
 161             next;
 162         }
 163
 164         # num vs. char
 165         $retval = ($na[$i] =~ /\d/ and -1 or +1);
 166         return $retval;
 167     }
 168
 169     #
 170     # compare suffix second
 171     #
 172     if (defined $sa and !defined $sb) {
 173         return +2 if $sa eq "p";
 174         return -2;
 175     }
 176     if (defined $sb and !defined $sa) {
 177         return -3 if $sb eq "p";
 178         return +3;
 179     }
 180
 181     if (defined $sa) {  # and defined $sb
 182         $retval = ($sa cmp $sb);
 183         if ($retval) {
 184             return +4 if $sa eq "p";
 185             return -4 if $sb eq "p";
 186             return $retval; # suffixes happen to be alphabetical order, mostly
 187         }
 188
 189         # compare suffix number
 190         return +5 if defined $sna and !defined $snb;
 191         return -5 if defined $snb and !defined $sna;
 192         if (defined $sna) {  # and defined $snb
 193             $retval = ($sna <=> $snb);
 194             return $retval if $retval;
 195         }
 196     }
 197
 198     #
 199     # compare rev third
 200     #
 201     return +6 if defined $ra and !defined $rb;
 202     return -6 if defined $rb and !defined $ra;
 203     if (defined $ra) {  # and defined $rb
 204         return ($ra <=> $rb);
 205     }
 206
 207     #
 208     # nothing left to compare
 209     #
 210     return 0;
 211 }
 212 @files = sort sortfunc @files;
 213
 214 # Forget ebuilds that only have changed copyrights, unless that's all
 215 # the changed files we have
 216 # does not work with svn TODO
 217 #@ebuilds = grep /\.ebuild$/, @files;
 218 #@files = grep !/\.ebuild$/, @files;
 219
 220 if (@ebuilds) {
 221     open C, $vcs{$vcs}{diff}.@ebuilds." 2>&1 |" or die "Can't run: ".$vcs{$vcs}{diff}."$!\n";
 222     $_ = <C>;
 223     while (defined $_) {
 224         if (/^$vcs diff: (([^\/]*?)\.ebuild) was removed/) {
 225             push @files, $1;
 226         }
 227         elsif (/^Index: (([^\/]*?)\.ebuild)\s*$/) {
 228             my ($f, $v) = ($1, $2);
 229             # check if more than just copyright date changed.
 230             # skip some lines
 231             foreach(1..$vcs{$vcs}{skip}){
 232                     $_ = <C>;
 233             }
 234             while (<C>) {
 235                 last if /^[A-Za-z]/;
 236                 if (/^[-+](?!# Copyright)/) {
 237                     push @files, $f;
 238                     last;
 239                 }
 240             }
 241             # at this point we've either added $f to @files or not,
 242             # and we have the next line in $_ for processing
 243             next;
 244         }
 245         elsif (/^$vcs.*?: (([^\/]*?)\.ebuild) is a new entry/) {
 246             push @files, $1;
 247             push @new_versions, $2;  # new ebuild, will create a new entry
 248         }
 249         # other cvs output is ignored
 250         $_ = <C>;
 251     }
 252 }
 253 close C;
 254
 255 # When a package move occurs, the versions appear to be new even though they are
 256 # not.  Trim them from @new_versions in that case.
 257 @new_versions = grep { $text !~ /^\*\Q$_\E\s/m } @new_versions;
 258
 259 # Check if we have any files left, otherwise re-insert ebuild list
 260 # (of course, both might be empty anyway)
 261 @files = @ebuilds unless (@files);
 262
 263 # Allow ChangeLog entries with no changed files, but give a fat warning
 264 unless (@files) {
 265     print STDERR "**\n";
 266     print STDERR "** NOTE: No non-trivial changed files found.  Normally echangelog\n";
 267     print STDERR "** should be run after all affected files have been added and/or\n";
 268     print STDERR "** modified.  Did you forget to cvs add?\n";
 269     print STDERR "**\n";
 270     @files = sort sortfunc @trivial;
 271     @files = qw/ChangeLog/ unless @files;  # last resort to put something in the list
 272 }
 273
 274 # Get the input from the cmdline, editor or stdin
 275 if ($ARGV[0]) {
 276     $input = "@ARGV";
 277 } else {
 278     # Testing for defined() allows ECHANGELOG_EDITOR='' to cancel EDITOR
 279     $editor = defined($ENV{'ECHANGELOG_EDITOR'}) ? $ENV{'ECHANGELOG_EDITOR'} :
 280         $ENV{'EDITOR'} || undef;
 281     if ($editor) {
 282         system("$editor ChangeLog.new");
 283         if ($? != 0) {
 284             # This usually happens when the editor got forcefully killed; and
 285             # the terminal is probably messed up: so we reset things.
 286             system('/usr/bin/stty sane');
 287             print STDERR "Editor died!  Reverting to stdin method.\n";
 288             undef $editor;
 289         } else {
 290             if (open I, "<ChangeLog.new") {
 291                 local $/ = undef;
 292                 $input = <I>;
 293                 close I;
 294             } else {
 295                 print STDERR "Error opening ChangeLog.new: $!\n";
 296                 print STDERR "Reverting to stdin method.\n";
 297                 undef $editor;
 298             }
 299             unlink 'ChangeLog.new';
 300         }
 301     }
 302     unless ($editor) {
 303         print "Please type the log entry: use Ctrl-d to finish, Ctrl-c to abort...\n";
 304         local $/ = undef;
 305         $input = <>;
 306     }
 307 }
 308 die "Empty entry; aborting\n" unless $input =~ /\S/;
 309
 310 # If there are any long lines, then wrap the input at $columns chars
 311 # (leaving 2 chars on left, one char on right, after adding indentation below).
 312 $input =~ s/^\s*(.*?)\s*\z/$1/s;  # trim whitespace
 313 $input = Text::Wrap::fill('', '', $input) if ($input =~ /^.{80}/m);
 314 $input =~ s/^/  /gm;        # add indentation
 315
 316 # Prepend the user info to the input
 317 unless ($user = $ENV{'ECHANGELOG_USER'}) {
 318     my ($fullname, $username) = (getpwuid($<))[6,0];
 319     $fullname =~ s/,.*//;       # remove GECOS, bug 80011
 320     $user = sprintf "%s <%s\@gentoo.org>", $fullname, $username;
 321 }
 322 # Make sure that we didn't get "root"
 323 die "Please set ECHANGELOG_USER or run as non-root\n" if $user =~ /<root@/;
 324 $date = strftime("%d %b %Y", gmtime);
 325 $entry = "$date; $user ";
 326 $entry .= join ', ', map "$actions{$_}$_", @files;
 327 $entry .= ':';
 328 $entry = Text::Wrap::fill('  ', '  ', $entry);  # does not append a \n
 329 $entry .= "\n$input";                           # append user input
 330
 331 # Each one of these regular expressions will eat the whitespace
 332 # leading up to the next entry (except the two-space leader on the
 333 # front of a dated entry), so it needs to be replaced with a
 334 # double carriage-return.  This helps to normalize the spacing in
 335 # the ChangeLogs.
 336 if (@new_versions) {
 337     # Insert at the top with a new version marker
 338     $text =~ s/^( .*? )               # grab header
 339                \s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
 340     /"$1\n\n" .
 341      join("\n", map "*$_ ($date)", reverse @new_versions) .
 342      "\n\n$entry\n\n"/sxe
 343         or die "Failed to insert new entry (4)\n";
 344 } else {
 345     # Changing an existing patch or ebuild, no new version marker
 346     # required
 347     $text =~ s/^( .*? )               # grab header
 348                \s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
 349     /$1\n\n$entry\n\n/sx
 350         or die "Failed to insert new entry (3)\n";
 351 }
 352
 353 sub update_copyright {
 354     my ($t) = @_;
 355     (my $year = $date) =~ s/.* //;
 356     $t =~ s/^# Copyright \d+(?= )/$&-$year/m or
 357     $t =~ s/^(# Copyright \d+)-(\d+)/$1-$year/m;
 358     return $t;
 359 }
 360
 361 # Update the copyright year in the ChangeLog
 362 $text = update_copyright($text);
 363
 364 # Write the new ChangeLog
 365 open O, '>ChangeLog.new' or die "Can't open ChangeLog.new for output: $!\n";
 366 print O $text            or die "Can't write ChangeLog.new: $!\n";
 367 close O                  or die "Can't close ChangeLog.new: $!\n";
 368
 369 # Update affected ebuild copyright dates.  There is no reason to update the
 370 # copyright lines on ebuilds that haven't changed.  I verified this with an IP
 371 # lawyer.
 372 for my $e (grep /\.ebuild$/, @files) {
 373     my ($etext, $netext);
 374     open E, "<$e" or warn("Can't read $e to update copyright year\n"), next;
 375     { local $/ = undef; $etext = <E>; }
 376     close E;
 377
 378     # Attempt the substitution and compare
 379     $netext = update_copyright($etext);
 380     next if $netext eq $etext; # skip this file if no change.
 381
 382     # Write the new ebuild
 383     open E, ">$e.new" or warn("Can't open $e.new\n"), next;
 384     print E $netext and
 385     close E or warn("Can't write $e.new\n"), next;
 386
 387     # Move things around and show the diff
 388     system "diff -U 0 $e $e.new";
 389     rename "$e.new", $e or warn("Can't rename $e.new: $!\n");
 390 }
 391
 392 # Move things around and show the ChangeLog diff
 393 system 'diff -Nu ChangeLog ChangeLog.new';
 394 rename 'ChangeLog.new', 'ChangeLog' or die "Can't rename ChangeLog.new: $!\n";
 395
 396 # Okay, now we have a starter ChangeLog to work with.
 397 # The text will be added just like with any other ChangeLog below.
 398 # Add the new ChangeLog to cvs before continuing.
 399 if (open F, $vcs{$vcs}{entries} ) {
 400     system("$vcs{$vcs}{add} ChangeLog") unless (scalar grep /\/?ChangeLog\/?/, <F>);
 401 }
 402
 403 # vim:sw=4 ts=8 expandtab