3 # debchange: update the debian changelog using your favorite visual editor
4 # For options, see the usage message below.
6 # When creating a new changelog section, if either of the environment
7 # variables DEBEMAIL or EMAIL is set, debchange will use this as the
8 # uploader's email address (with the former taking precedence), and if
9 # DEBFULLNAME or NAME is set, it will use this as the uploader's full name.
10 # Otherwise, it will take the standard values for the current user or,
11 # failing that, just copy the values from the previous changelog entry.
13 # Originally by Christoph Lameter <clameter@debian.org>
14 # Modified extensively by Julian Gilbey <jdg@debian.org>
16 # Copyright 1999-2005 by Julian Gilbey
18 # This program is free software; you can redistribute it and/or modify
19 # it under the terms of the GNU General Public License as published by
20 # the Free Software Foundation; either version 2 of the License, or
21 # (at your option) any later version.
23 # This program is distributed in the hope that it will be useful,
24 # but WITHOUT ANY WARRANTY; without even the implied warranty of
25 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 # GNU General Public License for more details.
28 # You should have received a copy of the GNU General Public License
29 # along with this program; if not, write to the Free Software
30 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
32 use 5.008; # We're using PerlIO layers
34 use open ':utf8'; # changelogs are written with UTF-8 encoding
35 use filetest 'access'; # use access rather than stat for -w
36 use Encode 'decode_utf8'; # for checking whether user names are valid
43 # Load the URI::Escape module safely
44 eval { require URI::Escape; };
46 my $progname = basename $0;
47 if ($@ =~ /^Can\'t locate URI\/Escape\.pm/) {
48 die "$progname: you must have the liburi-perl package installed\nto use this script\n";
50 die "$progname: problem loading the URI::Escape module:\n $@\nHave you installed the liburi-perl package?\n";
55 # Predeclare functions
59 # And global variables
60 my $progname = basename($0);
61 my $modified_conf_msg;
63 my $CHGLINE; # used by the format O section at the end
67 Usage: $progname [options] [changelog entry]
70 Append a new entry to the current changelog
72 Increase the Infobot release number, adding a new changelog entry
73 -v <version>, --newversion=<version>
74 Add a new changelog entry with version number specified
76 Don't change version number or add a new changelog entry, just
77 update the changelog's stamp and open up an editor
79 Update the changelog timestamp.
81 Add a new changelog entry with version taken from the directory name
83 Preserve the directory name
85 Do not preserve the directory name (default)
87 Display this help message and exit
89 Display version information
90 At most one of -a, -i, -e, -r, -v, -d (or their long equivalents)
92 With no options, one of -i or -a is chosen by looking for a .upload
93 file in the parent directory and checking its contents.
95 Default settings modified by devscripts configuration files:
102 This is $progname, ripped from the Debian devscripts package, version 2.10.9
103 This code is copyright 1999-2003 by Julian Gilbey, all rights reserved.
104 Based on code by Christoph Lameter.
105 This program comes with ABSOLUTELY NO WARRANTY.
106 You are free to redistribute this code under the terms of the
107 GNU General Public License, version 2 or later.
111 # Start by setting default values
112 my $check_dirname_level = 1;
113 my $check_dirname_regex = 'PACKAGE(-.*)?';
116 my $opt_release_heuristic = 'log';
117 my $opt_multimaint = 1;
118 my $opt_multimaint_merge = 0;
120 my $opt_mainttrailer = 0;
122 # Next, read configuration files and then command line
123 # The next stuff is boilerplate
125 if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
126 $modified_conf_msg = " (no configuration files read)";
129 my @config_files = ('~/.infobot-dev.conf');
131 'CHANGE_PRESERVE' => 'no',
132 'CHANGE_TZ' => $ENV{TZ}, # undef if TZ unset
134 $config_vars{'CHANGE_TZ'} ||= '';
135 my %config_default = %config_vars;
139 foreach my $var (keys %config_vars) {
140 $shell_cmd .= qq[$var="$config_vars{$var}";\n];
142 $shell_cmd .= 'for file in ' . join(" ",@config_files) . "; do\n";
143 $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
145 foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
146 my $shell_out = `/bin/bash -c '$shell_cmd'`;
147 @config_vars{keys %config_vars} = split /\n/, $shell_out, -1;
150 $config_vars{'CHANGE_PRESERVE'} =~ /^(yes|no)$/
151 or $config_vars{'CHANGE_PRESERVE'}='no';
153 foreach my $var (sort keys %config_vars) {
154 if ($config_vars{$var} ne $config_default{$var}) {
155 $modified_conf_msg .= " $var=$config_vars{$var}\n";
158 $modified_conf_msg ||= " (none)\n";
159 chomp $modified_conf_msg;
161 $opt_p = $config_vars{'CHANGE_PRESERVE'} eq 'yes' ? 1 : 0;
162 $opt_tz = $config_vars{'CHANGE_TZ'};
165 # We use bundling so that the short option behaviour is the same as
166 # with older debchange versions.
167 my ($opt_help, $opt_version);
168 my ($opt_i, $opt_a, $opt_e, $opt_r, $opt_v, $opt_b, $opt_d, $opt_D, $opt_u, $opt_t);
169 my ($opt_n, $opt_qa, $opt_bpo, $opt_c, $opt_m, $opt_create, $opt_package, @closes);
171 my ($opt_ignore, $opt_level, $opt_regex, $opt_noconf);
173 Getopt::Long::Configure('bundling');
174 GetOptions("help|h" => \$opt_help,
175 "version" => \$opt_version,
176 "i|increment" => \$opt_i,
177 "a|append" => \$opt_a,
179 "r|release" => \$opt_r,
180 "v|newversion=s" => \$opt_v,
182 "preserve!" => \$opt_p,
183 "release-heuristic=s" => \$opt_release_heuristic,
185 or die "Usage: $progname [options] [changelog entry]\nRun $progname --help for more details\n";
188 fatal "--no-conf is only acceptable as the first command-line option!";
190 if ($opt_help) { usage; exit 0; }
191 if ($opt_version) { version; exit 0; }
195 fatal "--ignore-dirname has been replaced by --check-dirname-level and\n--check-dirname-regex; run $progname --help for more details";
198 if (defined $opt_level) {
199 if ($opt_level =~ /^[012]$/) { $check_dirname_level = $opt_level; }
201 fatal "Unrecognised --check-dirname-level value (allowed are 0,1,2)";
205 if (defined $opt_regex) { $check_dirname_regex = $opt_regex; }
207 # Only allow at most one non-help option
208 fatal "Only one of -a, -i, -e, -r, -v, -d is allowed;\ntry $progname --help for more help"
209 if ($opt_i?1:0) + ($opt_a?1:0) + ($opt_e?1:0) + ($opt_r?1:0) + ($opt_v?1:0) + ($opt_d?1:0) + ($opt_n?1:0) + ($opt_qa?1:0) + ($opt_bpo?1:0) > 1;
211 my $changelog_path = $opt_c || $ENV{'CHANGELOG'} || 'Changelog';
212 my $real_changelog_path = $changelog_path;
213 if ($changelog_path ne 'Changelog') {
214 $check_dirname_level = 0;
218 if ($opt_a || $opt_i || $opt_e || $opt_r || $opt_b || $opt_n || $opt_qa || $opt_bpo) {
219 warn "$progname warning: ignoring -a/-i/-e/-r/-b/-n/--qa/--bpo options with --create\n";
222 if ($opt_package && $opt_d) {
223 fatal "Can only use one of --package and -d";
228 @closes = split(/,/, join(',', @closes));
229 map { s/^\#//; } @closes; # remove any leading # from bug numbers
231 # We'll process the rest of the command line later.
233 # Look for the changelog
236 if ($changelog_path eq 'Changelog' or $opt_news) {
237 until (-f $changelog_path) {
239 chdir '..' or fatal "Can't chdir ..: $!";
241 fatal "Cannot find $changelog_path anywhere!\nAre you in the source code tree?\n(You could use --create if you wish to create this file.)";
245 # Can't write, so stop now.
246 if (! -w $changelog_path) {
247 fatal "$changelog_path is not writable!";
251 unless (-f $changelog_path) {
252 fatal "Cannot find $changelog_path!\nAre you in the correct directory?\n(You could use --create if you wish to create this file.)";
255 # Can't write, so stop now.
256 if (! -w $changelog_path) {
257 fatal "$changelog_path is not writable!";
262 unless (-d dirname $changelog_path) {
263 fatal "Cannot find " . (dirname $changelog_path) . " directory!\nAre you in the correct directory?";
265 if (-f $changelog_path) {
266 fatal "File $changelog_path already exists!";
268 unless (-w dirname $changelog_path) {
269 fatal "Cannot find " . (dirname $changelog_path) . " directory!\nAre you in the correct directory?";
271 if ($opt_news && ! -f 'debian/changelog') {
272 fatal "I can't create $opt_news without debian/changelog present";
278 # Find the current version number etc.
280 my $PACKAGE = 'PACKAGE';
281 my $VERSION = 'VERSION';
282 my $MAINTAINER = 'MAINTAINER';
284 my $DISTRIBUTION = 'UNRELEASED';
287 # Clean up after old versions of debchange
288 if (-f "debian/RELEASED") {
289 unlink("debian/RELEASED");
292 if ( -e "$changelog_path.clg" ) {
293 fatal "The backup file $changelog_path.clg already exists --\n" .
294 "please move it before trying again";
298 # Is this a native Debian package, i.e., does it have a - in the
300 (my $EPOCH) = ($VERSION =~ /^(\d+):/);
301 (my $SVERSION=$VERSION) =~ s/^\d+://;
302 (my $UVERSION=$SVERSION) =~ s/-[^-]*$//;
304 # Check, sanitise and decode these environment variables
305 check_env_utf8('FULLNAME');
306 check_env_utf8('NAME');
307 check_env_utf8('EMAIL');
309 if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
310 $env{'FULLNAME'} = $1 unless exists $env{'FULLNAME'};
313 if (! exists $env{'EMAIL'} or ! exists $env{'FULLNAME'}) {
314 if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
315 $env{'FULLNAME'} = $1 unless exists $env{'FULLNAME'};
320 # Now use the gleaned values to detemine our MAINTAINER and EMAIL values
322 if (exists $env{'FULLNAME'}) {
323 $MAINTAINER = $env{'FULLNAME'};
324 } elsif (exists $env{'NAME'}) {
325 $MAINTAINER = $env{'NAME'};
327 my @pw = getpwuid $<;
328 if (defined($pw[6])) {
329 if (my $pw = decode_utf8($pw[6])) {
333 warn "$progname warning: passwd full name field for uid $<\nis not UTF-8 encoded; ignoring\n";
338 # Otherwise, $MAINTAINER retains its default value of the last
342 if (exists $env{'EMAIL'}) { $EMAIL = $env{'EMAIL'}; }
343 elsif (exists $env{'EMAIL'}) { $EMAIL = $env{'EMAIL'}; }
346 if (open MAILNAME, '/etc/mailname') {
347 chomp($addr = <MAILNAME>);
351 chomp($addr = `hostname --fqdn 2>/dev/null`);
355 my $user = getpwuid $<;
360 $addr = "$user\@$addr";
363 $EMAIL = $addr if $addr;
365 # Otherwise, $EMAIL retains its default value of the last changelog entry
370 # Get a possible changelog entry from the command line
371 my $ARGS=join(' ', @ARGV);
372 my $TEXT=decode_utf8($ARGS);
375 if (@ARGV and ! $TEXT) {
377 warn "$progname warning: command-line changelog entry not UTF-8 encoded; ignoring\n";
385 my $date_cmd = ($opt_tz ? "TZ=$opt_tz " : "") . "date -R";
386 chomp(my $DATE=`$date_cmd`);
388 # Are we going to have to figure things out for ourselves?
389 if (! $opt_i && ! $opt_v && ! $opt_d && ! $opt_a && ! $opt_e && ! $opt_r &&
392 if ($opt_release_heuristic eq 'log') {
393 my @UPFILES = glob("../$PACKAGE\_$SVERSION\_*.upload");
395 fatal "Found more than one appropriate .upload file!\n" .
396 "Please use an explicit -a, -i or -v option instead.";
398 elsif (@UPFILES == 0) { $opt_a = 1 }
400 open UPFILE, "<${UPFILES[0]}"
401 or fatal "Couldn't open .upload file for reading: $!\n" .
402 "Please use an explicit -a, -i or -v option instead.";
404 if (m%^(s|Successfully uploaded) (/.*/)?\Q$PACKAGE\E\_\Q$SVERSION\E\_[\w\-\+]+\.changes %) {
410 or fatal "Problems experienced reading .upload file: $!\n" .
411 "Please use an explicit -a, -i or -v option instead.";
413 warn "$progname warning: A successful upload of the current version was not logged\n" .
414 "in the upload log file; adding log entry to current version.";
421 # Open in anticipation....
422 unless ($opt_create) {
423 open S, $changelog_path or fatal "Cannot open existing $changelog_path: $!";
425 open O, ">$changelog_path.clg"
426 or fatal "Cannot write to temporary file: $!";
427 # Turn off form feeds; taken from perlform
428 select((select(O), $^L = "")[0]);
430 # Note that we now have to remove it
432 my ($NEW_VERSION, $NEW_SVERSION, $NEW_UVERSION);
435 if (($opt_i || $opt_n || $opt_qa || $opt_bpo || $opt_v || $opt_d ||
436 ($opt_news && $VERSION ne $changelog{'Version'})) && ! $opt_create) {
438 # Check that a given explicit version number is sensible.
439 if ($opt_v || $opt_d) {
443 my $pwd = basename(cwd());
444 # The directory name should be <package>-<version>
445 my $version_chars = '0-9a-zA-Z+\.~';
446 $version_chars .= ':' if defined $EPOCH;
447 $version_chars .= '\-' if $UVERSION ne $SVERSION;
448 if ($pwd =~ m/^\Q$PACKAGE\E-([0-9][$version_chars]*)$/) {
450 if ($NEW_VERSION eq $UVERSION) {
451 # So it's a Debian-native package
452 if ($SVERSION eq $UVERSION) {
453 fatal "New version taken from directory ($NEW_VERSION) is equal to\n" .
454 "the current version number ($UVERSION)!";
456 # So we just increment the Debian revision
457 warn "$progname warning: Incrementing Infobot revision without altering\n version number.\n";
458 $VERSION =~ /^(.*?)([a-yA-Y][a-zA-Z]*|\d*)$/;
461 fatal "Cannot determine new revision; please use -v option!";
464 $NEW_VERSION="$1$end";
466 $NEW_VERSION = "$EPOCH:$NEW_VERSION" if defined $EPOCH;
467 $NEW_VERSION .= "-1";
470 fatal "The directory name must be <package>-<version> for -d to work!\n" .
471 "No underscores allowed!";
473 # Don't try renaming the directory in this case!
477 if (system("dpkg --compare-versions $VERSION lt $NEW_VERSION" .
478 " 2>/dev/null 1>&2")) {
480 warn "$progname warning: new version ($NEW_VERSION) is less than\n" .
481 "the current version number ($VERSION).\n";
483 fatal "New version specified ($NEW_VERSION) is less than\n" .
484 "the current version number ($VERSION)! Use -b to force.";
488 ($NEW_SVERSION=$NEW_VERSION) =~ s/^\d+://;
489 ($NEW_UVERSION=$NEW_SVERSION) =~ s/-[^-]*$//;
492 # We use the following criteria for the version and release number:
493 # the last component of the version number is used as the
494 # release number. If this is not a Debian native package, then the
495 # upstream version number is everything up to the final '-', not
498 if (! $NEW_VERSION) {
499 if ($VERSION =~ /(.*?)([a-yA-Y][a-zA-Z]*|\d+)$/i) {
502 # If it's not already an NMU make it so
503 # otherwise we can be safe if we behave like dch -i
504 if ($opt_n and (not $start =~ /\.$/ or $VERSION eq $UVERSION)) {
505 if ($VERSION eq $UVERSION) {
506 # First NMU of a Debian native package
511 } elsif ($opt_qa and $start =~/(.*?)-(\d+)\.$/) {
512 # Drop NMU revision when doing a QA upload
513 my $upstream_version = $1;
514 my $debian_revision = $2;
516 $start = "$upstream_version-$debian_revision";
518 } elsif ($opt_bpo and not $start =~ /~bpo\.$/) {
519 # If it's not already a backport make it so
520 # otherwise we can be safe if we behave like dch -i
522 } elsif (!$opt_news) {
523 # Don't bump the version of a NEWS file in this case as we're
524 # using the version from the changelog
527 $NEW_VERSION = "$start$end";
528 ($NEW_SVERSION=$NEW_VERSION) =~ s/^\d+://;
529 ($NEW_UVERSION=$NEW_SVERSION) =~ s/-[^-]*$//;
531 fatal "Error parsing version number: $VERSION";
536 print O "\n -- $MAINTAINER <$EMAIL> $DATE\n\n";
538 # Copy the old changelog file to the new one
542 elsif (($opt_r || $opt_a) && ! $opt_create) {
543 # This means we just have to generate a new * entry in changelog
544 # and if a multi-developer changelog is detected, add developer names.
546 $NEW_VERSION=$VERSION;
547 $NEW_SVERSION=$SVERSION;
548 $NEW_UVERSION=$UVERSION;
550 # Read and discard maintainer line, see who made the
551 # last entry, and determine whether there are existing
552 # multi-developer changes by the current maintainer.
554 my ($lastmaint, $nextmaint, $maintline, $count, $lastheader, $lastdist);
555 my $savedline = $line;;
558 # Start of existing changes by the current maintainer
559 if (/^ \[ $MAINTAINER \]$/) {
560 # If there's more than one such block,
561 # we only care about the first
562 $maintline ||= $line;
564 elsif (defined $lastmaint) {
565 if (m/^\w[-+0-9a-z.]* \([^\(\) \t]+\)((?:\s+[-+0-9a-z.]+)+)\;/i) {
568 $lastdist =~ s/^\s+//;
569 undef $lastdist if $lastdist eq "UNRELEASED";
570 # Revert to our previously saved position
575 elsif (/^ --\s+([^<]+)\s+/) {
577 # Remember where we are so we can skip back afterwards
581 if (defined $maintline && !defined $nextmaint) {
586 if (defined $maintline && defined $nextmaint) {
587 # Output the lines up to the end of the current maintainer block
590 foreach (split /\n/, $CHANGES) {
593 last if $count==$maintline;
596 # The first lines are as we have already found
600 if (defined $count) {
601 # Output the remainder of the changes
603 foreach (split /\n/, $CHANGES) {
605 next unless $count>$maintline;
610 if ($opt_t && $opt_a) {
611 print O "\n -- $changelog{'Maintainer'} $changelog{'Date'}\n";
613 print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
617 print O "\n$lastheader";
620 # Copy the rest of the changelog file to new one
625 elsif ($opt_e && ! $opt_create) {
626 # We don't do any fancy stuff with respect to versions or adding
627 # entries, we just update the timestamp and open the editor
632 print O "\n -- $changelog{'Maintainer'} $changelog{'Date'}\n";
634 print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
637 # Copy the rest of the changelog file to the new one
639 while (<S>) { $line++; last if /^ --/; }
644 # Set the start-line to 0, as we don't know what they want to edit
650 warn "$progname: Did you see those $warnings warnings? Press RETURN to continue...\n";
652 warn "$progname: Did you see that warning? Press RETURN to continue...\n";
654 my $garbage = <STDIN>;
657 # Now Run the Editor; always run if doing "closes" to give a chance to check
658 if (!$TEXT and !$EMPTY_TEXT) {
659 my $mtime = (stat("$changelog_path.clg"))[9];
660 defined $mtime or fatal
661 "Error getting modification time of temporary $changelog_path: $!";
663 system("sensible-editor +$line $changelog_path.clg") == 0 or
664 fatal "Error editing $changelog_path";
667 copy("$changelog_path.clg","$changelog_path") or
668 fatal "Couldn't replace $changelog_path with new version: $!";
673 # Format for standard Debian changelogs
675 * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
677 ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
680 # Format for NEWS files.
682 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
684 ~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
693 print O "\n" if $opt_news && ! ($newentry || $linecount);
707 # Initialise the variable
713 unlink "$changelog_path.clg" or
714 warn "$progname warning: Could not remove $changelog_path.clg";
715 unlink "$changelog_path.clg~"; # emacs backup file
720 my ($pack,$file,$line);
721 ($pack,$file,$line) = caller();
722 (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
727 # Is the environment variable valid or not?
731 if (exists $ENV{$envvar} and $ENV{$envvar} ne '') {
732 if (! decode_utf8($ENV{$envvar})) {
733 warn "$progname warning: environment variable $envvar not UTF-8 encoded; ignoring\n";
735 $env{$envvar} = decode_utf8($ENV{$envvar});