Porting/git-deltatool

   1 #!/usr/bin/perl
   2 #
   3 # This is a rough draft of a tool to aid in generating a perldelta file
   4 # from a series of git commits.
   5
   6 use 5.010;
   7 use strict;
   8 use warnings;
   9 package Git::DeltaTool;
  10
  11 use Class::Struct;
  12 use File::Basename;
  13 use File::Temp;
  14 use Getopt::Long;
  15 use Git::Wrapper;
  16 use Term::ReadKey;
  17 use Term::ANSIColor;
  18 use Pod::Usage;
  19
  20 BEGIN { struct( git => '$', last_tag => '$', opt => '%', original_stdout => '$' ) }
  21
  22 __PACKAGE__->run;
  23
  24 #--------------------------------------------------------------------------#
  25 # main program
  26 #--------------------------------------------------------------------------#
  27
  28 sub run {
  29   my $class = shift;
  30
  31   my %opt = (
  32     mode => 'assign',
  33   );
  34
  35   GetOptions( \%opt,
  36     # inputs
  37     'mode|m:s', # 'assign', 'review', 'render', 'update'
  38     'type|t:s', # select by status
  39     'status|s:s', # status to set for 'update'
  40     'since:s', # origin commit
  41     'help|h',  # help
  42   );
  43
  44   pod2usage() if $opt{help};
  45
  46   my $git = Git::Wrapper->new(".");
  47   my $git_id = $opt{since};
  48   if ( defined $git_id ) {
  49     die "Invalid git identifier '$git_id'\n"
  50       unless eval { $git->show($git_id); 1 };
  51   } else {
  52     ($git_id) = $git->describe;
  53     $git_id =~ s/-.*$//;
  54   }
  55   my $gdt = $class->new( git => $git, last_tag => $git_id, opt => \%opt );
  56
  57   if ( $opt{mode} eq 'assign' ) {
  58     $opt{type} //= 'new';
  59     $gdt->assign;
  60   }
  61   elsif ( $opt{mode} eq 'review' ) {
  62     $opt{type} //= 'pending';
  63     $gdt->review;
  64   }
  65   elsif ( $opt{mode} eq 'render' ) {
  66     $opt{type} //= 'pending';
  67     $gdt->render;
  68   }
  69   elsif ( $opt{mode} eq 'summary' ) {
  70     $opt{type} //= 'pending';
  71     $gdt->summary;
  72   }
  73   elsif ( $opt{mode} eq 'update' ) {
  74     die "Explicit --type argument required for update mode\n"
  75       unless defined $opt{type};
  76     die "Explicit --status argument required for update mode\n"
  77       unless defined $opt{status};
  78     $gdt->update;
  79   }
  80   else {
  81     die "Unrecognized mode '$opt{mode}'\n";
  82   }
  83   exit 0;
  84 }
  85
  86 #--------------------------------------------------------------------------#
  87 # program modes (and iterator)
  88 #--------------------------------------------------------------------------#
  89
  90 sub assign {
  91   my ($self) = @_;
  92   my @choices = ( $self->section_choices, $self->action_choices );
  93   $self->_iterate_commits(
  94     sub {
  95       my $log = shift;
  96       say "";
  97       say "-" x 75;
  98       $self->show_header($log);
  99       $self->show_body($log, 1);
 100       say "-" x 75;
 101       return $self->dispatch( $self->prompt( @choices ), $log);
 102     }
 103   );
 104   return;
 105 }
 106
 107 sub review {
 108   my ($self) = @_;
 109   my @choices = ( $self->review_choices, $self->action_choices );
 110   $self->_iterate_commits(
 111     sub {
 112       my $log = shift;
 113       say "";
 114       say "-" x 75;
 115       $self->show_header($log);
 116       $self->show_notes($log, 1);
 117       say "-" x 75;
 118       return $self->dispatch( $self->prompt( @choices ), $log);
 119     }
 120   );
 121   return;
 122 }
 123
 124 sub render {
 125   my ($self) = @_;
 126   my %sections;
 127   $self->_iterate_commits(
 128     sub {
 129       my $log = shift;
 130       my $section = $self->note_section($log) or return;
 131       push @{ $sections{$section} }, $self->note_delta($log);
 132       return 1;
 133     }
 134   );
 135   my @order = $self->section_order;
 136   my %known = map { $_ => 1 } @order;
 137   my @rest = grep { ! $known{$_} } keys %sections;
 138   for my $s ( @order, @rest ) {
 139     next unless ref $sections{$s};
 140     say "-"x75;
 141     say uc($s) . "\n";
 142     say join ( "\n", @{ $sections{$s} }, "" );
 143   }
 144   return;
 145 }
 146
 147 sub summary {
 148   my ($self) = @_;
 149   $self->_iterate_commits(
 150     sub {
 151       my $log = shift;
 152       $self->show_header($log);
 153       return 1;
 154     }
 155   );
 156   return;
 157 }
 158
 159 sub update {
 160   my ($self) = @_;
 161
 162   my $status = $self->opt('status')
 163     or die "The 'status' option must be supplied for update mode\n";
 164
 165   $self->_iterate_commits(
 166     sub {
 167       my $log = shift;
 168       my $note = $log->notes;
 169       $note =~ s{^(perldelta.*\[)\w+(\].*)}{$1$status$2}ms;
 170       $self->add_note( $log->id, $note );
 171       return 1;
 172     }
 173   );
 174   return;
 175 }
 176
 177 sub _iterate_commits {
 178   my ($self, $fcn) = @_;
 179   my $type = $self->opt('type');
 180   say STDERR "Scanning for $type commits since " . $self->last_tag . "...";
 181   for my $log ( $self->find_commits($type) ) {
 182     redo unless $fcn->($log);
 183   }
 184   return 1;
 185 }
 186
 187 #--------------------------------------------------------------------------#
 188 # methods
 189 #--------------------------------------------------------------------------#
 190
 191 sub add_note {
 192   my ($self, $id, $note) = @_;
 193   my @lines = split "\n", _strip_comments($note);
 194   pop @lines while @lines && $lines[-1] =~ m{^\s*$};
 195   my $tempfh = File::Temp->new;
 196   if (@lines) {
 197     $tempfh->printflush( join( "\n", @lines), "\n" );
 198     $self->git->notes('edit', '-F', "$tempfh", $id);
 199   }
 200   else {
 201     $tempfh->printflush( "\n" );
 202     # git notes won't take an empty file as input
 203     system("git notes edit -F $tempfh $id");
 204   }
 205
 206   return;
 207 }
 208
 209 sub dispatch {
 210   my ($self, $choice, $log) = @_;
 211   return unless $choice;
 212   my $method = "do_$choice->{handler}";
 213   return 1 unless $self->can($method); # missing methods "succeed"
 214   return $self->$method($choice, $log);
 215 }
 216
 217 sub edit_text {
 218   my ($self, $text, $args) = @_;
 219   $args //= {};
 220   my $tempfh = File::Temp->new;
 221   $tempfh->printflush( $text );
 222   if ( my @editor = split /\s+/, ($ENV{VISUAL} || $ENV{EDITOR}) ) {
 223     push @editor, "-f" if $editor[0] =~ /^gvim/;
 224     system(@editor, "$tempfh");
 225   }
 226   else {
 227     warn("No VISUAL or EDITOR defined");
 228   }
 229   $tempfh->seek(0,0);
 230   return do { local $/; <$tempfh> };
 231 }
 232
 233 sub find_commits {
 234   my ($self, $type) = @_;
 235   $type //= 'new';
 236   my @commits = $self->git->log($self->last_tag . "..HEAD");
 237   $_ = Git::Wrapper::XLog->from_log($_) for @commits;
 238   my @list;
 239   if ( $type eq 'new' ) {
 240     @list = grep { ! $_->notes } @commits;
 241   }
 242   else {
 243     @list = grep { $self->note_status( $_ ) eq $type } @commits;
 244   }
 245   return @list;
 246 }
 247
 248 sub get_diff {
 249   my ($self, $log) = @_;
 250   my @diff = $self->git->show({ stat => 1, p => 1 }, $log->id);
 251   return join("\n", @diff);
 252 }
 253
 254 sub note_delta {
 255   my ($self, $log) = @_;
 256   my @delta = split "\n", ($log->notes || '');
 257   return '' unless @delta;
 258   splice @delta, 0, 2;
 259   return join( "\n", @delta, "" );
 260 }
 261
 262 sub note_section {
 263   my ($self, $log) = @_;
 264   my $note = $log->notes or return '';
 265   my ($section) = $note =~ m{^perldelta:\s*([^\[]*)\s+}ms;
 266   return $section || '';
 267 }
 268
 269 sub note_status {
 270   my ($self, $log) = @_;
 271   my $note = $log->notes or return '';
 272   my ($status) = $note =~ m{^perldelta:\s*[^\[]*\[(\w+)\]}ms;
 273   return $status || '';
 274 }
 275
 276 sub note_template {
 277   my ($self, $log, $text) = @_;
 278   my $diff = _prepend_comment( $self->get_diff($log) );
 279   return << "HERE";
 280 # Edit commit note below. Do not change the first line. Comments are stripped
 281 $text
 282
 283 $diff
 284 HERE
 285 }
 286
 287 sub prompt {
 288   my ($self, @choices) = @_;
 289   my ($valid, @menu, %keymap) = '';
 290   for my $c ( map { @$_ } @choices ) {
 291     my ($item) = grep { /\(/ } split q{ }, $c->{name};
 292     my ($button) = $item =~ m{\((.)\)};
 293     die "No key shortcut found for '$item'" unless $button;
 294     die "Duplicate key shortcut found for '$item'" if $keymap{lc $button};
 295     push @menu, $item;
 296     $valid .= lc $button;
 297     $keymap{lc $button} = $c;
 298   }
 299   my $keypress = $self->prompt_key( $self->wrap_list(@menu), $valid );
 300   return $keymap{lc $keypress};
 301 }
 302
 303 sub prompt_key {
 304   my ($self, $prompt, $valid_keys) = @_;
 305   my $key;
 306   KEY: {
 307     say $prompt;
 308     ReadMode 3;
 309     $key = lc ReadKey(0);
 310     ReadMode 0;
 311     if ( $key !~ qr/\A[$valid_keys]\z/i ) {
 312       say "";
 313       redo KEY;
 314     }
 315   }
 316   return $key;
 317 }
 318
 319 sub show_body {
 320   my ($self, $log, $lf) = @_;
 321   return unless my $body = $log->body;
 322   say $lf ? "\n$body" : $body;
 323   return;
 324 }
 325
 326 sub show_header {
 327   my ($self, $log) = @_;
 328   my $header = $log->short_id;
 329   $header .= " " . $log->subject if length $log->subject;
 330   say colored( $header, "yellow");
 331   return;
 332 }
 333
 334 sub show_notes {
 335   my ($self, $log, $lf) = @_;
 336   return unless my $notes = $log->notes;
 337   say $lf ? "\n$notes" : $notes;
 338   return;
 339 }
 340
 341 sub wrap_list {
 342   my ($self, @list) = @_;
 343   my $line = shift @list;
 344   my @wrap;
 345   for my $item ( @list ) {
 346     if ( length( $line . $item ) > 70 ) {
 347       push @wrap, $line;
 348       $line = $item ne $list[-1] ? $item : "or $item";
 349     }
 350     else {
 351       $line .= $item ne $list[-1] ? ", $item" : " or $item";
 352     }
 353   }
 354   return join("\n", @wrap, $line);
 355 }
 356
 357 sub y_n {
 358   my ($self, $msg) = @_;
 359   my $key = $self->prompt_key($msg . " (y/n?)", 'yn');
 360   return $key eq 'y';
 361 }
 362
 363 #--------------------------------------------------------------------------#
 364 # handlers
 365 #--------------------------------------------------------------------------#
 366
 367 sub do_blocking {
 368   my ($self, $choice, $log) = @_;
 369   my $note = "perldelta: Unknown [blocking]\n";
 370   $self->add_note( $log->id, $note );
 371   return 1;
 372 }
 373
 374 sub do_examine {
 375   my ($self, $choice, $log) = @_;
 376   $self->start_pager;
 377   say $self->get_diff($log);
 378   $self->end_pager;
 379   return;
 380 }
 381
 382 sub do_cherry {
 383   my ($self, $choice, $log) = @_;
 384   my $id = $log->short_id;
 385   $self->y_n("Recommend a cherry pick of '$id' to maint?") or return;
 386   my $cherrymaint = dirname($0) . "/cherrymaint";
 387   system("$^X $cherrymaint --vote $id");
 388   return; # false will re-prompt the same commit
 389 }
 390
 391 sub do_done {
 392   my ($self, $choice, $log) = @_;
 393   my $note = $log->notes;
 394   $note =~ s{^(perldelta.*\[)\w+(\].*)}{$1done$2}ms;
 395   $self->add_note( $log->id, $note );
 396   return 1;
 397 }
 398
 399 sub do_edit {
 400   my ($self, $choice, $log) = @_;
 401   my $old_note = $log->notes;
 402   my $new_note = $self->edit_text( $self->note_template( $log, $old_note) );
 403   $self->add_note( $log->id, $new_note );
 404   return 1;
 405 }
 406
 407 sub do_head2 {
 408   my ($self, $choice, $log) = @_;
 409   my $section = _strip_parens($choice->{name});
 410   my $subject = $log->subject;
 411   my $body = $log->body;
 412
 413   my $template = $self->note_template( $log,
 414     "perldelta: $section [pending]\n\n=head2 $subject\n\n$body\n"
 415   );
 416
 417   my $note = $self->edit_text( $template );
 418   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 419     $self->add_note( $log->id, $note );
 420     return 1;
 421   }
 422   return;
 423 }
 424
 425 sub do_linked_item {
 426   my ($self, $choice, $log) = @_;
 427   my $section = _strip_parens($choice->{name});
 428   my $subject = $log->subject;
 429   my $body = $log->body;
 430
 431   my $template = $self->note_template( $log,
 432     "perldelta: $section [pending]\n\n=head3 L<LINK>\n\n=over\n\n=item *\n\n$subject\n\n$body\n\n=back\n"
 433   );
 434
 435   my $note = $self->edit_text($template);
 436   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 437     $self->add_note( $log->id, $note );
 438     return 1;
 439   }
 440   return;
 441 }
 442
 443 sub do_item {
 444   my ($self, $choice, $log) = @_;
 445   my $section = _strip_parens($choice->{name});
 446   my $subject = $log->subject;
 447   my $body = $log->body;
 448
 449   my $template = $self->note_template( $log,
 450     "perldelta: $section [pending]\n\n=item *\n\n$subject\n\n$body\n"
 451   );
 452
 453   my $note = $self->edit_text($template);
 454   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 455     $self->add_note( $log->id, $note );
 456     return 1;
 457   }
 458   return;
 459 }
 460
 461 sub do_none {
 462   my ($self, $choice, $log) = @_;
 463   my $note = "perldelta: None [ignored]\n";
 464   $self->add_note( $log->id, $note );
 465   return 1;
 466 }
 467
 468 sub do_platform {
 469   my ($self, $choice, $log) = @_;
 470   my $section = _strip_parens($choice->{name});
 471   my $subject = $log->subject;
 472   my $body = $log->body;
 473
 474   my $template = $self->note_template( $log,
 475     "perldelta: $section [pending]\n\n=item PLATFORM-NAME\n\n$subject\n\n$body\n"
 476   );
 477
 478   my $note = $self->edit_text($template);
 479   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 480     $self->add_note( $log->id, $note );
 481     return 1;
 482   }
 483   return;
 484 }
 485
 486 sub do_quit { exit 0 }
 487
 488 sub do_repeat { return 0 }
 489
 490 sub do_skip { return 1 }
 491
 492 sub do_special {
 493   my ($self, $choice, $log) = @_;
 494   my $section = _strip_parens($choice->{name});
 495   my $subject = $log->subject;
 496   my $body = $log->body;
 497
 498   my $template = $self->note_template( $log, << "HERE" );
 499 perldelta: $section [pending]
 500
 501 $subject
 502
 503 $body
 504 HERE
 505
 506   my $note = $self->edit_text( $template );
 507   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 508     $self->add_note( $log->id, $note );
 509     return 1;
 510   }
 511   return;
 512 }
 513
 514 sub do_subsection {
 515   my ($self, $choice, $log) = @_;
 516   my @choices = ( $choice->{subsection}, $self->submenu_choices );
 517   say "For " . _strip_parens($choice->{name}) . ":";
 518   return $self->dispatch( $self->prompt( @choices ), $log);
 519 }
 520
 521 #--------------------------------------------------------------------------#
 522 # define prompts
 523 #--------------------------------------------------------------------------#
 524
 525 sub action_choices {
 526   my ($self) = @_;
 527   state $action_choices = [
 528       { name => 'E(x)amine', handler => 'examine' },
 529       { name => '(+)Cherrymaint', handler => 'cherry' },
 530       { name => '(?)NeedHelp', handler => 'blocking' },
 531       { name => 'S(k)ip', handler => 'skip' },
 532       { name => '(Q)uit', handler => 'quit' },
 533   ];
 534   return $action_choices;
 535 }
 536
 537 sub submenu_choices {
 538   my ($self) = @_;
 539   state $submenu_choices = [
 540       { name => '(B)ack', handler => 'repeat' },
 541   ];
 542   return $submenu_choices;
 543 }
 544
 545
 546 sub review_choices {
 547   my ($self) = @_;
 548   state $action_choices = [
 549       { name => '(E)dit', handler => 'edit' },
 550       { name => '(I)gnore', handler => 'none' },
 551       { name => '(D)one', handler => 'done' },
 552   ];
 553   return $action_choices;
 554 }
 555
 556 sub section_choices {
 557   my ($self, $key) = @_;
 558   state $section_choices = [
 559     # Headline stuff that should go first
 560     {
 561       name => 'Core (E)nhancements',
 562       handler => 'head2',
 563     },
 564     {
 565       name => 'Securit(y)',
 566       handler => 'head2',
 567     },
 568     {
 569       name => '(I)ncompatible Changes',
 570       handler => 'head2',
 571     },
 572     {
 573       name => 'Dep(r)ecations',
 574       handler => 'head2',
 575     },
 576     {
 577       name => '(P)erformance Enhancements',
 578       handler => 'item',
 579     },
 580
 581     # Details on things installed with Perl (for Perl developers)
 582     {
 583       name => '(M)odules and Pragmata',
 584       handler => 'subsection',
 585       subsection => [
 586         {
 587           name => '(N)ew Modules and Pragmata',
 588           handler => 'item',
 589         },
 590         {
 591           name => '(U)pdated Modules and Pragmata',
 592           handler => 'item',
 593         },
 594         {
 595           name => '(R)emoved Modules and Pragmata',
 596           handler => 'item',
 597         },
 598       ],
 599     },
 600     {
 601       name => '(D)ocumentation',
 602       handler => 'subsection',
 603       subsection => [
 604         {
 605           name => '(N)ew Documentation',
 606           handler => 'linked_item',
 607         },
 608         {
 609           name => '(C)hanges to Existing Documentation',
 610           handler => 'linked_item',
 611         },
 612       ],
 613     },
 614     {
 615       name => 'Dia(g)nostics',
 616       handler => 'subsection',
 617       subsection => [
 618         {
 619           name => '(N)ew Diagnostics',
 620           handler => 'item',
 621         },
 622         {
 623           name => '(C)hanges to Existing Diagnostics',
 624           handler => 'item',
 625         },
 626       ],
 627     },
 628     {
 629       name => '(U)tilities',
 630       handler => 'linked_item',
 631     },
 632
 633     # Details on building/testing Perl (for porters and packagers)
 634     {
 635       name => '(C)onfiguration and Compilation',
 636       handler => 'item',
 637     },
 638     {
 639       name => '(T)esting', # new tests or significant notes about it
 640       handler => 'item',
 641     },
 642     {
 643       name => 'Pl(a)tform Support',
 644       handler => 'subsection',
 645       subsection => [
 646         {
 647           name => '(N)ew Platforms',
 648           handler => 'platform',
 649         },
 650         {
 651           name => '(D)iscontinued Platforms',
 652           handler => 'platform',
 653         },
 654         {
 655           name => '(P)latform-Specific Notes',
 656           handler => 'platform',
 657         },
 658       ],
 659     },
 660
 661     # Details on perl internals (for porters and XS developers)
 662     {
 663       name => 'Inter(n)al Changes',
 664       handler => 'item',
 665     },
 666
 667     # Bugs fixed and related stuff
 668     {
 669       name => 'Selected Bug (F)ixes',
 670       handler => 'item',
 671     },
 672     {
 673       name => 'Known Prob(l)ems',
 674       handler => 'item',
 675     },
 676
 677     # dummy options for special handling
 678     {
 679       name => '(S)pecial',
 680       handler => 'special',
 681     },
 682     {
 683       name => '(*)None',
 684       handler => 'none',
 685     },
 686   ];
 687   return $section_choices;
 688 }
 689
 690 sub section_order {
 691   my ($self) = @_;
 692   state @order;
 693   if ( ! @order ) {
 694     for my $c ( @{ $self->section_choices } ) {
 695       if ( $c->{subsection} ) {
 696         push @order, map { $_->{name} } @{$c->{subsection}};
 697       }
 698       else {
 699         push @order, $c->{name};
 700       }
 701     }
 702   }
 703   return @order;
 704 }
 705
 706 #--------------------------------------------------------------------------#
 707 # Pager handling
 708 #--------------------------------------------------------------------------#
 709
 710 sub get_pager { $ENV{'PAGER'} || `which less` || `which more` }
 711
 712 sub in_pager { shift->original_stdout ? 1 : 0 }
 713
 714 sub start_pager {
 715   my $self = shift;
 716   my $content = shift;
 717   if (!$self->in_pager) {
 718     local $ENV{'LESS'} ||= '-FXe';
 719     local $ENV{'MORE'};
 720     $ENV{'MORE'} ||= '-FXe' unless $^O =~ /^MSWin/;
 721
 722     my $pager = $self->get_pager;
 723     return unless $pager;
 724     open (my $cmd, "|-", $pager) || return;
 725     $|++;
 726     $self->original_stdout(*STDOUT);
 727
 728     # $pager will be closed once we restore STDOUT to $original_stdout
 729     *STDOUT = $cmd;
 730   }
 731 }
 732
 733 sub end_pager {
 734   my $self = shift;
 735   return unless ($self->in_pager);
 736   *STDOUT = $self->original_stdout;
 737
 738   # closes the pager
 739   $self->original_stdout(undef);
 740 }
 741
 742 #--------------------------------------------------------------------------#
 743 # Utility functions
 744 #--------------------------------------------------------------------------#
 745
 746 sub _strip_parens {
 747   my ($name) = @_;
 748   $name =~ s/[()]//g;
 749   return $name;
 750 }
 751
 752 sub _prepend_comment {
 753   my ($text) = @_;
 754   return join ("\n", map { s/^/# /g; $_ } split "\n", $text);
 755 }
 756
 757 sub _strip_comments {
 758   my ($text) = @_;
 759   return join ("\n", grep { ! /^#/ } split "\n", $text);
 760 }
 761
 762 #--------------------------------------------------------------------------#
 763 # Extend Git::Wrapper::Log
 764 #--------------------------------------------------------------------------#
 765
 766 package Git::Wrapper::XLog;
 767 BEGIN { our @ISA = qw/Git::Wrapper::Log/; }
 768
 769 sub subject { shift->attr->{subject} }
 770 sub body { shift->attr->{body} }
 771 sub short_id { shift->attr->{short_id} }
 772
 773 sub from_log {
 774   my ($class, $log) = @_;
 775
 776   my $msg = $log->message;
 777   my ($subject, $body) = $msg =~ m{^([^\n]+)\n*(.*)}ms;
 778   $subject //= '';
 779   $body //= '';
 780   $body =~ s/[\r\n]*\z//ms;
 781
 782   my ($short) = Git::Wrapper->new(".")->rev_parse({short => 1}, $log->id);
 783
 784   $log->attr->{subject} = $subject;
 785   $log->attr->{body} = $body;
 786   $log->attr->{short_id} = $short;
 787   return bless $log, $class;
 788 }
 789
 790 sub notes {
 791   my ($self) = @_;
 792   my @notes = eval { Git::Wrapper->new(".")->notes('show', $self->id) };
 793   pop @notes while @notes && $notes[-1] =~ m{^\s*$};
 794   return unless @notes;
 795   return join ("\n", @notes);
 796 }
 797
 798 __END__
 799
 800 =head1 NAME
 801
 802 git-deltatool - Annotate commits for perldelta
 803
 804 =head1 SYNOPSIS
 805
 806  # annotate commits back to last 'git describe' tag
 807
 808  $ git-deltatool
 809
 810  # review annotations
 811
 812  $ git-deltatool --mode review
 813
 814  # review commits needing help
 815
 816  $ git-deltatool --mode review --type blocking
 817
 818  # summarize commits needing help
 819
 820  $ git-deltatool --mode summary --type blocking
 821
 822  # assemble annotations by section to STDOUT
 823
 824  $ git-deltatool --mode render
 825
 826  # Get a list of commits needing further review, e.g. for peer review
 827
 828  $ git-deltatool --mode summary --type blocking
 829
 830  # mark 'pending' annotations as 'done' (i.e. added to perldelta)
 831
 832  $ git-deltatool --mode update --type pending --status done
 833
 834 =head1 OPTIONS
 835
 836 =over
 837
 838 =item B<--mode>|B<-m> MODE
 839
 840 Indicates the run mode for the program.  The default is 'assign' which
 841 assigns categories and marks the notes as 'pending' (or 'ignored').  Other
 842 modes are 'review', 'render', 'summary' and 'update'.
 843
 844 =item B<--type>|B<-t> TYPE
 845
 846 Indicates what types of commits to process.  The default for 'assign' mode is
 847 'new', which processes commits without any perldelta notes.  The default for
 848 'review', 'summary' and 'render' modes is 'pending'.  The options must be set
 849 explicitly for 'update' mode.
 850
 851 The type 'blocking' is reserved for commits needing further review.
 852
 853 =item B<--status>|B<-s> STATUS
 854
 855 For 'update' mode only, sets a new status.  While there is no restriction,
 856 it should be one of 'new', 'pending', 'blocking', 'ignored' or 'done'.
 857
 858 =item B<--since> REVISION
 859
 860 Defines the boundary for searching git commits.  Defaults to the last
 861 major tag (as would be given by 'git describe').
 862
 863 =item B<--help>
 864
 865 Shows the manual.
 866
 867 =back
 868
 869 =head1 TODO
 870
 871 It would be nice to make some of the structured sections smarter -- e.g.
 872 look at changed files in pod/* for Documentation section entries.  Likewise
 873 it would be nice to collate them during the render phase -- e.g. cluster
 874 all platform-specific things properly.
 875
 876 =head1 AUTHOR
 877
 878 David Golden <dagolden@cpan.org>
 879
 880 =head1 COPYRIGHT AND LICENSE
 881
 882 This software is copyright (c) 2010 by David Golden.
 883
 884 This is free software; you can redistribute it and/or modify it under the same
 885 terms as the Perl 5 programming language system itself.
 886
 887 =cut
 888