From 8b17dec64effc0c9927c556d0e245a0ea089c808 Mon Sep 17 00:00:00 2001 From: Colin Watson Date: Tue, 15 Apr 2008 16:12:02 +0000 Subject: [PATCH] add mdcommit and gnucommit, hacky variants of debcommit for other projects --- gnucommit | 593 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ mdcommit | 568 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1161 insertions(+) create mode 100755 gnucommit create mode 100755 mdcommit diff --git a/gnucommit b/gnucommit new file mode 100755 index 0000000..e167903 --- /dev/null +++ b/gnucommit @@ -0,0 +1,593 @@ +#!/usr/bin/perl + +=head1 NAME + +gnucommit - commit changes to packages with GNU-format ChangeLog files + +=head1 SYNOPSIS + +B [B<--release>] [B<--message=>I] [B<--noact>] [B<--confirm>] [B<--changelog=>I] [B<--all> | I] + +=head1 DESCRIPTION + +B generates a commit message based on new text in B, +and commits the change to the repository. It must be run in a working +copy for the package. Supported version control systems are: +B (subversion), B. + +=head1 OPTIONS + +=over 4 + +=item B<-c> B<--changelog> I + +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 to determine where the tag should be placed in the +repository. + +=item B<-m> I B<--message> I + +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 + +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 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 + +If this is set to I, then it is the same as the --strip-message +command line parameter being used. The default is I. + +=item B + +If this is set to I, then it is the same as the --sign-tags command +line parameter being used. The default is I. + +=item B + +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 , 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: $!"; + ; ; + my $firstline=; + 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 () { + 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 () { + 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] "; + $_ = ; + return 0 if /^n/i; + return 1 if /^(y|$)/i; + } +} + +=head1 LICENSE + +This code is copyright by Joey Hess , 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 + +=head1 SEE ALSO + +L. + +=cut diff --git a/mdcommit b/mdcommit new file mode 100755 index 0000000..246e26d --- /dev/null +++ b/mdcommit @@ -0,0 +1,568 @@ +#!/usr/bin/perl + +=head1 NAME + +mdcommit - commit changes to man-db + +=head1 SYNOPSIS + +B [B<--release>] [B<--message=>I] [B<--noact>] [B<--confirm>] [B<--changelog=>I] [B<--all> | I] + +=head1 DESCRIPTION + +B generates a commit message based on new text in B, +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. + +=head1 OPTIONS + +=over 4 + +=item B<-c> B<--changelog> I + +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 to determine where the tag should be placed in the +repository. + +=item B<-m> I B<--message> I + +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 + +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 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 + +If this is set to I, then it is the same as the --strip-message +command line parameter being used. The default is I. + +=item B + +If this is set to I, then it is the same as the --sign-tags command +line parameter being used. The default is I. + +=item B + +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 , 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: $!"; + ; ; + my $firstline=; + 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 () { + 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 () { + 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] "; + $_ = ; + return 0 if /^n/i; + return 1 if /^(y|$)/i; + } +} + +=head1 LICENSE + +This code is copyright by Joey Hess , 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 + +=head1 SEE ALSO + +L. + +=cut -- 2.30.2