--- /dev/null
+#! /usr/bin/perl -w
+
+# debchange: update the debian changelog using your favorite visual editor
+# For options, see the usage message below.
+#
+# When creating a new changelog section, if either of the environment
+# variables DEBEMAIL or EMAIL is set, debchange will use this as the
+# uploader's email address (with the former taking precedence), and if
+# DEBFULLNAME or NAME is set, it will use this as the uploader's full name.
+# Otherwise, it will take the standard values for the current user or,
+# failing that, just copy the values from the previous changelog entry.
+#
+# Originally by Christoph Lameter <clameter@debian.org>
+# Modified extensively by Julian Gilbey <jdg@debian.org>
+#
+# Copyright 1999-2005 by Julian Gilbey
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use 5.008; # We're using PerlIO layers
+use strict;
+use open ':utf8'; # changelogs are written with UTF-8 encoding
+use filetest 'access'; # use access rather than stat for -w
+use Encode 'decode_utf8'; # for checking whether user names are valid
+use Getopt::Long;
+use File::Copy;
+use File::Basename;
+use Cwd;
+
+BEGIN {
+ # Load the URI::Escape module safely
+ eval { require URI::Escape; };
+ if ($@) {
+ my $progname = basename $0;
+ if ($@ =~ /^Can\'t locate URI\/Escape\.pm/) {
+ die "$progname: you must have the liburi-perl package installed\nto use this script\n";
+ }
+ die "$progname: problem loading the URI::Escape module:\n $@\nHave you installed the liburi-perl package?\n";
+ }
+ import URI::Escape;
+}
+
+# Predeclare functions
+sub fatal($);
+my $warnings = 0;
+
+# And global variables
+my $progname = basename($0);
+my $modified_conf_msg;
+my %env;
+my $CHGLINE; # used by the format O section at the end
+
+sub usage () {
+ print <<"EOF";
+Usage: $progname [options] [changelog entry]
+Options:
+ -a, --append
+ Append a new entry to the current changelog
+ -i, --increment
+ Increase the Infobot release number, adding a new changelog entry
+ -v <version>, --newversion=<version>
+ Add a new changelog entry with version number specified
+ -e, --edit
+ Don't change version number or add a new changelog entry, just
+ update the changelog's stamp and open up an editor
+ -r, --release
+ Update the changelog timestamp.
+ -d, --fromdirname
+ Add a new changelog entry with version taken from the directory name
+ -p, --preserve
+ Preserve the directory name
+ --no-preserve
+ Do not preserve the directory name (default)
+ --help, -h
+ Display this help message and exit
+ --version
+ Display version information
+ At most one of -a, -i, -e, -r, -v, -d (or their long equivalents)
+ may be used.
+ With no options, one of -i or -a is chosen by looking for a .upload
+ file in the parent directory and checking its contents.
+
+Default settings modified by devscripts configuration files:
+$modified_conf_msg
+EOF
+}
+
+sub version () {
+ print <<"EOF";
+This is $progname, ripped from the Debian devscripts package, version 2.10.9
+This code is copyright 1999-2003 by Julian Gilbey, all rights reserved.
+Based on code by Christoph Lameter.
+This program comes with ABSOLUTELY NO WARRANTY.
+You are free to redistribute this code under the terms of the
+GNU General Public License, version 2 or later.
+EOF
+}
+
+# Start by setting default values
+my $check_dirname_level = 1;
+my $check_dirname_regex = 'PACKAGE(-.*)?';
+my $opt_p = 0;
+my $opt_query = 1;
+my $opt_release_heuristic = 'log';
+my $opt_multimaint = 1;
+my $opt_multimaint_merge = 0;
+my $opt_tz = undef;
+my $opt_mainttrailer = 0;
+
+# Next, read configuration files and then command line
+# The next stuff is boilerplate
+
+if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
+ $modified_conf_msg = " (no configuration files read)";
+ shift;
+} else {
+ my @config_files = ('~/.infobot-dev.conf');
+ my %config_vars = (
+ 'CHANGE_PRESERVE' => 'no',
+ 'CHANGE_TZ' => $ENV{TZ}, # undef if TZ unset
+ );
+ $config_vars{'CHANGE_TZ'} ||= '';
+ my %config_default = %config_vars;
+
+ my $shell_cmd;
+ # Set defaults
+ foreach my $var (keys %config_vars) {
+ $shell_cmd .= qq[$var="$config_vars{$var}";\n];
+ }
+ $shell_cmd .= 'for file in ' . join(" ",@config_files) . "; do\n";
+ $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
+ # Read back values
+ foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
+ my $shell_out = `/bin/bash -c '$shell_cmd'`;
+ @config_vars{keys %config_vars} = split /\n/, $shell_out, -1;
+
+ # Check validity
+ $config_vars{'CHANGE_PRESERVE'} =~ /^(yes|no)$/
+ or $config_vars{'CHANGE_PRESERVE'}='no';
+
+ foreach my $var (sort keys %config_vars) {
+ if ($config_vars{$var} ne $config_default{$var}) {
+ $modified_conf_msg .= " $var=$config_vars{$var}\n";
+ }
+ }
+ $modified_conf_msg ||= " (none)\n";
+ chomp $modified_conf_msg;
+
+ $opt_p = $config_vars{'CHANGE_PRESERVE'} eq 'yes' ? 1 : 0;
+ $opt_tz = $config_vars{'CHANGE_TZ'};
+}
+
+# We use bundling so that the short option behaviour is the same as
+# with older debchange versions.
+my ($opt_help, $opt_version);
+my ($opt_i, $opt_a, $opt_e, $opt_r, $opt_v, $opt_b, $opt_d, $opt_D, $opt_u, $opt_t);
+my ($opt_n, $opt_qa, $opt_bpo, $opt_c, $opt_m, $opt_create, $opt_package, @closes);
+my ($opt_news);
+my ($opt_ignore, $opt_level, $opt_regex, $opt_noconf);
+
+Getopt::Long::Configure('bundling');
+GetOptions("help|h" => \$opt_help,
+ "version" => \$opt_version,
+ "i|increment" => \$opt_i,
+ "a|append" => \$opt_a,
+ "e|edit" => \$opt_e,
+ "r|release" => \$opt_r,
+ "v|newversion=s" => \$opt_v,
+ "p" => \$opt_p,
+ "preserve!" => \$opt_p,
+ "release-heuristic=s" => \$opt_release_heuristic,
+ )
+ or die "Usage: $progname [options] [changelog entry]\nRun $progname --help for more details\n";
+
+if ($opt_noconf) {
+ fatal "--no-conf is only acceptable as the first command-line option!";
+}
+if ($opt_help) { usage; exit 0; }
+if ($opt_version) { version; exit 0; }
+
+# dirname stuff
+if ($opt_ignore) {
+ fatal "--ignore-dirname has been replaced by --check-dirname-level and\n--check-dirname-regex; run $progname --help for more details";
+}
+
+if (defined $opt_level) {
+ if ($opt_level =~ /^[012]$/) { $check_dirname_level = $opt_level; }
+ else {
+ fatal "Unrecognised --check-dirname-level value (allowed are 0,1,2)";
+ }
+}
+
+if (defined $opt_regex) { $check_dirname_regex = $opt_regex; }
+
+# Only allow at most one non-help option
+fatal "Only one of -a, -i, -e, -r, -v, -d is allowed;\ntry $progname --help for more help"
+ 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;
+
+my $changelog_path = $opt_c || $ENV{'CHANGELOG'} || 'Changelog';
+my $real_changelog_path = $changelog_path;
+if ($changelog_path ne 'Changelog') {
+ $check_dirname_level = 0;
+}
+
+if ($opt_create) {
+ if ($opt_a || $opt_i || $opt_e || $opt_r || $opt_b || $opt_n || $opt_qa || $opt_bpo) {
+ warn "$progname warning: ignoring -a/-i/-e/-r/-b/-n/--qa/--bpo options with --create\n";
+ $warnings++;
+ }
+ if ($opt_package && $opt_d) {
+ fatal "Can only use one of --package and -d";
+ }
+}
+
+
+@closes = split(/,/, join(',', @closes));
+map { s/^\#//; } @closes; # remove any leading # from bug numbers
+
+# We'll process the rest of the command line later.
+
+# Look for the changelog
+my $chdir = 0;
+if (! $opt_create) {
+ if ($changelog_path eq 'Changelog' or $opt_news) {
+ until (-f $changelog_path) {
+ $chdir = 1;
+ chdir '..' or fatal "Can't chdir ..: $!";
+ if (cwd() eq '/') {
+ 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.)";
+ }
+ }
+
+ # Can't write, so stop now.
+ if (! -w $changelog_path) {
+ fatal "$changelog_path is not writable!";
+ }
+ }
+ else {
+ unless (-f $changelog_path) {
+ fatal "Cannot find $changelog_path!\nAre you in the correct directory?\n(You could use --create if you wish to create this file.)";
+ }
+
+ # Can't write, so stop now.
+ if (! -w $changelog_path) {
+ fatal "$changelog_path is not writable!";
+ }
+ }
+}
+else { # $opt_create
+ unless (-d dirname $changelog_path) {
+ fatal "Cannot find " . (dirname $changelog_path) . " directory!\nAre you in the correct directory?";
+ }
+ if (-f $changelog_path) {
+ fatal "File $changelog_path already exists!";
+ }
+ unless (-w dirname $changelog_path) {
+ fatal "Cannot find " . (dirname $changelog_path) . " directory!\nAre you in the correct directory?";
+ }
+ if ($opt_news && ! -f 'debian/changelog') {
+ fatal "I can't create $opt_news without debian/changelog present";
+ }
+}
+
+#####
+
+# Find the current version number etc.
+my %changelog;
+my $PACKAGE = 'PACKAGE';
+my $VERSION = 'VERSION';
+my $MAINTAINER = 'MAINTAINER';
+my $EMAIL = 'EMAIL';
+my $DISTRIBUTION = 'UNRELEASED';
+my $CHANGES = '';
+
+# Clean up after old versions of debchange
+if (-f "debian/RELEASED") {
+ unlink("debian/RELEASED");
+}
+
+if ( -e "$changelog_path.clg" ) {
+ fatal "The backup file $changelog_path.clg already exists --\n" .
+ "please move it before trying again";
+}
+
+
+# Is this a native Debian package, i.e., does it have a - in the
+# version number?
+(my $EPOCH) = ($VERSION =~ /^(\d+):/);
+(my $SVERSION=$VERSION) =~ s/^\d+://;
+(my $UVERSION=$SVERSION) =~ s/-[^-]*$//;
+
+# Check, sanitise and decode these environment variables
+check_env_utf8('FULLNAME');
+check_env_utf8('NAME');
+check_env_utf8('EMAIL');
+
+if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'FULLNAME'} = $1 unless exists $env{'FULLNAME'};
+ $env{'EMAIL'} = $2;
+}
+if (! exists $env{'EMAIL'} or ! exists $env{'FULLNAME'}) {
+ if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'FULLNAME'} = $1 unless exists $env{'FULLNAME'};
+ $env{'EMAIL'} = $2;
+ }
+}
+
+# Now use the gleaned values to detemine our MAINTAINER and EMAIL values
+if (! $opt_m) {
+ if (exists $env{'FULLNAME'}) {
+ $MAINTAINER = $env{'FULLNAME'};
+ } elsif (exists $env{'NAME'}) {
+ $MAINTAINER = $env{'NAME'};
+ } else {
+ my @pw = getpwuid $<;
+ if (defined($pw[6])) {
+ if (my $pw = decode_utf8($pw[6])) {
+ $pw =~ s/,.*//;
+ $MAINTAINER = $pw;
+ } else {
+ warn "$progname warning: passwd full name field for uid $<\nis not UTF-8 encoded; ignoring\n";
+ $warnings++;
+ }
+ }
+ }
+ # Otherwise, $MAINTAINER retains its default value of the last
+ # changelog entry
+
+ # Email is easier
+ if (exists $env{'EMAIL'}) { $EMAIL = $env{'EMAIL'}; }
+ elsif (exists $env{'EMAIL'}) { $EMAIL = $env{'EMAIL'}; }
+ else {
+ my $addr;
+ if (open MAILNAME, '/etc/mailname') {
+ chomp($addr = <MAILNAME>);
+ close MAILNAME;
+ }
+ if (!$addr) {
+ chomp($addr = `hostname --fqdn 2>/dev/null`);
+ $addr = undef if $?;
+ }
+ if ($addr) {
+ my $user = getpwuid $<;
+ if (!$user) {
+ $addr = undef;
+ }
+ else {
+ $addr = "$user\@$addr";
+ }
+ }
+ $EMAIL = $addr if $addr;
+ }
+ # Otherwise, $EMAIL retains its default value of the last changelog entry
+} # if (! $opt_m)
+
+#####
+
+# Get a possible changelog entry from the command line
+my $ARGS=join(' ', @ARGV);
+my $TEXT=decode_utf8($ARGS);
+my $EMPTY_TEXT=0;
+
+if (@ARGV and ! $TEXT) {
+ if ($ARGS) {
+ warn "$progname warning: command-line changelog entry not UTF-8 encoded; ignoring\n";
+ $TEXT='';
+ } else {
+ $EMPTY_TEXT = 1;
+ }
+}
+
+# Get the date
+my $date_cmd = ($opt_tz ? "TZ=$opt_tz " : "") . "date -R";
+chomp(my $DATE=`$date_cmd`);
+
+# Are we going to have to figure things out for ourselves?
+if (! $opt_i && ! $opt_v && ! $opt_d && ! $opt_a && ! $opt_e && ! $opt_r &&
+ ! $opt_create) {
+ # Yes, we are
+ if ($opt_release_heuristic eq 'log') {
+ my @UPFILES = glob("../$PACKAGE\_$SVERSION\_*.upload");
+ if (@UPFILES > 1) {
+ fatal "Found more than one appropriate .upload file!\n" .
+ "Please use an explicit -a, -i or -v option instead.";
+ }
+ elsif (@UPFILES == 0) { $opt_a = 1 }
+ else {
+ open UPFILE, "<${UPFILES[0]}"
+ or fatal "Couldn't open .upload file for reading: $!\n" .
+ "Please use an explicit -a, -i or -v option instead.";
+ while (<UPFILE>) {
+ if (m%^(s|Successfully uploaded) (/.*/)?\Q$PACKAGE\E\_\Q$SVERSION\E\_[\w\-\+]+\.changes %) {
+ $opt_i = 1;
+ last;
+ }
+ }
+ close UPFILE
+ or fatal "Problems experienced reading .upload file: $!\n" .
+ "Please use an explicit -a, -i or -v option instead.";
+ if (! $opt_i) {
+ warn "$progname warning: A successful upload of the current version was not logged\n" .
+ "in the upload log file; adding log entry to current version.";
+ $opt_a = 1;
+ }
+ }
+ }
+}
+
+# Open in anticipation....
+unless ($opt_create) {
+ open S, $changelog_path or fatal "Cannot open existing $changelog_path: $!";
+}
+open O, ">$changelog_path.clg"
+ or fatal "Cannot write to temporary file: $!";
+# Turn off form feeds; taken from perlform
+select((select(O), $^L = "")[0]);
+
+# Note that we now have to remove it
+my $tmpchk=1;
+my ($NEW_VERSION, $NEW_SVERSION, $NEW_UVERSION);
+my $line;
+
+if (($opt_i || $opt_n || $opt_qa || $opt_bpo || $opt_v || $opt_d ||
+ ($opt_news && $VERSION ne $changelog{'Version'})) && ! $opt_create) {
+
+ # Check that a given explicit version number is sensible.
+ if ($opt_v || $opt_d) {
+ if($opt_v) {
+ $NEW_VERSION=$opt_v;
+ } else {
+ my $pwd = basename(cwd());
+ # The directory name should be <package>-<version>
+ my $version_chars = '0-9a-zA-Z+\.~';
+ $version_chars .= ':' if defined $EPOCH;
+ $version_chars .= '\-' if $UVERSION ne $SVERSION;
+ if ($pwd =~ m/^\Q$PACKAGE\E-([0-9][$version_chars]*)$/) {
+ $NEW_VERSION=$1;
+ if ($NEW_VERSION eq $UVERSION) {
+ # So it's a Debian-native package
+ if ($SVERSION eq $UVERSION) {
+ fatal "New version taken from directory ($NEW_VERSION) is equal to\n" .
+ "the current version number ($UVERSION)!";
+ }
+ # So we just increment the Debian revision
+ warn "$progname warning: Incrementing Infobot revision without altering\n version number.\n";
+ $VERSION =~ /^(.*?)([a-yA-Y][a-zA-Z]*|\d*)$/;
+ my $end = $2;
+ if ($end eq '') {
+ fatal "Cannot determine new revision; please use -v option!";
+ }
+ $end++;
+ $NEW_VERSION="$1$end";
+ } else {
+ $NEW_VERSION = "$EPOCH:$NEW_VERSION" if defined $EPOCH;
+ $NEW_VERSION .= "-1";
+ }
+ } else {
+ fatal "The directory name must be <package>-<version> for -d to work!\n" .
+ "No underscores allowed!";
+ }
+ # Don't try renaming the directory in this case!
+ $opt_p=1;
+ }
+
+ if (system("dpkg --compare-versions $VERSION lt $NEW_VERSION" .
+ " 2>/dev/null 1>&2")) {
+ if ($opt_b) {
+ warn "$progname warning: new version ($NEW_VERSION) is less than\n" .
+ "the current version number ($VERSION).\n";
+ } else {
+ fatal "New version specified ($NEW_VERSION) is less than\n" .
+ "the current version number ($VERSION)! Use -b to force.";
+ }
+ }
+
+ ($NEW_SVERSION=$NEW_VERSION) =~ s/^\d+://;
+ ($NEW_UVERSION=$NEW_SVERSION) =~ s/-[^-]*$//;
+ }
+
+ # We use the following criteria for the version and release number:
+ # the last component of the version number is used as the
+ # release number. If this is not a Debian native package, then the
+ # upstream version number is everything up to the final '-', not
+ # including epochs.
+
+ if (! $NEW_VERSION) {
+ if ($VERSION =~ /(.*?)([a-yA-Y][a-zA-Z]*|\d+)$/i) {
+ my $end=$2;
+ my $start=$1;
+ # If it's not already an NMU make it so
+ # otherwise we can be safe if we behave like dch -i
+ if ($opt_n and (not $start =~ /\.$/ or $VERSION eq $UVERSION)) {
+ if ($VERSION eq $UVERSION) {
+ # First NMU of a Debian native package
+ $end .= "-0.1";
+ } else {
+ $end += 0.1;
+ }
+ } elsif ($opt_qa and $start =~/(.*?)-(\d+)\.$/) {
+ # Drop NMU revision when doing a QA upload
+ my $upstream_version = $1;
+ my $debian_revision = $2;
+ $debian_revision++;
+ $start = "$upstream_version-$debian_revision";
+ $end = "";
+ } elsif ($opt_bpo and not $start =~ /~bpo\.$/) {
+ # If it's not already a backport make it so
+ # otherwise we can be safe if we behave like dch -i
+ $end .= "~bpo40+1";
+ } elsif (!$opt_news) {
+ # Don't bump the version of a NEWS file in this case as we're
+ # using the version from the changelog
+ $end++;
+ }
+ $NEW_VERSION = "$start$end";
+ ($NEW_SVERSION=$NEW_VERSION) =~ s/^\d+://;
+ ($NEW_UVERSION=$NEW_SVERSION) =~ s/-[^-]*$//;
+ } else {
+ fatal "Error parsing version number: $VERSION";
+ }
+ }
+
+ $line += 3;
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n\n";
+
+ # Copy the old changelog file to the new one
+ local $/ = undef;
+ print O <S>;
+}
+elsif (($opt_r || $opt_a) && ! $opt_create) {
+ # This means we just have to generate a new * entry in changelog
+ # and if a multi-developer changelog is detected, add developer names.
+
+ $NEW_VERSION=$VERSION;
+ $NEW_SVERSION=$SVERSION;
+ $NEW_UVERSION=$UVERSION;
+
+ # Read and discard maintainer line, see who made the
+ # last entry, and determine whether there are existing
+ # multi-developer changes by the current maintainer.
+ $line=-1;
+ my ($lastmaint, $nextmaint, $maintline, $count, $lastheader, $lastdist);
+ my $savedline = $line;;
+ while (<S>) {
+ $line++;
+ # Start of existing changes by the current maintainer
+ if (/^ \[ $MAINTAINER \]$/) {
+ # If there's more than one such block,
+ # we only care about the first
+ $maintline ||= $line;
+ }
+ elsif (defined $lastmaint) {
+ if (m/^\w[-+0-9a-z.]* \([^\(\) \t]+\)((?:\s+[-+0-9a-z.]+)+)\;/i) {
+ $lastheader = $_;
+ $lastdist = $1;
+ $lastdist =~ s/^\s+//;
+ undef $lastdist if $lastdist eq "UNRELEASED";
+ # Revert to our previously saved position
+ $line = $savedline;
+ last;
+ }
+ }
+ elsif (/^ --\s+([^<]+)\s+/) {
+ $lastmaint=$1;
+ # Remember where we are so we can skip back afterwards
+ $savedline = $line;
+ }
+
+ if (defined $maintline && !defined $nextmaint) {
+ $maintline++;
+ }
+ }
+
+ if (defined $maintline && defined $nextmaint) {
+ # Output the lines up to the end of the current maintainer block
+ $count=1;
+ $line=$maintline;
+ foreach (split /\n/, $CHANGES) {
+ print O $_ . "\n";
+ $count++;
+ last if $count==$maintline;
+ }
+ } else {
+ # The first lines are as we have already found
+ print O $CHANGES;
+ };
+
+ if (defined $count) {
+ # Output the remainder of the changes
+ $count=1;
+ foreach (split /\n/, $CHANGES) {
+ $count++;
+ next unless $count>$maintline;
+ print O $_ . "\n";
+ }
+ }
+
+ if ($opt_t && $opt_a) {
+ print O "\n -- $changelog{'Maintainer'} $changelog{'Date'}\n";
+ } else {
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
+ }
+
+ if ($lastheader) {
+ print O "\n$lastheader";
+ }
+
+ # Copy the rest of the changelog file to new one
+ # Slurp the rest....
+ local $/ = undef;
+ print O <S>;
+}
+elsif ($opt_e && ! $opt_create) {
+ # We don't do any fancy stuff with respect to versions or adding
+ # entries, we just update the timestamp and open the editor
+
+ print O $CHANGES;
+
+ if ($opt_t) {
+ print O "\n -- $changelog{'Maintainer'} $changelog{'Date'}\n";
+ } else {
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
+ }
+
+ # Copy the rest of the changelog file to the new one
+ $line=-1;
+ while (<S>) { $line++; last if /^ --/; }
+ # Slurp the rest...
+ local $/ = undef;
+ print O <S>;
+
+ # Set the start-line to 0, as we don't know what they want to edit
+ $line=0;
+}
+
+if ($warnings) {
+ if ($warnings>1) {
+ warn "$progname: Did you see those $warnings warnings? Press RETURN to continue...\n";
+ } else {
+ warn "$progname: Did you see that warning? Press RETURN to continue...\n";
+ }
+ my $garbage = <STDIN>;
+}
+
+# Now Run the Editor; always run if doing "closes" to give a chance to check
+if (!$TEXT and !$EMPTY_TEXT) {
+ my $mtime = (stat("$changelog_path.clg"))[9];
+ defined $mtime or fatal
+ "Error getting modification time of temporary $changelog_path: $!";
+
+ system("sensible-editor +$line $changelog_path.clg") == 0 or
+ fatal "Error editing $changelog_path";
+}
+
+copy("$changelog_path.clg","$changelog_path") or
+ fatal "Couldn't replace $changelog_path with new version: $!";
+
+exit 0;
+
+
+# Format for standard Debian changelogs
+format CHANGELOG =
+ * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+ ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+.
+# Format for NEWS files.
+format NEWS =
+ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+.
+
+my $linecount=0;
+sub format_line {
+ $CHGLINE=shift;
+ my $newentry=shift;
+
+ print O "\n" if $opt_news && ! ($newentry || $linecount);
+ $linecount++;
+ my $f=select(O);
+ if ($opt_news) {
+ $~='NEWS';
+ }
+ else {
+ $~='CHANGELOG';
+ }
+ write O;
+ select $f;
+}
+
+BEGIN {
+ # Initialise the variable
+ $tmpchk=0;
+}
+
+END {
+ if ($tmpchk) {
+ unlink "$changelog_path.clg" or
+ warn "$progname warning: Could not remove $changelog_path.clg";
+ unlink "$changelog_path.clg~"; # emacs backup file
+ }
+}
+
+sub fatal($) {
+ my ($pack,$file,$line);
+ ($pack,$file,$line) = caller();
+ (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
+ $msg =~ s/\n\n$/\n/;
+ die $msg;
+}
+
+# Is the environment variable valid or not?
+sub check_env_utf8 {
+ my $envvar = $_[0];
+
+ if (exists $ENV{$envvar} and $ENV{$envvar} ne '') {
+ if (! decode_utf8($ENV{$envvar})) {
+ warn "$progname warning: environment variable $envvar not UTF-8 encoded; ignoring\n";
+ } else {
+ $env{$envvar} = decode_utf8($ENV{$envvar});
+ }
+ }
+}
+
projects / infobot.git / commitdiff