summaryrefslogtreecommitdiffstats
path: root/scripts/dep3changelog.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/dep3changelog.pl')
-rwxr-xr-xscripts/dep3changelog.pl187
1 files changed, 187 insertions, 0 deletions
diff --git a/scripts/dep3changelog.pl b/scripts/dep3changelog.pl
new file mode 100755
index 0000000..87bf588
--- /dev/null
+++ b/scripts/dep3changelog.pl
@@ -0,0 +1,187 @@
+#!/usr/bin/perl
+
+# dep3changelog: extract a DEP3 patch header from the named file and
+# automatically update debian/changelog with a suitable entry
+#
+# Copyright 2010 Steve Langasek <vorlon@debian.org>
+#
+# 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
+# USA
+
+use 5.008; # We're using PerlIO layers
+use strict;
+use warnings;
+use open ':utf8'; # patch headers are required to be UTF-8
+
+# for checking whether user names are valid and making format() behave
+use Encode qw/decode_utf8 encode_utf8/;
+use Getopt::Long;
+use File::Basename;
+
+# And global variables
+my $progname = basename($0);
+my %env;
+
+sub usage () {
+ print <<"EOF";
+Usage: $progname patch [patch...] [options] [-- [dch options]]
+Options:
+ --help, -h
+ Display this help message and exit
+ --version
+ Display version information
+ Additional options specified after -- are passed to dch.
+EOF
+}
+
+sub version () {
+ print <<"EOF";
+This is $progname, from the Debian devscripts package, version ###VERSION###
+This code is copyright 2010 by Steve Langasek, all rights reserved.
+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
+}
+
+my ($opt_help, $opt_version);
+GetOptions(
+ "help|h" => \$opt_help,
+ "version" => \$opt_version,
+ )
+ or die
+"Usage: $progname patch [... patch] [-- [dch options]]\nRun $progname --help for more details\n";
+
+if ($opt_help) { usage; exit 0; }
+if ($opt_version) { version; exit 0; }
+
+my @patches;
+
+while (@ARGV && $ARGV[0] !~ /^-/) {
+ push(@patches, shift(@ARGV));
+}
+
+# Check, sanitise and decode these environment variables
+check_env_utf8('DEBFULLNAME');
+check_env_utf8('NAME');
+check_env_utf8('DEBEMAIL');
+check_env_utf8('EMAIL');
+
+if (exists $env{'DEBEMAIL'} and $env{'DEBEMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'};
+ $env{'DEBEMAIL'} = $2;
+}
+if (!exists $env{'DEBEMAIL'} or !exists $env{'DEBFULLNAME'}) {
+ if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'};
+ $env{'EMAIL'} = $2;
+ }
+}
+
+my $fullname = '';
+my $email = '';
+
+if (exists $env{'DEBFULLNAME'}) {
+ $fullname = $env{'DEBFULLNAME'};
+} elsif (exists $env{'NAME'}) {
+ $fullname = $env{'NAME'};
+} else {
+ my @pw = getpwuid $<;
+ if ($pw[6]) {
+ if (my $pw = decode_utf8($pw[6])) {
+ $pw =~ s/,.*//;
+ $fullname = $pw;
+ } else {
+ warn
+"$progname warning: passwd full name field for uid $<\nis not UTF-8 encoded; ignoring\n";
+ }
+ }
+}
+
+if (exists $env{'DEBEMAIL'}) {
+ $email = $env{'DEBEMAIL'};
+} elsif (exists $env{'EMAIL'}) {
+ $email = $env{'EMAIL'};
+}
+
+for my $patch (@patches) {
+ my $shebang = 0;
+ my $dpatch = 0;
+ # TODO: more than one debian or launchpad bug in a patch?
+ my ($description, $author, $debbug, $lpbug, $origin);
+
+ next unless (open PATCH, $patch);
+ while (<PATCH>) {
+ # first line only
+ if (!$shebang) {
+ $shebang = 1;
+ if (/^#!/) {
+ $dpatch = $shebang = 1;
+ next;
+ }
+ }
+ last if (/^---/);
+ chomp;
+ # only if there was a shebang do we strip comment chars
+ s/^# // if ($dpatch);
+ # fixme: this should only apply to the description field.
+ next if (/^ /);
+
+ if (/^(Description|Subject):\s+(.*)\s*/) {
+ $description = $2;
+ } elsif (/^(Author|From):\s+(.*)\s*/) {
+ $author = $2;
+ } elsif (/^Origin:\s+(.*)\s*/) {
+ $origin = $1;
+ } elsif (/^bug-debian:\s+https?:\/\/bugs\.debian\.org\/([0-9]+)\s*/i) {
+ $debbug = $1;
+ } elsif (/^bug-ubuntu:\s+https:\/\/.*launchpad\.net\/.*\/([0-9]+)\s*/i)
+ {
+ $lpbug = $1;
+ }
+ }
+ close PATCH;
+ if (!$description || (!$origin && !$author)) {
+ warn "$patch: Invalid DEP3 header\n";
+ next;
+ }
+ my $changelog = "$patch: $description";
+ $changelog .= '.' unless ($changelog =~ /\.$/);
+ if ($author && $author ne $fullname && $author ne "$fullname <$email>") {
+ $changelog .= " Thanks to $author.";
+ }
+ if ($debbug || $lpbug) {
+ $changelog .= ' Closes';
+ $changelog .= ": #$debbug" if ($debbug);
+ $changelog .= "," if ($debbug && $lpbug);
+ $changelog .= " LP: #$lpbug" if ($lpbug);
+ $changelog .= '.';
+ }
+ system('dch', $changelog, @ARGV);
+}
+
+# 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});
+ }
+ }
+}