trunk/src/echangelog/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 use File::Find;
  14 use Getopt::Long;
  15
  16 # Fix bug 21022 by restricting to C locale
  17 setlocale(&POSIX::LC_ALL, "C");
  18
  19 use Text::Wrap;
  20 $Text::Wrap::columns = 77;
  21 $Text::Wrap::unexpand = 0;
  22
  23 # Global variables
  24 my (@files, @ebuilds, @conflicts, @trivial, @unknown, @new_versions, %actions);
  25 my ($input, $editor, $entry, $user, $date, $text, $year, $vcs);
  26 my ($opt_help, $opt_strict, $opt_version);
  27
  28 $opt_help = 0;
  29 $opt_strict = 0;
  30 $opt_version = 0;
  31
  32 my %vcs = (
  33         cvs => {
  34                 diff => "cvs -f diff -U0",
  35                 status => "cvs -fn up",
  36                 add => "cvs -f add",
  37                 skip => 6,
  38                 regex => qr/^Index: (([^\/]*?)\.ebuild)\s*$/
  39         },
  40         svn => {
  41                 diff => "svn diff -N",
  42                 status => "svn status",
  43                 add => "svn add",
  44                 skip => 4,
  45                 regex => qr/^Index: (([^\/]*?)\.ebuild)\s*$/
  46         },
  47         git => {
  48                 diff => "git diff",
  49                 status => "git diff-index HEAD --name-status",
  50                 add => "git add",
  51                 # This value should usually be 3 but on new file mode we need skip+1.
  52                 # So 4 should be fine anyway.
  53                 skip => 4,
  54                 regex => qr/^diff \-\-git \S*\/((\S*)\.ebuild)/
  55         },
  56 );
  57
  58 sub usage {
  59         (my $usage = <<"        EOF") =~ s/^\t//gm;
  60         Usage: echangelog [options] <changelog message>
  61
  62         Options:
  63             --help      err, this screen ...
  64             --strict    abort on trivial/no changes
  65             --version   show version info
  66         EOF
  67         print $usage;
  68         exit 0;
  69 }
  70
  71 sub version {
  72         my $Revision = "Last svn change rev";
  73         my $Date = "Last svn change date";
  74         my $foo = "";
  75         print "echangelog\n$Revision$foo \n$Date$foo\n";
  76         exit 0;
  77 }
  78
  79 GetOptions(
  80         'help' => \$opt_help,
  81         'strict' => \$opt_strict,
  82         'version' => \$opt_version,
  83 );
  84
  85 usage() if $opt_help;
  86 version() if $opt_version;
  87
  88 # Figure out what kind of repo we are in.
  89 if ( -d "CVS" ) {
  90         $vcs = "cvs";
  91 } elsif ( -d '.svn' ) {
  92         $vcs = "svn";
  93 } elsif ( -f '/usr/bin/git' and open GIT, "git rev-parse --git-dir |" ) {
  94         $vcs = "git";
  95         close GIT;
  96 } else {
  97         die "No CVS, .git, .svn directories found, what kind of repo is this?";
  98 }
  99
 100 # Read the current ChangeLog
 101 if (-f 'ChangeLog') {
 102         open I, '<ChangeLog' or die "Can't open ChangeLog for input: $!\n";
 103         { local $/ = undef; $text = <I>; }
 104         close I;
 105 } else {
 106         # No ChangeLog here, maybe we should make one...
 107         if (<*.ebuild>) {
 108                 open C, "portageq envvar PORTDIR |" or die "Can't find PORTDIR";
 109                 my ($new) = <C>;
 110                 close C;
 111
 112                 $new =~ s/\s+$//;
 113                 open I, "< $new/skel.ChangeLog"
 114                         or die "Can't open $new/skel.ChangeLog for input: $!\n";
 115                 { local $/ = undef; $text = <I>; }
 116                 close I;
 117                 $text =~ s/^\*.*//ms;   # don't need the fake entry
 118         } else {
 119                 die "This should be run in a directory with ebuilds...\n";
 120         }
 121 }
 122
 123 # Figure out what has changed around here
 124 open C, $vcs{$vcs}{status}.' 2>&1 |' or die "Can't run ".$vcs{$vcs}{status}.": $!\n";
 125 while (<C>) {
 126         if (/^C\s+(\S+)/) {
 127                 if($vcs eq "git") {
 128                         my $filename = $2;
 129                         $filename =~ /\S*\/(\S*)/;
 130
 131                         if( -d $1 ) {
 132                                 next;
 133                         }
 134
 135                         push @conflicts, $1;
 136                         next;
 137                 }
 138
 139                 push @conflicts, $1;
 140                 next;
 141         } elsif (/^\?\s+(\S+)/) {
 142                 if($vcs eq "git") {
 143                         my $filename = $2;
 144                         $filename =~ /\S*\/(\S*)/;
 145
 146                         if( -d $1 ) {
 147                                 next;
 148                         }
 149
 150                         push @unknown, $1;
 151                         next;
 152                 } else {
 153                         push @unknown, $1;
 154                 }
 155
 156                 $actions{$1} = '+';
 157                 next;
 158         } elsif (/^([ARMD])\s+\+?\s*(\S+)/) {
 159                 my ($status, $filename) = ($1,$2);
 160
 161                 if($vcs eq "git") {
 162                         open P, "git rev-parse --sq --show-prefix |";
 163                         my $prefix = <P>;
 164                         $prefix = substr($prefix, 0, -1);
 165                         close P;
 166
 167                         if ($filename =~ /$prefix(\S*)/) {
 168                                 $filename = $1 ;
 169                         }
 170                         else {
 171                                 next;
 172                         }
 173                 }
 174
 175                 if( -d $filename ) {
 176                         next;
 177                 }
 178
 179                 push @files, $filename;
 180                 ($actions{$filename} = $status) =~ tr/DARM/-+-/d;
 181         }
 182 }
 183
 184 # git only shows files already added so we need to check for unknown files
 185 # separately here.
 186 if($vcs eq "git") {
 187         find(\&git_unknown_objects, "./");
 188 }
 189
 190 sub git_unknown_objects {
 191         my $object = $_;
 192         my ($dev,$ino,$mode,$nlink,$uid,$gid);
 193
 194         # Ignore empty directories - git doesn't version them and cvs removes them.
 195         if ( (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && ! -d _ ) {
 196                 open C, $vcs." status $_ 2>&1 1>/dev/null |";
 197
 198                 while (<C>) {
 199                         $_ = <C>;
 200                         push @unknown, $object;
 201                 };
 202
 203                 close C;
 204         };
 205 }
 206
 207 # Separate out the trivial files for now
 208 @files = grep {
 209         !/files.digest|Manifest|ChangeLog/ or do { push @trivial, $_; 0; }
 210 } @files;
 211
 212 @unknown = grep {
 213         !/files.digest|Manifest|ChangeLog/ or do { push @trivial, $_; 0; }
 214 } @unknown;
 215
 216 # Don't allow any conflicts
 217 if (@conflicts) {
 218         print STDERR <<EOT;
 219 $vcs reports the following conflicts.  Please resolve them before
 220 running echangelog.
 221 EOT
 222         print STDERR map "C $_\n", @conflicts;
 223         exit 1;
 224 }
 225
 226 # Don't allow unknown files (other than the trivial files that were separated
 227 # out above)
 228 if (@unknown) {
 229         print STDERR <<EOT;
 230 $vcs reports the following unknown files.  Please use "$vcs add" before
 231 running echangelog, or remove the files in question.
 232 EOT
 233         print STDERR map "? $_\n", @unknown;
 234         exit 1;
 235 }
 236
 237 # Sort the list of files as portage does.  None of the operations through
 238 # the rest of the script should break this sort.
 239 sub sortfunc($$) {
 240         my ($a, $b) = @_;
 241         (my $va = $a) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
 242         (my $vb = $b) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
 243         my ($na, $sa, $sna, $ra) = ($va =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
 244         my ($nb, $sb, $snb, $rb) = ($vb =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
 245         my (@na) = split /\.|(?<=\d)(?=[^\d\.])/, $na;
 246         my (@nb) = split /\.|(?<=\d)(?=[^\d\.])/, $nb;
 247         my $retval;
 248
 249         #
 250         # compare version numbers first
 251         #
 252         for (my $i = 0; defined $na[$i] or defined $nb[$i]; $i++) {
 253                 # def vs. undef
 254                 return +1 if defined $na[$i] and !defined $nb[$i];
 255                 return -1 if defined $nb[$i] and !defined $na[$i];
 256
 257                 # num vs. num
 258                 if ($na[$i] =~ /^\d/ and $nb[$i] =~ /^\d/) {
 259                         $retval = ($na[$i] <=> $nb[$i]);
 260                         return $retval if $retval;
 261                         next;
 262                 }
 263
 264                 # char vs. char
 265                 if ($na[$i] =~ /^\D/ and $nb[$i] =~ /^\D/) {
 266                         $retval = ($na[$i] cmp $nb[$i]);
 267                         return $retval if $retval;
 268                         next;
 269                 }
 270
 271                 # num vs. char
 272                 $retval = ($na[$i] =~ /\d/ and -1 or +1);
 273                 return $retval;
 274         }
 275
 276         #
 277         # compare suffix second
 278         #
 279         if (defined $sa and !defined $sb) {
 280                 return +2 if $sa eq "p";
 281                 return -2;
 282         }
 283         if (defined $sb and !defined $sa) {
 284                 return -3 if $sb eq "p";
 285                 return +3;
 286         }
 287
 288         if (defined $sa) { # and defined $sb
 289                 $retval = ($sa cmp $sb);
 290                 if ($retval) {
 291                         return +4 if $sa eq "p";
 292                         return -4 if $sb eq "p";
 293                         return $retval; # suffixes happen to be alphabetical order, mostly
 294                 }
 295
 296                 # compare suffix number
 297                 return +5 if defined $sna and !defined $snb;
 298                 return -5 if defined $snb and !defined $sna;
 299
 300                 if (defined $sna) {  # and defined $snb
 301                         $retval = ($sna <=> $snb);
 302                         return $retval if $retval;
 303                 }
 304         }
 305
 306         #
 307         # compare rev third
 308         #
 309         return +6 if defined $ra and !defined $rb;
 310         return -6 if defined $rb and !defined $ra;
 311
 312         if (defined $ra) { # and defined $rb
 313                 return ($ra <=> $rb);
 314         }
 315
 316         #
 317         # nothing left to compare
 318         #
 319         return 0;
 320 }
 321
 322 @files = sort sortfunc @files;
 323
 324 # Just to ensure we don't get duplicate entries.
 325 sub mypush(\@@) {
 326         my $aref = shift;
 327
 328         foreach my $value (@_) {
 329                 push(@{$aref}, $value) if !grep(/^$value$/, @{$aref});
 330         }
 331 }
 332
 333 # Forget ebuilds that only have changed copyrights, unless that's all
 334 # the changed files we have
 335
 336 @ebuilds = grep /\.ebuild$/, @files;
 337 @files = grep !/\.ebuild$/, @files;
 338
 339 if (@ebuilds) {
 340         if ($vcs eq "git") {
 341                 open C, $vcs{$vcs}{diff}." HEAD -- @ebuilds 2>&1 |" or die "Can't run: ".$vcs{$vcs}{diff}."$!\n";
 342         } else {
 343                 open C, $vcs{$vcs}{diff}." @ebuilds 2>&1 |" or die "Can't run: ".$vcs{$vcs}{diff}."$!\n";
 344         }
 345
 346         $_ = <C>;
 347
 348         while (defined $_) {
 349                 # only possible with cvs
 350                 if (/^$vcs diff: (([^\/]*?)\.ebuild) was removed/) {
 351                         mypush(@files, $1);
 352                 }
 353                 # We assume GNU diff output format here.
 354                 # git format: diff --git a/app-doc/repodoc/metadata.xml b/app-doc/repodoc/metadata.xml
 355                 elsif (/$vcs{$vcs}{regex}/) {
 356                         my $f = $1;
 357
 358                         if ($vcs eq "git") {
 359                                 my $version = $2;
 360
 361                                 while (<C>) {
 362                                         last if /^deleted file mode|^index/;
 363                                         if (/^new file mode/) {
 364                                                 mypush(@files, $f);
 365                                                 mypush(@new_versions, $version);
 366                                                 last;
 367                                         }
 368                                 }
 369                         }
 370
 371                         # check if more than just copyright date changed.
 372                         # skip some lines (vcs dependent)
 373                         foreach(1..$vcs{$vcs}{skip}) {
 374                                 $_ = <C>;
 375                         }
 376
 377                         while (<C>) {
 378                                 last if /^[A-Za-z]/;
 379                                 if (/^[-+](?!# Copyright)/) {
 380                                         mypush(@files, $f);
 381                                         last;
 382                                 }
 383                         }
 384
 385                         # at this point we've either added $f to @files or not,
 386                         # and we have the next line in $_ for processing
 387                         next;
 388                 }
 389                 elsif (/^$vcs.*?: (([^\/]*?)\.ebuild) is a new entry/) {
 390                         mypush(@files, $1);
 391                         mypush(@new_versions, $2);
 392                 }
 393
 394                 # other cvs output is ignored
 395                 $_ = <C>;
 396         }
 397 }
 398 close C;
 399
 400 # Subversion diff doesn't identify new versions. So use the status command
 401 if (($vcs eq "svn") and (@ebuilds)) {
 402         open C, $vcs{$vcs}{status}." @ebuilds 2>&1 |" or die "Can't run: ".$vcs{$vcs}{status}."$!\n";
 403         $_ = <C>;
 404
 405         while (defined $_) {
 406                 if (/^A\s+\+?\s*(([^\s]*)\.ebuild)/) {
 407                         mypush(@files, $1);
 408                         mypush(@new_versions, $2);
 409                 }
 410
 411                 $_ = <C>;
 412         }
 413 }
 414
 415 # When a package move occurs, the versions appear to be new even though they are
 416 # not.  Trim them from @new_versions in that case.
 417 @new_versions = grep { $text !~ /^\*\Q$_\E\s/m } @new_versions;
 418
 419 # Check if we have any files left, otherwise re-insert ebuild list
 420 # (of course, both might be empty anyway)
 421 @files = @ebuilds unless (@files);
 422
 423 # Allow ChangeLog entries with no changed files, but give a fat warning
 424 unless (@files) {
 425         print STDERR "**\n";
 426         print STDERR "** NOTE: No non-trivial changed files found.  Normally echangelog\n";
 427         print STDERR "** should be run after all affected files have been added and/or\n";
 428         print STDERR "** modified.  Did you forget to $vcs add?\n";
 429         print STDERR "**\n";
 430
 431         if ($opt_strict) {
 432                 print STDERR "** In strict mode, exiting\n";
 433                 exit 1;
 434         }
 435
 436         @files = sort sortfunc @trivial;
 437         @files = qw/ChangeLog/ unless @files;  # last resort to put something in the list
 438 }
 439
 440 # sort
 441 @files = sort sortfunc @files;
 442 @new_versions = sort sortfunc @new_versions;
 443
 444 # Get the input from the cmdline, editor or stdin
 445 if ($ARGV[0]) {
 446         $input = "@ARGV";
 447 } else {
 448         # Testing for defined() allows ECHANGELOG_EDITOR='' to cancel EDITOR
 449         $editor = defined($ENV{'ECHANGELOG_EDITOR'}) ? $ENV{'ECHANGELOG_EDITOR'} :
 450         $ENV{'EDITOR'} || undef;
 451
 452         if ($editor) {
 453                 system("$editor ChangeLog.new");
 454
 455                 if ($? != 0) {
 456                         # This usually happens when the editor got forcefully killed; and
 457                         # the terminal is probably messed up: so we reset things.
 458                         system('/usr/bin/stty sane');
 459                         print STDERR "Editor died!  Reverting to stdin method.\n";
 460                         undef $editor;
 461                 } else {
 462                         if (open I, "<ChangeLog.new") {
 463                                 local $/ = undef;
 464                                 $input = <I>;
 465                                 close I;
 466                         } else {
 467                                 print STDERR "Error opening ChangeLog.new: $!\n";
 468                                 print STDERR "Reverting to stdin method.\n";
 469                                 undef $editor;
 470                         }
 471
 472                         unlink 'ChangeLog.new';
 473                 }
 474         }
 475
 476         unless ($editor) {
 477                 print "Please type the log entry: use Ctrl-d to finish, Ctrl-c to abort...\n";
 478                 local $/ = undef;
 479                 $input = <>;
 480         }
 481 }
 482 die "Empty entry; aborting\n" unless $input =~ /\S/;
 483
 484 # If there are any long lines, then wrap the input at $columns chars
 485 # (leaving 2 chars on left, one char on right, after adding indentation below).
 486 $input =~ s/^\s*(.*?)\s*\z/$1/s;  # trim whitespace
 487 $input = Text::Wrap::fill('  ', '  ', $input);
 488
 489 # Prepend the user info to the input
 490 unless ($user = $ENV{'ECHANGELOG_USER'}) {
 491         my ($fullname, $username) = (getpwuid($<))[6,0];
 492         $fullname =~ s/,.*//;       # remove GECOS, bug 80011
 493         $user = sprintf "%s <%s\@gentoo.org>", $fullname, $username;
 494 }
 495
 496 # Make sure that we didn't get "root"
 497 die "Please set ECHANGELOG_USER or run as non-root\n" if $user =~ /<root@/;
 498
 499 $date = strftime("%d %b %Y", gmtime);
 500 $entry = "$date; $user ";
 501 $entry .= join ', ', map "$actions{$_}$_", @files;
 502 $entry .= ':';
 503 $entry = Text::Wrap::fill('  ', '  ', $entry); # does not append a \n
 504 $entry .= "\n$input";                          # append user input
 505
 506 # Each one of these regular expressions will eat the whitespace
 507 # leading up to the next entry (except the two-space leader on the
 508 # front of a dated entry), so it needs to be replaced with a
 509 # double carriage-return.  This helps to normalize the spacing in
 510 # the ChangeLogs.
 511 if (@new_versions) {
 512         # Insert at the top with a new version marker
 513         $text =~ s/^( .*? )               # grab header
 514         \s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
 515                 /"$1\n\n" .
 516                 join("\n", map "*$_ ($date)", reverse @new_versions) .
 517                 "\n\n$entry\n\n"/sxe
 518                         or die "Failed to insert new entry (4)\n";
 519 } else {
 520         # Changing an existing patch or ebuild, no new version marker
 521         # required
 522         $text =~ s/^( .*? )               # grab header
 523                 \s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
 524                 /$1\n\n$entry\n\n/sx
 525                         or die "Failed to insert new entry (3)\n";
 526 }
 527
 528 sub update_cat_pn {
 529         my ($t) = @_;
 530         my ($cwd) = getcwd();
 531
 532         $cwd =~ m|.*/(\w+-\w+\|virtual)/([^/]+)|
 533                 or die "Can't figure out category/package.. sorry!\n";
 534         my ($category, $package_name) = ($1, $2);
 535         $t =~ s/^(# ChangeLog for).*/$1 $category\/$package_name/;
 536
 537         return $t;
 538 }
 539
 540 # New packages and/or ones that have moved around often have stale data here.
 541 # But only do that in places where ebuilds are around (as echangelog can be
 542 # used in profiles/ and such places).
 543 if (grep(/\.ebuild$/, @files)) {
 544         $text = update_cat_pn($text);
 545 }
 546
 547 sub update_copyright {
 548         my ($t) = @_;
 549         (my $year = $date) =~ s/.* //;
 550
 551         $t =~ s/^# Copyright \d+(?= )/$&-$year/m or
 552         $t =~ s/^(# Copyright) \d+-(\d+)/$1 1999-$year/m;
 553
 554         return $t;
 555 }
 556
 557 # Update the copyright year in the ChangeLog
 558 $text = update_copyright($text);
 559
 560 # Write the new ChangeLog
 561 open O, '>ChangeLog.new' or die "Can't open ChangeLog.new for output: $!\n";
 562 print O $text            or die "Can't write ChangeLog.new: $!\n";
 563 close O                  or die "Can't close ChangeLog.new: $!\n";
 564
 565 # Update affected ebuild copyright dates.  There is no reason to update the
 566 # copyright lines on ebuilds that haven't changed.  I verified this with an IP
 567 # lawyer.
 568 for my $e (grep /\.ebuild$/, @files) {
 569         if (-s $e) {
 570                 my ($etext, $netext);
 571
 572                 open E, "<$e" or warn("Can't read $e to update copyright year\n"), next;
 573                 { local $/ = undef; $etext = <E>; }
 574                 close E;
 575
 576                 # Attempt the substitution and compare
 577                 $netext = update_copyright($etext);
 578                 next if $netext eq $etext; # skip this file if no change.
 579
 580                 # Write the new ebuild
 581                 open E, ">$e.new" or warn("Can't open $e.new\n"), next;
 582                 print E $netext and
 583                 close E or warn("Can't write $e.new\n"), next;
 584
 585                 # Move things around and show the diff
 586                 system "diff -U 0 $e $e.new";
 587                 rename "$e.new", $e or warn("Can't rename $e.new: $!\n");
 588         }
 589 }
 590
 591 # Move things around and show the ChangeLog diff
 592 system 'diff -Nu ChangeLog ChangeLog.new';
 593 rename 'ChangeLog.new', 'ChangeLog' or die "Can't rename ChangeLog.new: $!\n";
 594
 595 # Okay, now we have a starter ChangeLog to work with.
 596 # The text will be added just like with any other ChangeLog below.
 597 # Add the new ChangeLog to vcs before continuing.
 598 if ($vcs eq "cvs") {
 599         if (open F, "CVS/Entries") {
 600                 system("cvs -f add ChangeLog") unless (scalar grep /^\/ChangeLog\//, <F>);
 601         }
 602 } elsif ($vcs eq "svn") {
 603         if (open F, ".svn/entries") {
 604                 system("svn add ChangeLog") unless (scalar grep /ChangeLog/, <F>);
 605         }
 606 } else {
 607         system("$vcs{$vcs}{add} ChangeLog 2>&1 >> /dev/null");
 608 }
 609
 610 # vim: set ts=4 sw=4 tw=0: