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