1#!/usr/bin/perl 2 3=head1 NAME 4 5debcommit - commit changes to a package 6 7=head1 SYNOPSIS 8 9B<debcommit> [I<options>] [B<--all> | I<files to commit>] 10 11=head1 DESCRIPTION 12 13B<debcommit> generates a commit message based on new text in B<debian/changelog>, 14and commits the change to a package's repository. It must be run in a working 15copy for the package. Supported version control systems are: 16B<cvs>, B<git>, B<hg> (mercurial), B<svk>, B<svn> (Subversion), 17B<baz>, B<bzr>, B<tla> (arch), B<darcs>. 18 19=head1 OPTIONS 20 21=over 4 22 23=item B<-c>, B<--changelog> I<path> 24 25Specify an alternate location for the changelog. By default debian/changelog is 26used. 27 28=item B<-r>, B<--release> 29 30Commit a release of the package. The version number is determined from 31debian/changelog, and is used to tag the package in the repository. 32 33Note that svn/svk tagging conventions vary, so debcommit uses 34svnpath(1) to determine where the tag should be placed in the 35repository. 36 37=item B<-R>, B<--release-use-changelog> 38 39When used in conjunction with B<--release>, if there are uncommitted 40changes to the changelog then derive the commit message from those 41changes rather than using the default message. 42 43=item B<-m> I<text>, B<--message> I<text> 44 45Specify a commit message to use. Useful if the program cannot determine 46a commit message on its own based on debian/changelog, or if you want to 47override the default message. 48 49=item B<-n>, B<--noact> 50 51Do not actually do anything, but do print the commands that would be run. 52 53=item B<-d>, B<--diff> 54 55Instead of committing, do print the diff of what would have been committed if 56this option were not given. A typical usage scenario of this option is the 57generation of patches against the current working copy (e.g. when you don't have 58commit access right). 59 60=item B<-C>, B<--confirm> 61 62Display the generated commit message and ask for confirmation before committing 63it. It is also possible to edit the message at this stage; in this case, the 64confirmation prompt will be re-displayed after the editing has been performed. 65 66=item B<-e>, B<--edit> 67 68Edit the generated commit message in your favorite editor before committing 69it. 70 71=item B<-a>, B<--all> 72 73Commit all files. This is the default operation when using a VCS other 74than git. 75 76=item B<-s>, B<--strip-message>, B<--no-strip-message> 77 78If this option is set and the commit message has been derived from the 79changelog, the characters "* " will be stripped from the beginning of 80the message. 81 82This option is set by default and ignored if more than one line of 83the message begins with "[*+-] ". 84 85=item B<--sign-commit>, B<--no-sign-commit> 86 87If this option is set, then the commits that debcommit creates will be 88signed using gnupg. Currently this is only supported by git, hg, and bzr. 89 90=item B<--sign-tags>, B<--no-sign-tags> 91 92If this option is set, then tags that debcommit creates will be signed 93using gnupg. Currently this is only supported by git. 94 95=item B<--changelog-info> 96 97If this option is set, the commit author and date will be determined from 98the Maintainer and Date field of the first paragraph in F<debian/changelog>. 99This is mainly useful when using B<debchange>(1) with the B<--no-mainttrailer> 100option. 101 102=back 103 104=head1 CONFIGURATION VARIABLES 105 106The two configuration files F</etc/devscripts.conf> and 107F<~/.devscripts> are sourced by a shell in that order to set 108configuration variables. Command line options can be used to override 109configuration file settings. Environment variable settings are 110ignored for this purpose. The currently recognised variables are: 111 112=over 4 113 114=item B<DEBCOMMIT_STRIP_MESSAGE> 115 116If this is set to I<no>, then it is the same as the B<--no-strip-message> 117command line parameter being used. The default is I<yes>. 118 119=item B<DEBCOMMIT_SIGN_TAGS> 120 121If this is set to I<yes>, then it is the same as the B<--sign-tags> command 122line parameter being used. The default is I<no>. 123 124=item B<DEBCOMMIT_SIGN_COMMITS> 125 126If this is set to I<yes>, then it is the same as the B<--sign-commit> 127command line parameter being used. The default is I<no>. 128 129=item B<DEBCOMMIT_RELEASE_USE_CHANGELOG> 130 131If this is set to I<yes>, then it is the same as the B<--release-use-changelog> 132command line parameter being used. The default is I<no>. 133 134=item B<DEBSIGN_KEYID> 135 136This is the key id used for signing tags. If not set, a default will be 137chosen by the revision control system. 138 139=back 140 141=head1 VCS SPECIFIC FEATURES 142 143=over 4 144 145=item B<tla> / B<baz> 146 147If the commit message contains more than 72 characters, a summary will 148be created containing as many full words from the message as will fit within 14972 characters, followed by an ellipsis. 150 151=back 152 153Each of the features described below is applicable only if the commit message 154has been automatically determined from the changelog. 155 156=over 4 157 158=item B<git> 159 160If only a single change is detected in the changelog, B<debcommit> will unfold 161it to a single line and behave as if B<--strip-message> was used. 162 163Otherwise, the first change will be unfolded and stripped to form a summary line 164and a commit message formed using the summary line followed by a blank line and 165the changes as extracted from the changelog. B<debcommit> will then spawn an 166editor so that the message may be fine-tuned before committing. 167 168=item B<hg> / B<darcs> 169 170The first change detected in the changelog will be unfolded to form a single line 171summary. If multiple changes were detected then an editor will be spawned to 172allow the message to be fine-tuned. 173 174=item B<bzr> 175 176If the changelog entry used for the commit message closes any bugs then B<--fixes> 177options to "bzr commit" will be generated to associate the revision and the bugs. 178 179=back 180 181=cut 182 183use warnings; 184use strict; 185use Getopt::Long qw(:config bundling permute no_getopt_compat); 186use Cwd; 187use File::Basename; 188use File::HomeDir; 189use File::Temp; 190my $progname = basename($0); 191 192my $modified_conf_msg; 193 194sub usage { 195 print <<"EOT"; 196Usage: $progname [options] [files to commit] 197 $progname --version 198 $progname --help 199 200Generates a commit message based on new text in debian/changelog, 201and commit the change to a package\'s repository. 202 203Options: 204 -c --changelog=path Specify the location of the changelog 205 -r --release Commit a release of the package and create a tag 206 -R --release-use-changelog 207 Take any uncommitted changes in the changelog in 208 to account when determining the commit message 209 for a release 210 -m --message=text Specify a commit message 211 -n --noact Dry run, no actual commits 212 -d --diff Print diff on standard output instead of committing 213 -C --confirm Ask for confirmation of the message before commit 214 -e --edit Edit the message in EDITOR before commit 215 -a --all Commit all files (default except for git) 216 -s --strip-message Strip the leading '* ' from the commit message (default) 217 --no-strip-message Do not strip a leading '* ' 218 --sign-commit Enable signing of the commit (git, hg, and bzr) 219 --no-sign-commit Do not sign the commit (default) 220 --sign-tags Enable signing of tags (git only) 221 --no-sign-tags Do not sign tags (default) 222 --changelog-info Use author and date information from the changelog 223 for the commit (git, hg, and bzr) 224 -h --help This message 225 -v --version Version information 226 227 --no-conf, --noconf 228 Don\'t read devscripts config files; 229 must be the first option given 230 231Default settings modified by devscripts configuration files: 232$modified_conf_msg 233 234EOT 235} 236 237sub version { 238 print <<"EOF"; 239This is $progname, from the Debian devscripts package, version ###VERSION### 240This code is copyright by Joey Hess <joeyh\@debian.org>, all rights reserved. 241This program comes with ABSOLUTELY NO WARRANTY. 242You are free to redistribute this code under the terms of the 243GNU General Public License, version 2 or later. 244EOF 245} 246 247my $release = 0; 248my $message; 249my $release_use_changelog = 0; 250my $noact = 0; 251my $diffmode = 0; 252my $confirm = 0; 253my $edit = 0; 254my $all = 0; 255my $stripmessage = 1; 256my $signcommit = 0; 257my $signtags = 0; 258my $changelog; 259my $changelog_info = 0; 260my $keyid; 261my ($package, $version, $date, $maintainer); 262my $onlydebian = 0; 263 264# Now start by reading configuration files and then command line 265# The next stuff is boilerplate 266 267if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { 268 $modified_conf_msg = " (no configuration files read)"; 269 shift; 270} else { 271 my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); 272 my %config_vars = ( 273 'DEBCOMMIT_STRIP_MESSAGE' => 'yes', 274 'DEBCOMMIT_SIGN_COMMITS' => 'no', 275 'DEBCOMMIT_SIGN_TAGS' => 'no', 276 'DEBCOMMIT_RELEASE_USE_CHANGELOG' => 'no', 277 'DEBSIGN_KEYID' => '', 278 ); 279 my %config_default = %config_vars; 280 281 my $shell_cmd; 282 # Set defaults 283 foreach my $var (keys %config_vars) { 284 $shell_cmd .= qq[$var="$config_vars{$var}";\n]; 285 } 286 $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; 287 $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; 288 # Read back values 289 foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } 290 my $shell_out = `/bin/bash -c '$shell_cmd'`; 291 @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1; 292 293 # Check validity 294 $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} =~ /^(yes|no)$/ 295 or $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} = 'yes'; 296 $config_vars{'DEBCOMMIT_SIGN_COMMITS'} =~ /^(yes|no)$/ 297 or $config_vars{'DEBCOMMIT_SIGN_COMMITS'} = 'no'; 298 $config_vars{'DEBCOMMIT_SIGN_TAGS'} =~ /^(yes|no)$/ 299 or $config_vars{'DEBCOMMIT_SIGN_TAGS'} = 'no'; 300 $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} =~ /^(yes|no)$/ 301 or $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} = 'no'; 302 303 foreach my $var (sort keys %config_vars) { 304 if ($config_vars{$var} ne $config_default{$var}) { 305 $modified_conf_msg .= " $var=$config_vars{$var}\n"; 306 } 307 } 308 $modified_conf_msg ||= " (none)\n"; 309 chomp $modified_conf_msg; 310 311 $stripmessage = $config_vars{'DEBCOMMIT_STRIP_MESSAGE'} eq 'no' ? 0 : 1; 312 $signcommit = $config_vars{'DEBCOMMIT_SIGN_COMMITS'} eq 'no' ? 0 : 1; 313 $signtags = $config_vars{'DEBCOMMIT_SIGN_TAGS'} eq 'no' ? 0 : 1; 314 $release_use_changelog 315 = $config_vars{'DEBCOMMIT_RELEASE_USE_CHANGELOG'} eq 'no' ? 0 : 1; 316 if (exists $config_vars{'DEBSIGN_KEYID'} 317 && length $config_vars{'DEBSIGN_KEYID'}) { 318 $keyid = $config_vars{'DEBSIGN_KEYID'}; 319 } 320} 321 322# Find a good default for the changelog file location 323 324for (qw"debian/changelog changelog") { 325 if (-e $_) { 326 $changelog = $_; 327 last; 328 } 329} 330 331# Now read the command line arguments 332 333if ( 334 !GetOptions( 335 "r|release" => \$release, 336 "m|message=s" => \$message, 337 "n|noact" => \$noact, 338 "d|diff" => \$diffmode, 339 "C|confirm" => \$confirm, 340 "e|edit" => \$edit, 341 "a|all" => \$all, 342 "c|changelog=s" => \$changelog, 343 "s|strip-message!" => \$stripmessage, 344 "sign-commit!" => \$signcommit, 345 "sign-tags!" => \$signtags, 346 "changelog-info!" => \$changelog_info, 347 "R|release-use-changelog!" => \$release_use_changelog, 348 "h|help" => sub { usage(); exit 0; }, 349 "v|version" => sub { version(); exit 0; }, 350 'noconf|no-conf' => sub { die '--noconf must be first option'; }, 351 ) 352) { 353 die "Usage: $progname [options] [--all | files to commit]\n"; 354} 355 356if ($diffmode) { 357 $confirm = 0; 358 $edit = 0; 359} 360 361my @files_to_commit = @ARGV; 362if (@files_to_commit && !grep(/$changelog/, @files_to_commit)) { 363 push @files_to_commit, $changelog; 364} 365 366# Main program 367 368my $prog = getprog(); 369if (!defined $changelog) { 370 die "debcommit: Could not find a Debian changelog\n"; 371} 372if (!-e $changelog) { 373 die "debcommit: cannot find $changelog\n"; 374} 375 376$message = getmessage() 377 if !defined $message and (not $release or $release_use_changelog); 378 379if ($release || $changelog_info) { 380 require Dpkg::Changelog::Parse; 381 my $log = Dpkg::Changelog::Parse::changelog_parse(file => $changelog); 382 if ($release) { 383 if ($log->{Distribution} =~ /UNRELEASED/) { 384 die 385"debcommit: $changelog says it's UNRELEASED\nTry running dch --release first\n"; 386 } 387 $package = $log->{Source}; 388 $version = $log->{Version}; 389 390 $message = "releasing package $package version $version" 391 if !defined $message; 392 } 393 if ($changelog_info) { 394 $maintainer = $log->{Maintainer}; 395 $date = $log->{Date}; 396 } 397} 398 399if ($edit) { 400 my $modified = 0; 401 ($message, $modified) = edit($message); 402 die "$progname: Commit message not modified / saved; aborting\n" 403 unless $modified; 404} 405 406if (not $confirm or confirm($message)) { 407 commit($message); 408 tag($package, $version) if $release; 409} 410 411# End of code, only subs below 412 413sub getprog { 414 if (-d "debian") { 415 if (-d "debian/.svn") { 416 # SVN has .svn even in subdirs... 417 if (!-d ".svn") { 418 $onlydebian = 1; 419 } 420 return "svn"; 421 } elsif (-d "debian/CVS") { 422 # CVS has CVS even in subdirs... 423 if (!-d "CVS") { 424 $onlydebian = 1; 425 } 426 return "cvs"; 427 } elsif (-d "debian/{arch}") { 428 # I don't think we can tell just from the working copy 429 # whether to use tla or baz, so try baz if it's available, 430 # otherwise fall back to tla. 431 if (system("baz --version >/dev/null 2>&1") == 0) { 432 return "baz"; 433 } else { 434 return "tla"; 435 } 436 } elsif (-d "debian/_darcs") { 437 $onlydebian = 1; 438 return "darcs"; 439 } 440 } 441 if (-d ".svn") { 442 return "svn"; 443 } 444 if (-d "CVS") { 445 return "cvs"; 446 } 447 if (-d "{arch}") { 448 # I don't think we can tell just from the working copy 449 # whether to use tla or baz, so try baz if it's available, 450 # otherwise fall back to tla. 451 if (system("baz --version >/dev/null 2>&1") == 0) { 452 return "baz"; 453 } else { 454 return "tla"; 455 } 456 } 457 if (-d ".bzr") { 458 return "bzr"; 459 } 460 if (-e ".git") { 461# With certain forms of git checkouts, .git can be a file instead of a directory 462 return "git"; 463 } 464 if (-d ".hg") { 465 return "hg"; 466 } 467 if (-d "_darcs") { 468 return "darcs"; 469 } 470 471 # Test for this file to avoid interactive prompting from svk. 472 if (-d File::HomeDir->my_home . "/.svk/local") { 473 # svk has no useful directories so try to run it. 474 my $svkpath 475 = `svk info . 2>/dev/null| grep -i '^Depot Path:' | cut -d ' ' -f 3`; 476 if (length $svkpath) { 477 return "svk"; 478 } 479 } 480 481 # .bzr, .git, .hg, or .svn may be in a parent directory, rather than the 482 # current directory, if multiple packages are kept in one repository. 483 my $dir = getcwd(); 484 while ($dir =~ s/[^\/]*\/?$// && length $dir) { 485 if (-d "$dir/.bzr") { 486 return "bzr"; 487 } 488 if (-e "$dir/.git") { 489 return "git"; 490 } 491 if (-d "$dir/.hg") { 492 return "hg"; 493 } 494 if (-d "$dir/.svn") { 495 return "svn"; 496 } 497 } 498 499 die 500"debcommit: not in a cvs, Subversion, baz, bzr, git, hg, svk or darcs working copy\n"; 501} 502 503sub action { 504 my $prog = shift; 505 if ($prog eq "darcs" && $onlydebian) { 506 splice(@_, 1, 0, "--repodir=debian"); 507 } 508 print $prog, " ", join( 509 " ", 510 map { 511 if (/[^-A-Za-z0-9]/) { "'$_'" } 512 else { $_ } 513 } @_ 514 ), 515 "\n"; 516 return 1 if $noact; 517 return (system($prog, @_) != 0) ? 0 : 1; 518} 519 520sub bzr_find_fixes { 521 my $message = shift; 522 523 require Dpkg::Changelog::Entry::Debian; 524 require Dpkg::Vendor::Ubuntu; 525 526 my @debian_closes = Dpkg::Changelog::Entry::Debian::find_closes($message); 527 my $launchpad_closes 528 = Dpkg::Vendor::Ubuntu::find_launchpad_closes($message); 529 530 my @fixes_arg = (); 531 map { push(@fixes_arg, ("--fixes", "deb:" . $_)) } @debian_closes; 532 map { push(@fixes_arg, ("--fixes", "lp:" . $_)) } @$launchpad_closes; 533 return @fixes_arg; 534} 535 536sub commit { 537 my $message = shift; 538 539 die "debcommit: can't specify a list of files to commit when using --all\n" 540 if (@files_to_commit and $all); 541 542 my $action_rc; # return code of external command 543 if ($prog =~ /^(cvs|svn|svk|hg)$/) { 544 if (!@files_to_commit && $onlydebian) { 545 @files_to_commit = ("debian"); 546 } 547 my @extra_args; 548 if ($changelog_info && $prog eq 'hg') { 549 push(@extra_args, '-u', $maintainer, '-d', $date); 550 } 551 $action_rc 552 = $diffmode 553 ? action($prog, "diff", @files_to_commit) 554 : action($prog, "commit", "-m", $message, @extra_args, 555 @files_to_commit); 556 if ($prog eq 'hg' && $action_rc && $signcommit) { 557 my @sign_args; 558 push(@sign_args, '-k', $keyid) if $keyid; 559 push(@sign_args, '-u', $maintainer, '-d', $date) 560 if $changelog_info; 561 if (!action($prog, 'sign', @sign_args)) { 562 die "$progname: failed to sign commit\n"; 563 } 564 } 565 } elsif ($prog eq 'git') { 566 if (!@files_to_commit && ($all || $release)) { 567 # check to see if the WC is clean. git-commit would exit 568 # nonzero, so don't run it in --all or --release mode. 569 my $status = `git status --porcelain`; 570 if (!$status) { 571 print $status; 572 return; 573 } 574 } 575 if ($diffmode) { 576 $action_rc = action($prog, "diff", @files_to_commit); 577 } else { 578 if ($all) { 579 @files_to_commit = ("-a"); 580 } 581 my @extra_args = (); 582 if ($changelog_info) { 583 @extra_args = ("--author=$maintainer", "--date=$date"); 584 } 585 if ($signcommit) { 586 my $sign = '--gpg-sign'; 587 $sign .= "=$keyid" if $keyid; 588 push(@extra_args, $sign); 589 } 590 $action_rc = action($prog, "commit", "-m", $message, @extra_args, 591 @files_to_commit); 592 } 593 } elsif ($prog eq 'tla' || $prog eq 'baz') { 594 my $summary = $message; 595 $summary =~ s/^((?:\* )?[^\n]{1,72})(?:(?:\s|\n).*|$)/$1/ms; 596 my @args; 597 if (!$diffmode) { 598 if ($summary eq $message) { 599 $summary =~ s/^\* //s; 600 @args = ("-s", $summary); 601 } else { 602 $summary =~ s/^\* //s; 603 @args = ("-s", "$summary ...", "-L", $message); 604 } 605 } 606 push(@args, (($prog eq 'tla') ? '--' : ()), @files_to_commit,) 607 if @files_to_commit; 608 $action_rc = action($prog, $diffmode ? "diff" : "commit", @args); 609 } elsif ($prog eq 'bzr') { 610 if ($diffmode) { 611 $action_rc = action($prog, "diff", @files_to_commit); 612 } else { 613 my @extra_args = bzr_find_fixes($message); 614 if ($changelog_info) { 615 eval { 616 require Date::Format; 617 require Date::Parse; 618 }; 619 if ($@) { 620 my $error 621 = "$progname: Couldn't format the changelog date: "; 622 if ($@ =~ m%^Can\'t locate Date%) { 623 $error 624 .= "the libtimedate-perl package is not installed"; 625 } else { 626 $error .= "couldn't load Date::Format/Date::Parse: $@"; 627 } 628 die "$error\n"; 629 } 630 my @time = Date::Parse::strptime($date); 631 my $time 632 = Date::Format::strftime('%Y-%m-%d %H:%M:%S %z', \@time); 633 push(@extra_args, 634 "--author=$maintainer", "--commit-time=$time"); 635 } 636 my @sign_args; 637 if ($signcommit) { 638 push(@sign_args, "-Ocreate_signatures=always"); 639 if ($keyid) { 640 push(@sign_args, "-Ogpg_signing_key=$keyid"); 641 } 642 } 643 $action_rc = action($prog, @sign_args, "commit", "-m", $message, 644 @extra_args, @files_to_commit); 645 } 646 } elsif ($prog eq 'darcs') { 647 if (!@files_to_commit && ($all || $release)) { 648 # check to see if the WC is clean. darcs record would exit 649 # nonzero, so don't run it in --all or --release mode. 650 $action_rc = action($prog, "status"); 651 if (!$action_rc) { 652 return; 653 } 654 } 655 if ($diffmode) { 656 $action_rc = action($prog, "diff", @files_to_commit); 657 } else { 658 my $fh = File::Temp->new(TEMPLATE => '.commit-tmp.XXXXXX'); 659 $fh->print("$message\n"); 660 $fh->close(); 661 $action_rc = action($prog, "record", "--logfile", "$fh", "-a", 662 @files_to_commit); 663 } 664 } else { 665 die "debcommit: unknown program $prog"; 666 } 667 die "debcommit: commit failed\n" if (!$action_rc); 668} 669 670sub tag { 671 my ($package, $tag, $tag_msg) = @_; 672 673 # Make the message here so we can mangle $tag later, if needed 674 $tag_msg 675 = !defined $message 676 ? "tagging package $package version $tag" 677 : "$message"; 678 679 if ($prog eq 'svn' || $prog eq 'svk') { 680 my $svnpath = `svnpath`; 681 chomp $svnpath; 682 my $tagpath = `svnpath tags`; 683 chomp $tagpath; 684 685 if (!action($prog, "copy", $svnpath, "$tagpath/$tag", "-m", $tag_msg)) 686 { 687 if ( 688 !action( 689 $prog, "mkdir", $tagpath, "-m", "create tag directory" 690 ) 691 || !action( 692 $prog, "copy", $svnpath, "$tagpath/$tag", 693 "-m", $tag_msg 694 ) 695 ) { 696 die "debcommit: failed tagging with $tag\n"; 697 } 698 } 699 } elsif ($prog eq 'cvs') { 700 $tag =~ s/^[0-9]+://; # strip epoch 701 $tag =~ tr/./_/; # mangle for cvs 702 $tag = "debian_version_$tag"; 703 if (!action("cvs", "tag", "-f", $tag)) { 704 die "debcommit: failed tagging with $tag\n"; 705 } 706 } elsif ($prog eq 'tla' || $prog eq 'baz') { 707 my $archpath = `archpath`; 708 chomp $archpath; 709 my $tagpath = `archpath releases--\Q$tag\E`; 710 chomp $tagpath; 711 my $subcommand; 712 if ($prog eq 'baz') { 713 $subcommand = "branch"; 714 } else { 715 $subcommand = "tag"; 716 } 717 718 if (!action($prog, $subcommand, $archpath, $tagpath)) { 719 die "debcommit: failed tagging with $tag\n"; 720 } 721 } elsif ($prog eq 'bzr') { 722 if (action("$prog tags >/dev/null 2>&1")) { 723 if (!action($prog, "tag", $tag)) { 724 die "debcommit: failed tagging with $tag\n"; 725 } 726 } else { 727 die 728 "debcommit: bazaar or branch version too old to support tags\n"; 729 } 730 } elsif ($prog eq 'git') { 731 $tag =~ tr/~/_/; # mangle for git 732 $tag =~ tr/:/%/; 733 if ($tag =~ /-/) { 734 # not a native package, so tag as a debian release 735 $tag = "debian/$tag"; 736 } 737 738 if ($signtags) { 739 my $tag_msg = "tagging package $package version $tag"; 740 if (defined $keyid) { 741 if ( 742 !action( 743 $prog, "tag", "-a", "-u", 744 $keyid, "-m", $tag_msg, $tag 745 ) 746 ) { 747 die "debcommit: failed tagging with $tag\n"; 748 } 749 } else { 750 if (!action($prog, "tag", "-a", "-s", "-m", $tag_msg, $tag)) { 751 die "debcommit: failed tagging with $tag\n"; 752 } 753 } 754 } elsif (!action($prog, "tag", "-a", "-m", $tag_msg, $tag)) { 755 die "debcommit: failed tagging with $tag\n"; 756 } 757 } elsif ($prog eq 'hg') { 758 $tag =~ s/^[0-9]+://; # strip epoch 759 $tag = "debian-$tag"; 760 if (!action($prog, "tag", "-m", $tag_msg, $tag)) { 761 die "debcommit: failed tagging with $tag\n"; 762 } 763 } elsif ($prog eq 'darcs') { 764 if (!action($prog, "tag", $tag)) { 765 die "debcommit: failed tagging with $tag\n"; 766 } 767 } else { 768 die "debcommit: unknown program $prog"; 769 } 770} 771 772sub getmessage { 773 my $ret; 774 775 if ($prog =~ /^(cvs|svn|svk|tla|baz|bzr|git|hg|darcs)$/) { 776 $ret = ''; 777 my @diffcmd; 778 779 if ($prog eq 'tla') { 780 @diffcmd = ($prog, 'diff', '-D', '-w', '--'); 781 } elsif ($prog eq 'baz') { 782 @diffcmd = ($prog, 'file-diff'); 783 } elsif ($prog eq 'bzr') { 784 @diffcmd = ($prog, 'diff', '--diff-options', '-wu'); 785 } elsif ($prog eq 'git') { 786 if (git_repo_has_commits()) { 787 if ($all) { 788 @diffcmd = ('git', 'diff', '-w', '--no-color'); 789 } else { 790 @diffcmd = ('git', 'diff', '-w', '--cached', '--no-color'); 791 } 792 } else { 793 # No valid head! Rather than fail, cheat and use 'diff' 794 @diffcmd = ('diff', '-u', '/dev/null'); 795 } 796 } elsif ($prog eq 'svn') { 797 @diffcmd = ( 798 $prog, 'diff', '--diff-cmd', '/usr/bin/diff', '--extensions', 799 '-wu' 800 ); 801 } elsif ($prog eq 'svk') { 802 $ENV{'SVKDIFF'} = '/usr/bin/diff -w -u'; 803 @diffcmd = ($prog, 'diff'); 804 } elsif ($prog eq 'darcs') { 805 @diffcmd = ($prog, 'diff', '--diff-opts=-wu'); 806 if ($onlydebian) { 807 push(@diffcmd, '--repodir=debian'); 808 } 809 } else { 810 @diffcmd = ($prog, 'diff', '-w'); 811 } 812 813 open CHLOG, '-|', @diffcmd, $changelog 814 or die "debcommit: cannot run $diffcmd[0]: $!\n"; 815 816 foreach (<CHLOG>) { 817 next unless s/^\+( |\t)//; 818 next if /^\s*\[.*\]\s*$/; # maintainer name 819 $ret .= $_; 820 } 821 822 if (!length $ret) { 823 if ($release) { 824 return; 825 } else { 826 my $info = ''; 827 if ($prog eq 'git') { 828 $info 829 = ' (do you mean "debcommit -a" or did you forget to run "git add"?)'; 830 } 831 die 832"debcommit: unable to determine commit message using $prog$info\nTry using the -m flag.\n"; 833 } 834 } else { 835 if ($prog =~ /^(git|hg|darcs)$/ and not $diffmode) { 836 my $count = () = $ret =~ /^\s*[\*\+-] /mg; 837 838 if ($count == 1) { 839 # Unfold 840 $ret =~ s/\n\s+/ /mg; 841 } else { 842 my $summary = ''; 843 844 # We're constructing a message that can be used as a 845 # good starting point, the user will need to fine-tune it 846 $edit = 1; 847 848 $summary = $ret; 849 # Strip off the second and subsequent changes 850 $summary =~ s/(^\* .*?)^\s*[\*\+-] .*/$1/ms; 851 # Unfold 852 $summary =~ s/\n\s+/ /mg; 853 854 if ($prog eq 'git') { 855 $summary =~ s/^\* //; 856 $ret = $summary . "\n" . $ret; 857 } else { 858 # Strip off the first change so that we can prepend 859 # the unfolded version 860 $ret =~ s/^\* .*?(^\s*[\*\+-] .*)/$1\n/msg; 861 $ret = $summary . $ret; 862 } 863 } 864 } 865 866 if ($stripmessage or $prog eq 'git') { 867 my $count = () = $ret =~ /^[ \t]*[\*\+-] /mg; 868 if ($count == 1) { 869 $ret =~ s/^[ \t]*[\*\+-] //; 870 $ret =~ s/^[ \t]*//mg; 871 } 872 } 873 } 874 } else { 875 die "debcommit: unknown program $prog"; 876 } 877 878 chomp $ret; 879 return $ret; 880} 881 882sub confirm { 883 my $confirmmessage = shift; 884 print $confirmmessage, "\n--\n"; 885 while (1) { 886 print "OK to commit? [Y/n/e] "; 887 $_ = <STDIN>; 888 return 0 if /^n/i; 889 if (/^(y|$)/i) { 890 $message = $confirmmessage; 891 return 1; 892 } elsif (/^e/i) { 893 ($confirmmessage) = edit($confirmmessage); 894 print "\n", $confirmmessage, "\n--\n"; 895 } 896 } 897} 898 899# The string returned by edit is chomp()ed, so anywhere we present that string 900# to the user again needs to have a \n tacked on to the end. 901sub edit { 902 my $message = shift; 903 my $fh = File::Temp->new(TEMPLATE => '.commit-tmp.XXXXXX') 904 || die "$progname: unable to create a temporary file.\n"; 905 # Ensure the message we present to the user has an EOL on the last line. 906 chomp($message); 907 $fh->print("$message\n"); 908 $fh->close(); 909 my $mtime = (stat("$fh"))[9]; 910 defined $mtime 911 || die 912"$progname: unable to retrieve modification time for temporary file: $!\n"; 913 $mtime--; 914 utime $mtime, $mtime, $fh->filename; 915 system("sensible-editor $fh"); 916 open(FH, '<', "$fh") 917 || die "$progname: unable to open temporary file for reading\n"; 918 $message = ""; 919 920 while (<FH>) { 921 $message .= $_; 922 } 923 close(FH); 924 my $newmtime = (stat("$fh"))[9]; 925 defined $newmtime 926 || die 927"$progname: unable to retrieve modification time for updated temporary file: $!\n"; 928 chomp $message; 929 return ($message, $mtime != $newmtime); 930} 931 932sub git_repo_has_commits { 933 my $command = "git rev-parse --verify --quiet HEAD >/dev/null"; 934 system $command; 935 return ($? >> 8 == 0) ? 1 : 0; 936} 937 938=head1 LICENSE 939 940This code is copyright by Joey Hess <joeyh@debian.org>, all rights reserved. 941This program comes with ABSOLUTELY NO WARRANTY. 942You are free to redistribute this code under the terms of the 943GNU General Public License, version 2 or later. 944 945=head1 AUTHOR 946 947Joey Hess <joeyh@debian.org> 948 949=head1 SEE ALSO 950 951B<debchange>(1), B<svnpath>(1) 952 953=cut 954