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