--- /dev/null
+#!/usr/bin/perl
+
+=head1 NAME
+
+gnucommit - commit changes to packages with GNU-format ChangeLog files
+
+=head1 SYNOPSIS
+
+B<gnucommit> [B<--release>] [B<--message=>I<text>] [B<--noact>] [B<--confirm>] [B<--changelog=>I<path>] [B<--all> | I<files to commit>]
+
+=head1 DESCRIPTION
+
+B<gnucommit> generates a commit message based on new text in B<ChangeLog>,
+and commits the change to the repository. It must be run in a working
+copy for the package. Supported version control systems are:
+B<svn> (subversion), B<bzr>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c> B<--changelog> I<path>
+
+Specify an alternate location for the changelog. By default ChangeLog is
+used.
+
+=item B<-r> B<--release>
+
+Commit a release of the package. The version number is determined from
+ChangeLog, and is used to tag the package in the repository.
+
+Note that svn/svk tagging conventions vary, so gnucommit uses
+L<svnpath(1)> to determine where the tag should be placed in the
+repository.
+
+=item B<-m> I<text> B<--message> I<text>
+
+Specify a commit message to use. Useful if the program cannot determine
+a commit message on its own based on ChangeLog, or if you want to
+override the default message.
+
+=item B<-n> B<--noact>
+
+Do not actually do anything, but do print the commands that would be run.
+
+=item B<-C> B<--confirm>
+
+Display the generated commit message and ask for confirmation before committing
+it.
+
+=item B<-a> B<--all>
+
+Commit all files. This is the default operation when using a VCS other
+than git.
+
+=item I<files to commit>
+
+Specify which files to commit (ChangeLog is added to the list
+automatically.)
+
+=item B<-s> B<--strip-message>, B<--no-strip-message>
+
+If this option is set and the commit message has been derived from the
+changelog, the characters "* " will be stripped from the beginning of
+the message.
+
+This option is ignored if more than one line of the message
+begins with "* ".
+
+=item B<--sign-tags>, B<--no-sign-tags>
+
+If this option is set, then tags that gnucommit creates will be signed
+using gnupg. Currently this is only supported by git.
+
+=over 4
+
+=back
+
+=head1 CONFIGURATION VARIABLES
+
+The two configuration files F</etc/devscripts.conf> and
+F<~/.devscripts> are sourced by a shell in that order to set
+configuration variables. Command line options can be used to override
+configuration file settings. Environment variable settings are
+ignored for this purpose. The currently recognised variables are:
+
+=over 4
+
+=item B<DEBCOMMIT_STRIP_MESSAGE>
+
+If this is set to I<yes>, then it is the same as the --strip-message
+command line parameter being used. The default is I<no>.
+
+=item B<DEBCOMMIT_SIGN_TAGS>
+
+If this is set to I<yes>, then it is the same as the --sign-tags command
+line parameter being used. The default is I<no>.
+
+=item B<DEBSIGN_KEYID>
+
+This is the key id used for signing tags. If not set, a default will be
+chosen by the revision control system.
+
+=cut
+
+use warnings;
+use strict;
+use Getopt::Long;
+use Cwd;
+use File::Basename;
+my $progname = basename($0);
+
+my $modified_conf_msg;
+
+sub usage {
+ print <<"EOT";
+Usage: $progname [options] [files to commit]
+ $progname --version
+ $progname --help
+
+Generates a commit message based on new text in ChangeLog,
+and commit the change to a package\'s repository.
+
+Options:
+ -c --changelog=path Specify the location of the changelog
+ -r --release Commit a release of the package and create a tag
+ -m --message=text Specify a commit message
+ -n --noact Dry run, no actual commits
+ -C --confirm Ask for confirmation of the message before commit
+ -a --all Commit all files (default except for git)
+ -s --strip-message Strip the leading '* ' from the commit message
+ --no-strip-message Do not strip a leading '* ' (default)
+ --sign-tags Enable signing of tags (git only)
+ --no-sign-tags Do not sign tags (default)
+ -h --help This message
+ -v --version Version information
+
+ --no-conf, --noconf
+ Don\'t read devscripts config files;
+ must be the first option given
+
+Default settings modified by devscripts configuration files:
+$modified_conf_msg
+
+EOT
+}
+
+sub version {
+ print <<"EOF";
+This is $progname, from the Debian devscripts package, version 2.10.11
+This code is copyright by Joey Hess <joeyh\@debian.org>, 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 $release=0;
+my $message;
+my $noact=0;
+my $confirm=0;
+my $all=0;
+my $stripmessage=0;
+my $signtags=0;
+my $changelog="ChangeLog";
+my $keyid;
+
+# Now start by reading 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 = ('/etc/devscripts.conf', '~/.devscripts');
+ my %config_vars = (
+ 'DEBCOMMIT_STRIP_MESSAGE' => 'no',
+ 'DEBCOMMIT_SIGN_TAGS' => 'no',
+ 'DEBSIGN_KEYID' => '',
+ );
+ 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{'DEBCOMMIT_STRIP_MESSAGE'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCOMMIT_STRIP_MESSAGE'}='no';
+ $config_vars{'DEBCOMMIT_SIGN_TAGS'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCOMMIT_SIGN_TAGS'}='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;
+
+ $stripmessage = $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} eq 'no' ? 0 : 1;
+ $signtags = $config_vars{'DEBCOMMIT_SIGN_TAGS'} eq 'no' ? 0 : 1;
+ if (exists $config_vars{'DEBSIGN_KEYID'} &&
+ length $config_vars{'DEBSIGN_KEYID'}) {
+ $keyid=$config_vars{'DEBSIGN_KEYID'};
+ }
+}
+
+# Now read the command line arguments
+
+Getopt::Long::Configure("bundling");
+if (! GetOptions(
+ "r|release" => \$release,
+ "m|message=s" => \$message,
+ "n|noact" => \$noact,
+ "C|confirm" => \$confirm,
+ "a|all" => \$all,
+ "c|changelog=s" => \$changelog,
+ "s|strip-message!" => \$stripmessage,
+ "sign-tags!" => \$signtags,
+ "h|help" => sub { usage(); exit 0; },
+ "v|version" => sub { version(); exit 0; },
+ )) {
+ die "Usage: gnucommit [--release] [--message=text] [--noact] [--confirm] [--changelog=path] [--all | files to commit]\n";
+}
+
+my @files_to_commit = @ARGV;
+if (@files_to_commit && !grep(/$changelog/,@files_to_commit)) {
+ push @files_to_commit, $changelog;
+}
+
+my $prog=getprog();
+if (! -e $changelog) {
+ die "gnucommit: cannot find $changelog\n";
+}
+
+if ($release) {
+ open (C, "<$changelog" ) || die "gnucommit: cannot read $changelog: $!";
+ <C>; <C>;
+ my $firstline=<C>;
+ if ($firstline!~/Version: ([0-9][a-z0-9.-]*)/) {
+ die "gnucommit: no Version: changelog entry found\n";
+ }
+ close C;
+
+ my $version=$1;
+ $version=~s/\.$//;
+
+ #$message="releasing version $version" if ! defined $message;
+ $message=getmessage() if ! defined $message;
+ commit($message);
+ tag($version);
+}
+else {
+ $message=getmessage() if ! defined $message;
+ commit($message) if not $confirm or confirm($message);
+}
+
+sub getprog {
+ if (-d ".svn") {
+ return "svn";
+ }
+ if (-d "CVS") {
+ return "cvs";
+ }
+ if (-d "{arch}") {
+ # I don't think we can tell just from the working copy
+ # whether to use tla or baz, so try baz if it's available,
+ # otherwise fall back to tla.
+ if (system ("baz --version >/dev/null 2>&1") == 0) {
+ return "baz";
+ } else {
+ return "tla";
+ }
+ }
+ if (-d ".bzr") {
+ return "bzr";
+ }
+ if (-d ".git") {
+ return "git";
+ }
+ if (-d ".hg") {
+ return "hg";
+ }
+
+ # Test for this file to avoid interactive prompting from svk.
+ if (-d "$ENV{HOME}/.svk/local") {
+ # svk has no useful directories so try to run it.
+ my $svkpath=`svk info . 2>/dev/null| grep -i '^Depot Path:' | cut -d ' ' -f 3`;
+ if (length $svkpath) {
+ return "svk";
+ }
+ }
+
+ # .git may be in a parent directory, rather than the current
+ # directory, if multiple packages are kept in one git repository.
+ my $dir=getcwd();
+ while ($dir=~s/[^\/]*\/?$// && length $dir) {
+ if (-d "$dir/.git") {
+ return "git";
+ }
+ }
+
+ die "gnucommit: not in a cvs, subversion, baz, bzr, git, hg, or svk working copy\n";
+}
+
+sub action {
+ my $prog=shift;
+ print $prog, " ",
+ join(" ", map { if (/[^-A-Za-z0-9]/) { s/'/'\\''/g; "'$_'" } else { $_ } } @_), "\n";
+ return 1 if $noact;
+ return (system($prog, @_) != 0) ? 0 : 1;
+}
+
+sub commit {
+ my $message=shift;
+
+ die "gnucommit: can't specify a list of files to commit when using --all\n"
+ if (@files_to_commit and $all);
+
+ if ($prog =~ /^(cvs|svn|svk|bzr|hg)$/) {
+ my $author = getauthor();
+ my @author;
+ if ($prog eq 'bzr' and defined $author) {
+ @author = ('--author', $author);
+ }
+ if (! action($prog, "commit", @author, "-m", $message, @files_to_commit)) {
+ die "gnucommit: commit failed\n";
+ }
+ }
+ elsif ($prog eq 'git') {
+ if (! @files_to_commit && $all) {
+ # check to see if the WC is clean. git-commit would exit
+ # nonzero, so don't run it.
+ my $status=`LANG=C git status`;
+ if ($status=~/nothing to commit \(working directory clean\)/) {
+ print $status;
+ return;
+ }
+ }
+ if ($all) {
+ @files_to_commit=("-a")
+ }
+ if (! action($prog, "commit", "-m", $message, @files_to_commit)) {
+ die "gnucommit: commit failed\n";
+ }
+ }
+ elsif ($prog eq 'tla' || $prog eq 'baz') {
+ my $summary=$message;
+ $summary=~s/^((?:\* )?[^\n]{1,72})(?:(?:\s|\n).*|$)/$1/ms;
+ my @args;
+ if ($summary eq $message) {
+ $summary=~s/^\* //s;
+ @args=("-s", $summary);
+ } else {
+ $summary=~s/^\* //s;
+ @args=("-s", "$summary ...", "-L", $message);
+ }
+ push(
+ @args,
+ (($prog eq 'tla') ? '--' : ()),
+ @files_to_commit,
+ ) if @files_to_commit;
+
+ if (! action($prog, "commit", @args)) {
+ die "gnucommit: commit failed\n";
+ }
+ }
+ else {
+ die "gnucommit: unknown program $prog";
+ }
+}
+
+sub tag {
+ my $tag=shift;
+
+ if ($prog eq 'svn' || $prog eq 'svk') {
+ my $svnpath=`svnpath`;
+ chomp $svnpath;
+ my $tagpath=`svnpath tags`;
+ chomp $tagpath;
+
+ if (! action($prog, "copy", $svnpath, "$tagpath/$tag",
+ "-m", "tagging version $tag")) {
+ if (! action($prog, "mkdir", $tagpath,
+ "-m", "create tag directory") ||
+ ! action($prog, "copy", $svnpath, "$tagpath/$tag",
+ "-m", "tagging version $tag")) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ }
+ elsif ($prog eq 'cvs') {
+ $tag=~s/^[0-9]+://; # strip epoch
+ $tag=~tr/./_/; # mangle for cvs
+ $tag="debian_version_$tag";
+ if (! action("cvs", "tag", "-f", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'tla' || $prog eq 'baz') {
+ my $archpath=`archpath`;
+ chomp $archpath;
+ my $tagpath=`archpath releases--\Q$tag\E`;
+ chomp $tagpath;
+ my $subcommand;
+ if ($prog eq 'baz') {
+ $subcommand="branch";
+ } else {
+ $subcommand="tag";
+ }
+
+ if (! action($prog, $subcommand, $archpath, $tagpath)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'bzr') {
+ if (action("$prog tags >/dev/null 2>&1")) {
+ if (! action($prog, "tag", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ } else {
+ die "gnucommit: bazaar or branch version too old to support tags\n";
+ }
+ }
+ elsif ($prog eq 'git') {
+ $tag=~s/^[0-9]+://; # strip epoch
+ if ($tag=~/-/) {
+ # not a native package, so tag as a debian release
+ $tag="debian/$tag";
+ }
+
+ if ($signtags) {
+ if (defined $keyid) {
+ if (! action($prog, "tag", "-u", $keyid, "-m",
+ "tagging version $tag", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ else {
+ if (! action($prog, "tag", "-s", "-m",
+ "tagging version $tag", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ }
+ elsif (! action($prog, "tag", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'hg') {
+ $tag="debian-$tag";
+ if (! action($prog, "tag", "-m", "tagging version $tag", $tag)) {
+ die "gnucommit: failed tagging with $tag\n";
+ }
+ }
+ else {
+ die "gnucommit: unknown program $prog";
+ }
+}
+
+sub getauthor {
+ my $ret;
+
+ if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
+ $ret='';
+ my @diffcmd;
+
+ if ($prog eq 'tla' || $prog eq 'baz') {
+ @diffcmd = ($prog, 'file-diff');
+ } elsif ($prog eq 'git') {
+ if ($all) {
+ @diffcmd = ('git-diff');
+ } else {
+ @diffcmd = ('git-diff', '--cached');
+ }
+ } else {
+ @diffcmd = ($prog, 'diff');
+ }
+
+ open CHLOG, '-|', @diffcmd, $changelog
+ or die "gnucommit: cannot run $diffcmd[0]: $!\n";
+
+ foreach (<CHLOG>) {
+ next unless /^\+[0-9]/;
+ s/^\+//;
+ chomp;
+ s/^.* //; # date
+ s/ / /g;
+ if (/^Colin Watson /) {
+ last;
+ } else {
+ $ret = $_;
+ last;
+ }
+ }
+
+ close CHLOG;
+ }
+ else {
+ die "gnucommit: unknown program $prog";
+ }
+
+ return $ret;
+}
+
+sub getmessage {
+ my $ret;
+
+ if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
+ $ret='';
+ my @diffcmd;
+
+ if ($prog eq 'tla' || $prog eq 'baz') {
+ @diffcmd = ($prog, 'file-diff');
+ } elsif ($prog eq 'git') {
+ if ($all) {
+ @diffcmd = ('git-diff');
+ } else {
+ @diffcmd = ('git-diff', '--cached');
+ }
+ } else {
+ @diffcmd = ($prog, 'diff');
+ }
+
+ open CHLOG, '-|', @diffcmd, $changelog
+ or die "gnucommit: cannot run $diffcmd[0]: $!\n";
+
+ # TODO should keep intermediate whitespace in message
+ foreach (<CHLOG>) {
+ next unless /^\+\t/;
+ s/^\+\t//;
+ $ret .= $_;
+ }
+
+ if (! length $ret) {
+ my $info='';
+ if ($prog eq 'git') {
+ $info = ' (do you mean "gnucommit -a" or did you forget to run "git add"?)';
+ }
+ die "gnucommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n";
+ } else {
+ if ($stripmessage) {
+ my $count = () = $ret =~ /^\* /mg;
+ if ($count == 1) {
+ $ret =~ s/^\* //;
+ }
+ }
+ }
+ }
+ else {
+ die "gnucommit: unknown program $prog";
+ }
+
+ chomp $ret;
+ return $ret;
+}
+
+sub confirm {
+ my $message=shift;
+ print $message, "\n--\n";
+ while(1) {
+ print "OK to commit? [Y/n] ";
+ $_ = <STDIN>;
+ return 0 if /^n/i;
+ return 1 if /^(y|$)/i;
+ }
+}
+
+=head1 LICENSE
+
+This code is copyright by Joey Hess <joeyh@debian.org>, 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.
+
+=head1 AUTHOR
+
+Joey Hess <joeyh@debian.org>
+
+=head1 SEE ALSO
+
+L<svnpath(1)>.
+
+=cut
--- /dev/null
+#!/usr/bin/perl
+
+=head1 NAME
+
+mdcommit - commit changes to man-db
+
+=head1 SYNOPSIS
+
+B<mdcommit> [B<--release>] [B<--message=>I<text>] [B<--noact>] [B<--confirm>] [B<--changelog=>I<path>] [B<--all> | I<files to commit>]
+
+=head1 DESCRIPTION
+
+B<mdcommit> generates a commit message based on new text in B<docs/ChangeLog>,
+and commits the change to man-db's repository. It must be run in a working
+copy for the package. Supported version control systems are:
+B<bzr>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c> B<--changelog> I<path>
+
+Specify an alternate location for the changelog. By default docs/ChangeLog is
+used.
+
+=item B<-r> B<--release>
+
+Commit a release of the package. The version number is determined from
+docs/ChangeLog, and is used to tag the package in the repository.
+
+Note that svn/svk tagging conventions vary, so mdcommit uses
+L<svnpath(1)> to determine where the tag should be placed in the
+repository.
+
+=item B<-m> I<text> B<--message> I<text>
+
+Specify a commit message to use. Useful if the program cannot determine
+a commit message on its own based on docs/ChangeLog, or if you want to
+override the default message.
+
+=item B<-n> B<--noact>
+
+Do not actually do anything, but do print the commands that would be run.
+
+=item B<-C> B<--confirm>
+
+Display the generated commit message and ask for confirmation before committing
+it.
+
+=item B<-a> B<--all>
+
+Commit all files. This is the default operation when using a VCS other
+than git.
+
+=item I<files to commit>
+
+Specify which files to commit (docs/ChangeLog is added to the list
+automatically.)
+
+=item B<-s> B<--strip-message>, B<--no-strip-message>
+
+If this option is set and the commit message has been derived from the
+changelog, the characters "* " will be stripped from the beginning of
+the message.
+
+This option is ignored if more than one line of the message
+begins with "* ".
+
+=item B<--sign-tags>, B<--no-sign-tags>
+
+If this option is set, then tags that mdcommit creates will be signed
+using gnupg. Currently this is only supported by git.
+
+=over 4
+
+=back
+
+=head1 CONFIGURATION VARIABLES
+
+The two configuration files F</etc/devscripts.conf> and
+F<~/.devscripts> are sourced by a shell in that order to set
+configuration variables. Command line options can be used to override
+configuration file settings. Environment variable settings are
+ignored for this purpose. The currently recognised variables are:
+
+=over 4
+
+=item B<DEBCOMMIT_STRIP_MESSAGE>
+
+If this is set to I<yes>, then it is the same as the --strip-message
+command line parameter being used. The default is I<no>.
+
+=item B<DEBCOMMIT_SIGN_TAGS>
+
+If this is set to I<yes>, then it is the same as the --sign-tags command
+line parameter being used. The default is I<no>.
+
+=item B<DEBSIGN_KEYID>
+
+This is the key id used for signing tags. If not set, a default will be
+chosen by the revision control system.
+
+=cut
+
+use warnings;
+use strict;
+use Getopt::Long;
+use Cwd;
+use File::Basename;
+my $progname = basename($0);
+
+my $modified_conf_msg;
+
+sub usage {
+ print <<"EOT";
+Usage: $progname [options] [files to commit]
+ $progname --version
+ $progname --help
+
+Generates a commit message based on new text in docs/ChangeLog,
+and commit the change to a package\'s repository.
+
+Options:
+ -c --changelog=path Specify the location of the changelog
+ -r --release Commit a release of the package and create a tag
+ -m --message=text Specify a commit message
+ -n --noact Dry run, no actual commits
+ -C --confirm Ask for confirmation of the message before commit
+ -a --all Commit all files (default except for git)
+ -s --strip-message Strip the leading '* ' from the commit message
+ --no-strip-message Do not strip a leading '* ' (default)
+ --sign-tags Enable signing of tags (git only)
+ --no-sign-tags Do not sign tags (default)
+ -h --help This message
+ -v --version Version information
+
+ --no-conf, --noconf
+ Don\'t read devscripts config files;
+ must be the first option given
+
+Default settings modified by devscripts configuration files:
+$modified_conf_msg
+
+EOT
+}
+
+sub version {
+ print <<"EOF";
+This is $progname, from the Debian devscripts package, version 2.10.11
+This code is copyright by Joey Hess <joeyh\@debian.org>, 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 $release=0;
+my $message;
+my $noact=0;
+my $confirm=0;
+my $all=0;
+my $stripmessage=0;
+my $signtags=0;
+my $changelog="docs/ChangeLog";
+my $keyid;
+
+# Now start by reading 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 = ('/etc/devscripts.conf', '~/.devscripts');
+ my %config_vars = (
+ 'DEBCOMMIT_STRIP_MESSAGE' => 'no',
+ 'DEBCOMMIT_SIGN_TAGS' => 'no',
+ 'DEBSIGN_KEYID' => '',
+ );
+ 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{'DEBCOMMIT_STRIP_MESSAGE'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCOMMIT_STRIP_MESSAGE'}='no';
+ $config_vars{'DEBCOMMIT_SIGN_TAGS'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCOMMIT_SIGN_TAGS'}='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;
+
+ $stripmessage = $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} eq 'no' ? 0 : 1;
+ $signtags = $config_vars{'DEBCOMMIT_SIGN_TAGS'} eq 'no' ? 0 : 1;
+ if (exists $config_vars{'DEBSIGN_KEYID'} &&
+ length $config_vars{'DEBSIGN_KEYID'}) {
+ $keyid=$config_vars{'DEBSIGN_KEYID'};
+ }
+}
+
+# Now read the command line arguments
+
+Getopt::Long::Configure("bundling");
+if (! GetOptions(
+ "r|release" => \$release,
+ "m|message=s" => \$message,
+ "n|noact" => \$noact,
+ "C|confirm" => \$confirm,
+ "a|all" => \$all,
+ "c|changelog=s" => \$changelog,
+ "s|strip-message!" => \$stripmessage,
+ "sign-tags!" => \$signtags,
+ "h|help" => sub { usage(); exit 0; },
+ "v|version" => sub { version(); exit 0; },
+ )) {
+ die "Usage: mdcommit [--release] [--message=text] [--noact] [--confirm] [--changelog=path] [--all | files to commit]\n";
+}
+
+my @files_to_commit = @ARGV;
+if (@files_to_commit && !grep(/$changelog/,@files_to_commit)) {
+ push @files_to_commit, $changelog;
+}
+
+my $prog=getprog();
+if (! -e $changelog) {
+ die "mdcommit: cannot find $changelog\n";
+}
+
+if ($release) {
+ open (C, "<$changelog" ) || die "mdcommit: cannot read $changelog: $!";
+ <C>; <C>;
+ my $firstline=<C>;
+ if ($firstline!~/Version: ([0-9][a-z0-9.-]*)/) {
+ die "mdcommit: no Version: changelog entry found\n";
+ }
+ close C;
+
+ my $version=$1;
+ $version=~s/\.$//;
+
+ #$message="releasing version $version" if ! defined $message;
+ $message=getmessage() if ! defined $message;
+ commit($message);
+ tag($version);
+}
+else {
+ $message=getmessage() if ! defined $message;
+ commit($message) if not $confirm or confirm($message);
+}
+
+sub getprog {
+ if (-d ".svn") {
+ return "svn";
+ }
+ if (-d "CVS") {
+ return "cvs";
+ }
+ if (-d "{arch}") {
+ # I don't think we can tell just from the working copy
+ # whether to use tla or baz, so try baz if it's available,
+ # otherwise fall back to tla.
+ if (system ("baz --version >/dev/null 2>&1") == 0) {
+ return "baz";
+ } else {
+ return "tla";
+ }
+ }
+ if (-d ".bzr") {
+ return "bzr";
+ }
+ if (-d ".git") {
+ return "git";
+ }
+ if (-d ".hg") {
+ return "hg";
+ }
+
+ # Test for this file to avoid interactive prompting from svk.
+ if (-d "$ENV{HOME}/.svk/local") {
+ # svk has no useful directories so try to run it.
+ my $svkpath=`svk info . 2>/dev/null| grep -i '^Depot Path:' | cut -d ' ' -f 3`;
+ if (length $svkpath) {
+ return "svk";
+ }
+ }
+
+ # .git may be in a parent directory, rather than the current
+ # directory, if multiple packages are kept in one git repository.
+ my $dir=getcwd();
+ while ($dir=~s/[^\/]*\/?$// && length $dir) {
+ if (-d "$dir/.git") {
+ return "git";
+ }
+ }
+
+ die "mdcommit: not in a cvs, subversion, baz, bzr, git, hg, or svk working copy\n";
+}
+
+sub action {
+ my $prog=shift;
+ print $prog, " ",
+ join(" ", map { if (/[^-A-Za-z0-9]/) { s/'/'\\''/g; "'$_'" } else { $_ } } @_), "\n";
+ return 1 if $noact;
+ return (system($prog, @_) != 0) ? 0 : 1;
+}
+
+sub commit {
+ my $message=shift;
+
+ die "mdcommit: can't specify a list of files to commit when using --all\n"
+ if (@files_to_commit and $all);
+
+ if ($prog =~ /^(cvs|svn|svk|bzr|hg)$/) {
+ my $author = getauthor();
+ my @author;
+ if (defined $author) {
+ @author = ('--author', $author);
+ }
+ if (! action($prog, "commit", @author, "-m", $message, @files_to_commit)) {
+ die "mdcommit: commit failed\n";
+ }
+ }
+ elsif ($prog eq 'git') {
+ if (! @files_to_commit && $all) {
+ # check to see if the WC is clean. git-commit would exit
+ # nonzero, so don't run it.
+ my $status=`LANG=C git status`;
+ if ($status=~/nothing to commit \(working directory clean\)/) {
+ print $status;
+ return;
+ }
+ }
+ if ($all) {
+ @files_to_commit=("-a")
+ }
+ if (! action($prog, "commit", "-m", $message, @files_to_commit)) {
+ die "mdcommit: commit failed\n";
+ }
+ }
+ elsif ($prog eq 'tla' || $prog eq 'baz') {
+ my $summary=$message;
+ $summary=~s/^((?:\* )?[^\n]{1,72})(?:(?:\s|\n).*|$)/$1/ms;
+ my @args;
+ if ($summary eq $message) {
+ $summary=~s/^\* //s;
+ @args=("-s", $summary);
+ } else {
+ $summary=~s/^\* //s;
+ @args=("-s", "$summary ...", "-L", $message);
+ }
+ push(
+ @args,
+ (($prog eq 'tla') ? '--' : ()),
+ @files_to_commit,
+ ) if @files_to_commit;
+
+ if (! action($prog, "commit", @args)) {
+ die "mdcommit: commit failed\n";
+ }
+ }
+ else {
+ die "mdcommit: unknown program $prog";
+ }
+}
+
+sub tag {
+ my $tag=shift;
+
+ if ($prog eq 'svn' || $prog eq 'svk') {
+ my $svnpath=`svnpath`;
+ chomp $svnpath;
+ my $tagpath=`svnpath tags`;
+ chomp $tagpath;
+
+ if (! action($prog, "copy", $svnpath, "$tagpath/$tag",
+ "-m", "tagging version $tag")) {
+ if (! action($prog, "mkdir", $tagpath,
+ "-m", "create tag directory") ||
+ ! action($prog, "copy", $svnpath, "$tagpath/$tag",
+ "-m", "tagging version $tag")) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ }
+ elsif ($prog eq 'cvs') {
+ $tag=~s/^[0-9]+://; # strip epoch
+ $tag=~tr/./_/; # mangle for cvs
+ $tag="debian_version_$tag";
+ if (! action("cvs", "tag", "-f", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'tla' || $prog eq 'baz') {
+ my $archpath=`archpath`;
+ chomp $archpath;
+ my $tagpath=`archpath releases--\Q$tag\E`;
+ chomp $tagpath;
+ my $subcommand;
+ if ($prog eq 'baz') {
+ $subcommand="branch";
+ } else {
+ $subcommand="tag";
+ }
+
+ if (! action($prog, $subcommand, $archpath, $tagpath)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'bzr') {
+ if (action("$prog tags >/dev/null 2>&1")) {
+ if (! action($prog, "tag", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ } else {
+ die "mdcommit: bazaar or branch version too old to support tags\n";
+ }
+ }
+ elsif ($prog eq 'git') {
+ $tag=~s/^[0-9]+://; # strip epoch
+ if ($tag=~/-/) {
+ # not a native package, so tag as a debian release
+ $tag="debian/$tag";
+ }
+
+ if ($signtags) {
+ if (defined $keyid) {
+ if (! action($prog, "tag", "-u", $keyid, "-m",
+ "tagging version $tag", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ else {
+ if (! action($prog, "tag", "-s", "-m",
+ "tagging version $tag", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ }
+ elsif (! action($prog, "tag", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ elsif ($prog eq 'hg') {
+ $tag="debian-$tag";
+ if (! action($prog, "tag", "-m", "tagging version $tag", $tag)) {
+ die "mdcommit: failed tagging with $tag\n";
+ }
+ }
+ else {
+ die "mdcommit: unknown program $prog";
+ }
+}
+
+sub getauthor {
+ open CHLOG, '-|', ('bzr', 'diff'), $changelog
+ or die "mdcommit: cannot run bzr: $!\n";
+ foreach (<CHLOG>) {
+ next unless /^\+[A-Z]/;
+ s/^\+//;
+ chomp;
+ s/^.{30}//; # date
+ s/ / /g;
+ if (/^Colin Watson /) {
+ close CHLOG;
+ return;
+ } else {
+ close CHLOG;
+ return $_;
+ }
+ }
+ close CHLOG;
+}
+
+sub getmessage {
+ my $ret;
+
+ if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
+ $ret='';
+ my @diffcmd;
+
+ if ($prog eq 'tla' || $prog eq 'baz') {
+ @diffcmd = ($prog, 'file-diff');
+ } elsif ($prog eq 'git') {
+ if ($all) {
+ @diffcmd = ('git-diff');
+ } else {
+ @diffcmd = ('git-diff', '--cached');
+ }
+ } else {
+ @diffcmd = ($prog, 'diff');
+ }
+
+ open CHLOG, '-|', @diffcmd, $changelog
+ or die "mdcommit: cannot run $diffcmd[0]: $!\n";
+
+ # TODO should keep intermediate whitespace in message
+ foreach (<CHLOG>) {
+ next unless /^\+\t/;
+ s/^\+\t//;
+ $ret .= $_;
+ }
+
+ if (! length $ret) {
+ my $info='';
+ if ($prog eq 'git') {
+ $info = ' (do you mean "mdcommit -a" or did you forget to run "git add"?)';
+ }
+ die "mdcommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n";
+ } else {
+ if ($stripmessage) {
+ my $count = () = $ret =~ /^\* /mg;
+ if ($count == 1) {
+ $ret =~ s/^\* //;
+ }
+ }
+ }
+ }
+ else {
+ die "mdcommit: unknown program $prog";
+ }
+
+ chomp $ret;
+ return $ret;
+}
+
+sub confirm {
+ my $message=shift;
+ print $message, "\n--\n";
+ while(1) {
+ print "OK to commit? [Y/n] ";
+ $_ = <STDIN>;
+ return 0 if /^n/i;
+ return 1 if /^(y|$)/i;
+ }
+}
+
+=head1 LICENSE
+
+This code is copyright by Joey Hess <joeyh@debian.org>, 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.
+
+=head1 AUTHOR
+
+Joey Hess <joeyh@debian.org>
+
+=head1 SEE ALSO
+
+L<svnpath(1)>.
+
+=cut
~cjwatson / bin.git / commitdiff