chiark / gitweb /
bsmtp-pull: drop -2; avoid connection sharing
[bin.git] / mdcommit
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 mdcommit - commit changes to man-db
6
7 =head1 SYNOPSIS
8
9 B<mdcommit> [B<--release>] [B<--message=>I<text>] [B<--noact>] [B<--confirm>] [B<--changelog=>I<path>] [B<--all> | I<files to commit>]
10
11 =head1 DESCRIPTION
12
13 B<mdcommit> generates a commit message based on new text in B<docs/ChangeLog>,
14 and commits the change to man-db's repository. It must be run in a working
15 copy for the package. Supported version control systems are:
16 B<bzr>.
17
18 =head1 OPTIONS
19
20 =over 4
21
22 =item B<-c> B<--changelog> I<path>
23
24 Specify an alternate location for the changelog. By default docs/ChangeLog is
25 used.
26
27 =item B<-r> B<--release>
28
29 Commit a release of the package. The version number is determined from
30 docs/ChangeLog, and is used to tag the package in the repository.
31
32 Note that svn/svk tagging conventions vary, so mdcommit uses
33 L<svnpath(1)> to determine where the tag should be placed in the
34 repository.
35
36 =item B<-m> I<text> B<--message> I<text>
37
38 Specify a commit message to use. Useful if the program cannot determine
39 a commit message on its own based on docs/ChangeLog, or if you want to
40 override the default message.
41
42 =item B<-n> B<--noact>
43
44 Do not actually do anything, but do print the commands that would be run.
45
46 =item B<-C> B<--confirm>
47
48 Display the generated commit message and ask for confirmation before committing
49 it.
50
51 =item B<-a> B<--all>
52
53 Commit all files. This is the default operation when using a VCS other 
54 than git.
55
56 =item I<files to commit>
57
58 Specify which files to commit (docs/ChangeLog is added to the list
59 automatically.)
60
61 =item B<-s> B<--strip-message>, B<--no-strip-message>
62
63 If this option is set and the commit message has been derived from the 
64 changelog, the characters "* " will be stripped from the beginning of 
65 the message.
66
67 This option is ignored if more than one line of the message 
68 begins with "* ".
69
70 =item B<--sign-tags>, B<--no-sign-tags>
71
72 If this option is set, then tags that mdcommit creates will be signed
73 using gnupg. Currently this is only supported by git.
74
75 =over 4
76
77 =back
78
79 =head1 CONFIGURATION VARIABLES
80
81 The two configuration files F</etc/devscripts.conf> and
82 F<~/.devscripts> are sourced by a shell in that order to set
83 configuration variables.  Command line options can be used to override
84 configuration file settings.  Environment variable settings are
85 ignored for this purpose.  The currently recognised variables are:
86
87 =over 4
88
89 =item B<DEBCOMMIT_STRIP_MESSAGE>
90
91 If this is set to I<yes>, then it is the same as the --strip-message 
92 command line parameter being used. The default is I<no>.
93
94 =item B<DEBCOMMIT_SIGN_TAGS>
95
96 If this is set to I<yes>, then it is the same as the --sign-tags command
97 line parameter being used. The default is I<no>.
98
99 =item B<DEBSIGN_KEYID>
100
101 This is the key id used for signing tags. If not set, a default will be
102 chosen by the revision control system.
103
104 =cut
105
106 use warnings;
107 use strict;
108 use Getopt::Long;
109 use Cwd;
110 use File::Basename;
111 my $progname = basename($0);
112
113 my $modified_conf_msg;
114
115 sub usage {
116     print <<"EOT";
117 Usage: $progname [options] [files to commit]
118        $progname --version
119        $progname --help
120
121 Generates a commit message based on new text in docs/ChangeLog,
122 and commit the change to a package\'s repository.
123
124 Options:
125    -c --changelog=path Specify the location of the changelog                 
126    -r --release        Commit a release of the package and create a tag
127    -m --message=text   Specify a commit message
128    -n --noact          Dry run, no actual commits
129    -C --confirm        Ask for confirmation of the message before commit
130    -a --all            Commit all files (default except for git)
131    -s --strip-message  Strip the leading '* ' from the commit message
132    --no-strip-message  Do not strip a leading '* ' (default)
133    --sign-tags         Enable signing of tags (git only)
134    --no-sign-tags      Do not sign tags (default)
135    -h --help           This message
136    -v --version        Version information
137
138    --no-conf, --noconf
139                    Don\'t read devscripts config files;
140                    must be the first option given
141
142 Default settings modified by devscripts configuration files:
143 $modified_conf_msg
144
145 EOT
146 }
147
148 sub version {
149     print <<"EOF";
150 This is $progname, from the Debian devscripts package, version 2.10.11
151 This code is copyright by Joey Hess <joeyh\@debian.org>, all rights reserved.
152 This program comes with ABSOLUTELY NO WARRANTY.
153 You are free to redistribute this code under the terms of the
154 GNU General Public License, version 2 or later.
155 EOF
156 }
157
158 my $release=0;
159 my $message;
160 my $noact=0;
161 my $confirm=0;
162 my $all=0;
163 my $stripmessage=0;
164 my $signtags=0;
165 my $changelog="docs/ChangeLog";
166 my $keyid;
167
168 # Now start by reading configuration files and then command line
169 # The next stuff is boilerplate
170
171 if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
172     $modified_conf_msg = "  (no configuration files read)";
173     shift;
174 } else {
175     my @config_files = ('/etc/devscripts.conf', '~/.devscripts');
176     my %config_vars = (
177                        'DEBCOMMIT_STRIP_MESSAGE' => 'no',
178                        'DEBCOMMIT_SIGN_TAGS' => 'no',
179                        'DEBSIGN_KEYID' => '',
180                       );
181     my %config_default = %config_vars;
182
183     my $shell_cmd;
184     # Set defaults
185     foreach my $var (keys %config_vars) {
186         $shell_cmd .= qq[$var="$config_vars{$var}";\n];
187     }
188     $shell_cmd .= 'for file in ' . join(" ",@config_files) . "; do\n";
189     $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
190     # Read back values
191     foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
192     my $shell_out = `/bin/bash -c '$shell_cmd'`;
193     @config_vars{keys %config_vars} = split /\n/, $shell_out, -1;
194
195     # Check validity
196     $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} =~ /^(yes|no)$/
197         or $config_vars{'DEBCOMMIT_STRIP_MESSAGE'}='no';
198     $config_vars{'DEBCOMMIT_SIGN_TAGS'} =~ /^(yes|no)$/
199         or $config_vars{'DEBCOMMIT_SIGN_TAGS'}='no';
200
201     foreach my $var (sort keys %config_vars) {
202         if ($config_vars{$var} ne $config_default{$var}) {
203             $modified_conf_msg .= "  $var=$config_vars{$var}\n";
204         }
205     }
206     $modified_conf_msg ||= "  (none)\n";
207     chomp $modified_conf_msg;
208
209     $stripmessage = $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} eq 'no' ? 0 : 1;
210     $signtags = $config_vars{'DEBCOMMIT_SIGN_TAGS'} eq 'no' ? 0 : 1;
211     if (exists $config_vars{'DEBSIGN_KEYID'} &&
212         length $config_vars{'DEBSIGN_KEYID'}) {
213         $keyid=$config_vars{'DEBSIGN_KEYID'};
214     }
215 }
216
217 # Now read the command line arguments
218
219 Getopt::Long::Configure("bundling");
220 if (! GetOptions(
221                  "r|release" => \$release,
222                  "m|message=s" => \$message,
223                  "n|noact" => \$noact,
224                  "C|confirm" => \$confirm,
225                  "a|all" => \$all,
226                  "c|changelog=s" => \$changelog,
227                  "s|strip-message!" => \$stripmessage,
228                  "sign-tags!" => \$signtags,
229                  "h|help" => sub { usage(); exit 0; },
230                  "v|version" => sub { version(); exit 0; },
231                  )) {
232     die "Usage: mdcommit [--release] [--message=text] [--noact] [--confirm] [--changelog=path] [--all | files to commit]\n";
233 }
234
235 my @files_to_commit = @ARGV;
236 if (@files_to_commit && !grep(/$changelog/,@files_to_commit)) {
237     push @files_to_commit, $changelog;
238 }
239
240 my $prog=getprog();
241 if (! -e $changelog) {
242     die "mdcommit: cannot find $changelog\n";
243 }
244
245 if ($release) {
246     open (C, "<$changelog" ) || die "mdcommit: cannot read $changelog: $!";
247     <C>; <C>;
248     my $firstline=<C>;
249     if ($firstline!~/Version: ([0-9][a-z0-9.-]*)/) {
250         die "mdcommit: no Version: changelog entry found\n";
251     }
252     close C;
253     
254     my $version=$1;
255     $version=~s/\.$//;
256
257     #$message="releasing version $version" if ! defined $message;
258     $message=getmessage() if ! defined $message;
259     commit($message);
260     tag($version);
261 }
262 else {
263     $message=getmessage() if ! defined $message;
264     commit($message) if not $confirm or confirm($message);
265 }
266
267 sub getprog {
268     if (-d ".svn") {
269         return "svn";
270     }
271     if (-d "CVS") {
272         return "cvs";
273     }
274     if (-d "{arch}") {
275         # I don't think we can tell just from the working copy
276         # whether to use tla or baz, so try baz if it's available,
277         # otherwise fall back to tla.
278         if (system ("baz --version >/dev/null 2>&1") == 0) {
279             return "baz";
280         } else {
281             return "tla";
282         }
283     }
284     if (-d ".bzr") {
285         return "bzr";
286     }
287     if (-d ".git") {
288         return "git";
289     }
290     if (-d ".hg") {
291         return "hg";
292     }
293
294     # Test for this file to avoid interactive prompting from svk.
295     if (-d "$ENV{HOME}/.svk/local") {
296         # svk has no useful directories so try to run it.
297         my $svkpath=`svk info . 2>/dev/null| grep -i '^Depot Path:' | cut -d ' ' -f 3`;
298         if (length $svkpath) {
299             return "svk";
300         }
301     }
302
303     # .git may be in a parent directory, rather than the current
304     # directory, if multiple packages are kept in one git repository.
305     my $dir=getcwd();
306     while ($dir=~s/[^\/]*\/?$// && length $dir) {
307         if (-d "$dir/.git") {
308                 return "git";
309         }
310     }
311
312     die "mdcommit: not in a cvs, subversion, baz, bzr, git, hg, or svk working copy\n";
313 }
314
315 sub action {
316     my $prog=shift;
317     print $prog, " ",
318       join(" ", map { if (/[^-A-Za-z0-9]/) { s/'/'\\''/g; "'$_'" } else { $_ } } @_), "\n";
319     return 1 if $noact;
320     return (system($prog, @_) != 0) ? 0 : 1;
321 }
322
323 sub commit {
324     my $message=shift;
325     
326     die "mdcommit: can't specify a list of files to commit when using --all\n"
327         if (@files_to_commit and $all);
328
329     if ($prog =~ /^(cvs|svn|svk|bzr|hg)$/) {
330         my $author = getauthor();
331         my @author;
332         if (defined $author) {
333             @author = ('--author', $author);
334         }
335         if (! action($prog, "commit", @author, "-m", $message, @files_to_commit)) {
336             die "mdcommit: commit failed\n";
337         }
338     }
339     elsif ($prog eq 'git') {
340         if (! @files_to_commit && $all) {
341             # check to see if the WC is clean. git-commit would exit
342             # nonzero, so don't run it.
343             my $status=`LANG=C git status`;
344             if ($status=~/nothing to commit \(working directory clean\)/) {
345                     print $status;
346                     return;
347             }
348         }
349         if ($all) {
350             @files_to_commit=("-a")
351         }
352         if (! action($prog, "commit", "-m", $message, @files_to_commit)) {
353             die "mdcommit: commit failed\n";
354         }
355     }
356     elsif ($prog eq 'tla' || $prog eq 'baz') {
357         my $summary=$message;
358         $summary=~s/^((?:\* )?[^\n]{1,72})(?:(?:\s|\n).*|$)/$1/ms;
359         my @args;
360         if ($summary eq $message) {
361             $summary=~s/^\* //s;
362             @args=("-s", $summary);
363         } else {
364             $summary=~s/^\* //s;
365             @args=("-s", "$summary ...", "-L", $message);
366         }
367         push(
368             @args,
369             (($prog eq 'tla') ? '--' : ()),
370             @files_to_commit,
371         ) if @files_to_commit;
372
373         if (! action($prog, "commit", @args)) {
374             die "mdcommit: commit failed\n";
375         }
376     }
377     else {
378         die "mdcommit: unknown program $prog";
379     }
380 }
381
382 sub tag {
383     my $tag=shift;
384     
385     if ($prog eq 'svn' || $prog eq 'svk') {
386         my $svnpath=`svnpath`;
387         chomp $svnpath;
388         my $tagpath=`svnpath tags`;
389         chomp $tagpath;
390         
391         if (! action($prog, "copy", $svnpath, "$tagpath/$tag",
392                      "-m", "tagging version $tag")) {
393             if (! action($prog, "mkdir", $tagpath,
394                          "-m", "create tag directory") ||
395                 ! action($prog, "copy", $svnpath, "$tagpath/$tag",
396                          "-m", "tagging version $tag")) {
397                 die "mdcommit: failed tagging with $tag\n";
398             }
399         }
400     }
401     elsif ($prog eq 'cvs') {
402         $tag=~s/^[0-9]+://; # strip epoch
403         $tag=~tr/./_/;      # mangle for cvs
404         $tag="debian_version_$tag";
405         if (! action("cvs", "tag", "-f", $tag)) {
406             die "mdcommit: failed tagging with $tag\n";
407         }
408     }
409     elsif ($prog eq 'tla' || $prog eq 'baz') {
410         my $archpath=`archpath`;
411         chomp $archpath;
412         my $tagpath=`archpath releases--\Q$tag\E`;
413         chomp $tagpath;
414         my $subcommand;
415         if ($prog eq 'baz') {
416             $subcommand="branch";
417         } else {
418             $subcommand="tag";
419         }
420         
421         if (! action($prog, $subcommand, $archpath, $tagpath)) {
422             die "mdcommit: failed tagging with $tag\n";
423         }
424     }
425     elsif ($prog eq 'bzr') {
426         if (action("$prog tags >/dev/null 2>&1")) {
427             if (! action($prog, "tag", $tag)) {
428                 die "mdcommit: failed tagging with $tag\n";
429             }
430         } else {
431                 die "mdcommit: bazaar or branch version too old to support tags\n";
432         }
433     }
434     elsif ($prog eq 'git') {
435         $tag=~s/^[0-9]+://; # strip epoch
436         if ($tag=~/-/) {
437                 # not a native package, so tag as a debian release
438                 $tag="debian/$tag";
439         }
440
441         if ($signtags) {
442                 if (defined $keyid) {
443                         if (! action($prog, "tag", "-u", $keyid, "-m",
444                                      "tagging version $tag", $tag)) {
445                                 die "mdcommit: failed tagging with $tag\n";
446                         }
447                 }
448                 else {
449                         if (! action($prog, "tag", "-s", "-m",
450                                      "tagging version $tag", $tag)) {
451                                 die "mdcommit: failed tagging with $tag\n";
452                         }
453                 }
454         }
455         elsif (! action($prog, "tag", $tag)) {
456                 die "mdcommit: failed tagging with $tag\n";
457         }
458     }
459     elsif ($prog eq 'hg') {
460             $tag="debian-$tag";
461         if (! action($prog, "tag", "-m", "tagging version $tag", $tag)) {
462                 die "mdcommit: failed tagging with $tag\n";
463         }
464     }
465     else {
466         die "mdcommit: unknown program $prog";
467     }
468 }
469
470 sub getauthor {
471     open CHLOG, '-|', ('bzr', 'diff'), $changelog
472         or die "mdcommit: cannot run bzr: $!\n";
473     foreach (<CHLOG>) {
474         next unless /^\+[A-Z]/;
475         s/^\+//;
476         chomp;
477         s/^.{30}//; # date
478         s/  / /g;
479         if (/^Colin Watson /) {
480             close CHLOG;
481             return;
482         } else {
483             close CHLOG;
484             return $_;
485         }
486     }
487     close CHLOG;
488 }
489
490 sub getmessage {
491     my $ret;
492
493     if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
494         $ret='';
495         my @diffcmd;
496
497         if ($prog eq 'tla' || $prog eq 'baz') {
498             @diffcmd = ($prog, 'file-diff');
499         } elsif ($prog eq 'git') {
500             if ($all) {
501                 @diffcmd = ('git-diff');
502             } else {
503                 @diffcmd = ('git-diff', '--cached');
504             }
505         } else {
506             @diffcmd = ($prog, 'diff');
507         }
508
509         open CHLOG, '-|', @diffcmd, $changelog
510             or die "mdcommit: cannot run $diffcmd[0]: $!\n";
511
512         # TODO should keep intermediate whitespace in message
513         foreach (<CHLOG>) {
514             next unless /^\+\t/;
515             s/^\+\t//;
516             $ret .= $_;
517         }
518         
519         if (! length $ret) {
520             my $info='';
521             if ($prog eq 'git') {
522                 $info = ' (do you mean "mdcommit -a" or did you forget to run "git add"?)';
523             }
524             die "mdcommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n";
525         } else {
526             if ($stripmessage) {
527                 my $count = () = $ret =~ /^\* /mg;
528                 if ($count == 1) {
529                     $ret =~ s/^\* //;
530                 }
531             }
532         }
533     }
534     else {
535         die "mdcommit: unknown program $prog";
536     }
537
538     chomp $ret;
539     return $ret;
540 }
541
542 sub confirm {
543     my $message=shift;
544     print $message, "\n--\n";
545     while(1) {
546         print "OK to commit? [Y/n] ";
547         $_ = <STDIN>;
548         return 0 if /^n/i;
549         return 1 if /^(y|$)/i;
550     }
551 }
552
553 =head1 LICENSE
554
555 This code is copyright by Joey Hess <joeyh@debian.org>, all rights reserved.
556 This program comes with ABSOLUTELY NO WARRANTY.
557 You are free to redistribute this code under the terms of the
558 GNU General Public License, version 2 or later.
559
560 =head1 AUTHOR
561
562 Joey Hess <joeyh@debian.org>
563
564 =head1 SEE ALSO
565
566 L<svnpath(1)>.
567
568 =cut