chiark / gitweb /
ubuntu-daily: flip -a semantics to mean --authenticated, not --anonymous
[bin.git] / gnucommit
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 gnucommit - commit changes to packages with GNU-format ChangeLog files
6
7 =head1 SYNOPSIS
8
9 B<gnucommit> [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<gnucommit> generates a commit message based on new text in B<ChangeLog>,
14 and commits the change to the repository. It must be run in a working
15 copy for the package. Supported version control systems are:
16 B<svn> (subversion), 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 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 ChangeLog, and is used to tag the package in the repository.
31
32 Note that svn/svk tagging conventions vary, so gnucommit 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 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 (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 gnucommit 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 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="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: gnucommit [--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 "gnucommit: cannot find $changelog\n";
243 }
244
245 if ($release) {
246     open (C, "<$changelog" ) || die "gnucommit: cannot read $changelog: $!";
247     <C>; <C>;
248     my $firstline=<C>;
249     if ($firstline!~/Version: ([0-9][a-z0-9.-]*)/) {
250         die "gnucommit: 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 "gnucommit: 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 "gnucommit: 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 ($prog eq 'bzr' and defined $author) {
333             @author = ('--author', $author);
334         }
335         if (! action($prog, "commit", @author, "-m", $message, @files_to_commit)) {
336             die "gnucommit: 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 "gnucommit: 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 "gnucommit: commit failed\n";
375         }
376     }
377     else {
378         die "gnucommit: 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 "gnucommit: 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 "gnucommit: 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 "gnucommit: 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 "gnucommit: failed tagging with $tag\n";
429             }
430         } else {
431                 die "gnucommit: 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 "gnucommit: failed tagging with $tag\n";
446                         }
447                 }
448                 else {
449                         if (! action($prog, "tag", "-s", "-m",
450                                      "tagging version $tag", $tag)) {
451                                 die "gnucommit: failed tagging with $tag\n";
452                         }
453                 }
454         }
455         elsif (! action($prog, "tag", $tag)) {
456                 die "gnucommit: 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 "gnucommit: failed tagging with $tag\n";
463         }
464     }
465     else {
466         die "gnucommit: unknown program $prog";
467     }
468 }
469
470 sub getauthor {
471     my $ret;
472
473     if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
474         $ret='';
475         my @diffcmd;
476
477         if ($prog eq 'tla' || $prog eq 'baz') {
478             @diffcmd = ($prog, 'file-diff');
479         } elsif ($prog eq 'git') {
480             if ($all) {
481                 @diffcmd = ('git-diff');
482             } else {
483                 @diffcmd = ('git-diff', '--cached');
484             }
485         } else {
486             @diffcmd = ($prog, 'diff');
487         }
488
489         open CHLOG, '-|', @diffcmd, $changelog
490             or die "gnucommit: cannot run $diffcmd[0]: $!\n";
491
492         foreach (<CHLOG>) {
493             next unless /^\+[0-9]/;
494             s/^\+//;
495             chomp;
496             s/^.*  //; # date
497             s/  / /g;
498             if (/^Colin Watson /) {
499                 last;
500             } else {
501                 $ret = $_;
502                 last;
503             }
504         }
505
506         close CHLOG;
507     }
508     else {
509         die "gnucommit: unknown program $prog";
510     }
511
512     return $ret;
513 }
514
515 sub getmessage {
516     my $ret;
517
518     if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg)$/) {
519         $ret='';
520         my @diffcmd;
521
522         if ($prog eq 'tla' || $prog eq 'baz') {
523             @diffcmd = ($prog, 'file-diff');
524         } elsif ($prog eq 'git') {
525             if ($all) {
526                 @diffcmd = ('git-diff');
527             } else {
528                 @diffcmd = ('git-diff', '--cached');
529             }
530         } else {
531             @diffcmd = ($prog, 'diff');
532         }
533
534         open CHLOG, '-|', @diffcmd, $changelog
535             or die "gnucommit: cannot run $diffcmd[0]: $!\n";
536
537         # TODO should keep intermediate whitespace in message
538         foreach (<CHLOG>) {
539             next unless /^\+\t/;
540             s/^\+\t//;
541             $ret .= $_;
542         }
543         
544         if (! length $ret) {
545             my $info='';
546             if ($prog eq 'git') {
547                 $info = ' (do you mean "gnucommit -a" or did you forget to run "git add"?)';
548             }
549             die "gnucommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n";
550         } else {
551             if ($stripmessage) {
552                 my $count = () = $ret =~ /^\* /mg;
553                 if ($count == 1) {
554                     $ret =~ s/^\* //;
555                 }
556             }
557         }
558     }
559     else {
560         die "gnucommit: unknown program $prog";
561     }
562
563     chomp $ret;
564     return $ret;
565 }
566
567 sub confirm {
568     my $message=shift;
569     print $message, "\n--\n";
570     while(1) {
571         print "OK to commit? [Y/n] ";
572         $_ = <STDIN>;
573         return 0 if /^n/i;
574         return 1 if /^(y|$)/i;
575     }
576 }
577
578 =head1 LICENSE
579
580 This code is copyright by Joey Hess <joeyh@debian.org>, all rights reserved.
581 This program comes with ABSOLUTELY NO WARRANTY.
582 You are free to redistribute this code under the terms of the
583 GNU General Public License, version 2 or later.
584
585 =head1 AUTHOR
586
587 Joey Hess <joeyh@debian.org>
588
589 =head1 SEE ALSO
590
591 L<svnpath(1)>.
592
593 =cut