Porting/epigraphs.pod: add v5.19.1 and v5.19.0 epigraphs

[perl5.git] / Porting / git-deltatool

diff --git a/Porting/git-deltatool b/Porting/git-deltatool
old mode 100755 (executable)
new mode 100644 (file)
index a40ef83..33bd595
--- a/Porting/git-deltatool
+++ b/Porting/git-deltatool
@@ -9,13 +9,15 @@ use warnings;
 package Git::DeltaTool;
 
 use Class::Struct;
 package Git::DeltaTool;
 
 use Class::Struct;

+use File::Basename;

 use File::Temp;
 use Getopt::Long;
 use Git::Wrapper;
 use Term::ReadKey;
 use Term::ANSIColor;
 use File::Temp;
 use Getopt::Long;
 use Git::Wrapper;
 use Term::ReadKey;
 use Term::ANSIColor;

+use Pod::Usage;

 
 

-BEGIN { struct( git => '$', last_tag => '$', opt => '%' ) }
+BEGIN { struct( git => '$', last_tag => '$', opt => '%', original_stdout => '$' ) }

 
 __PACKAGE__->run;
 
 
 __PACKAGE__->run;
 


@@ -36,8 +38,11 @@ sub run {
     'type|t:s', # select by status
     'status|s:s', # status to set for 'update'
     'since:s', # origin commit
     'type|t:s', # select by status
     'status|s:s', # status to set for 'update'
     'since:s', # origin commit

+    'help|h',  # help

   );
 
   );
 

+  pod2usage() if $opt{help};
+

   my $git = Git::Wrapper->new(".");
   my $git_id = $opt{since};
   if ( defined $git_id ) {
   my $git = Git::Wrapper->new(".");
   my $git_id = $opt{since};
   if ( defined $git_id ) {


@@ -61,10 +66,14 @@ sub run {
     $opt{type} //= 'pending';
     $gdt->render;
   }
     $opt{type} //= 'pending';
     $gdt->render;
   }

+  elsif ( $opt{mode} eq 'summary' ) {
+    $opt{type} //= 'pending';
+    $gdt->summary;
+  }

   elsif ( $opt{mode} eq 'update' ) {
     die "Explicit --type argument required for update mode\n"
       unless defined $opt{type};
   elsif ( $opt{mode} eq 'update' ) {
     die "Explicit --type argument required for update mode\n"
       unless defined $opt{type};

-    die "Explicit --status argument requrid for update mode\n"
+    die "Explicit --status argument required for update mode\n"

       unless defined $opt{status};
     $gdt->update;
   }
       unless defined $opt{status};
     $gdt->update;
   }


@@ -83,10 +92,12 @@ sub assign {
   my @choices = ( $self->section_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {
   my @choices = ( $self->section_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {

-      my $log = shift;
+      my ($log, $i, $count) = @_;
+      say "\n### Commit @{[$i+1]} of $count ###";

       say "-" x 75;
       $self->show_header($log);
       $self->show_body($log, 1);
       say "-" x 75;
       $self->show_header($log);
       $self->show_body($log, 1);

+      $self->show_files($log);

       say "-" x 75;
       return $self->dispatch( $self->prompt( @choices ), $log);
     }
       say "-" x 75;
       return $self->dispatch( $self->prompt( @choices ), $log);
     }


@@ -99,10 +110,10 @@ sub review {
   my @choices = ( $self->review_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {
   my @choices = ( $self->review_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {

-      my $log = shift;
+      my ($log, $i, $count) = @_;
+      say "\n### Commit @{[$i+1]} of $count ###";

       say "-" x 75;
       $self->show_header($log);
       say "-" x 75;
       $self->show_header($log);

-      $self->show_body($log, 1);

       $self->show_notes($log, 1);
       say "-" x 75;
       return $self->dispatch( $self->prompt( @choices ), $log);
       $self->show_notes($log, 1);
       say "-" x 75;
       return $self->dispatch( $self->prompt( @choices ), $log);


@@ -134,6 +145,18 @@ sub render {
   return;
 }
 
   return;
 }
 

+sub summary {
+  my ($self) = @_;
+  $self->_iterate_commits(
+    sub {
+      my $log = shift;
+      $self->show_header($log);
+      return 1;
+    }
+  );
+  return;
+}
+

 sub update {
   my ($self) = @_;
 
 sub update {
   my ($self) = @_;
 


@@ -155,9 +178,11 @@ sub update {
 sub _iterate_commits {
   my ($self, $fcn) = @_;
   my $type = $self->opt('type');
 sub _iterate_commits {
   my ($self, $fcn) = @_;
   my $type = $self->opt('type');

-  say "Scanning for $type commits since " . $self->last_tag . "...";
-  for my $log ( $self->find_commits($type) ) {
-    redo unless $fcn->($log);
+  say STDERR "Scanning for $type commits since " . $self->last_tag . "...";
+  my $list = [ $self->find_commits($type) ];
+  my $count = @$list;
+  while ( my ($i,$log) = each @$list ) {
+    redo unless $fcn->($log, $i, $count);

   }
   return 1;
 }
   }
   return 1;
 }


@@ -168,7 +193,7 @@ sub _iterate_commits {
 
 sub add_note {
   my ($self, $id, $note) = @_;
 
 sub add_note {
   my ($self, $id, $note) = @_;

-  my @lines = split "\n", $note;
+  my @lines = split "\n", _strip_comments($note);

   pop @lines while @lines && $lines[-1] =~ m{^\s*$};
   my $tempfh = File::Temp->new;
   if (@lines) {
   pop @lines while @lines && $lines[-1] =~ m{^\s*$};
   my $tempfh = File::Temp->new;
   if (@lines) {


@@ -197,22 +222,21 @@ sub edit_text {
   $args //= {};
   my $tempfh = File::Temp->new;
   $tempfh->printflush( $text );
   $args //= {};
   my $tempfh = File::Temp->new;
   $tempfh->printflush( $text );

-  if ( my (@editor) = $ENV{VISUAL} || $ENV{EDITOR} ) {
+  if ( my @editor = split /\s+/, ($ENV{VISUAL} || $ENV{EDITOR}) ) {

     push @editor, "-f" if $editor[0] =~ /^gvim/;
     system(@editor, "$tempfh");
   }
   else {
     warn("No VISUAL or EDITOR defined");
   }
     push @editor, "-f" if $editor[0] =~ /^gvim/;
     system(@editor, "$tempfh");
   }
   else {
     warn("No VISUAL or EDITOR defined");
   }

-  $tempfh->seek(0,0);
-  return do { local $/; <$tempfh> };
+  return do { local (@ARGV,$/) = "$tempfh"; <> };

 }
 
 sub find_commits {
   my ($self, $type) = @_;
   $type //= 'new';
   my @commits = $self->git->log($self->last_tag . "..HEAD");
 }
 
 sub find_commits {
   my ($self, $type) = @_;
   $type //= 'new';
   my @commits = $self->git->log($self->last_tag . "..HEAD");

-  $_ = Git::Wrapper::XLog->from_log($_) for @commits;
+  $_ = Git::Wrapper::XLog->from_log($_, $self->git) for @commits;

   my @list;
   if ( $type eq 'new' ) {
     @list = grep { ! $_->notes } @commits;
   my @list;
   if ( $type eq 'new' ) {
     @list = grep { ! $_->notes } @commits;


@@ -301,10 +325,21 @@ sub show_body {
   return;
 }
 
   return;
 }
 

+sub show_files {
+  my ($self, $log) = @_;
+  my @files = $self->git->diff_tree({r => 1, abbrev => 1}, $log->id);
+  shift @files; # throw away commit line
+  return unless @files;
+  say "\nChanged:";
+  say join("\n", map { "  * $_" } sort map { /.*\s+(\S+)/; $1 } @files);
+  return;
+}
+

 sub show_header {
   my ($self, $log) = @_;
   my $header = $log->short_id;
   $header .= " " . $log->subject if length $log->subject;
 sub show_header {
   my ($self, $log) = @_;
   my $header = $log->short_id;
   $header .= " " . $log->subject if length $log->subject;

+  $header .= sprintf(' (%s)', $log->author) if $log->author;

   say colored( $header, "yellow");
   return;
 }
   say colored( $header, "yellow");
   return;
 }


@@ -342,6 +377,30 @@ sub y_n {
 # handlers
 #--------------------------------------------------------------------------#
 
 # handlers
 #--------------------------------------------------------------------------#
 

+sub do_blocking {
+  my ($self, $choice, $log) = @_;
+  my $note = "perldelta: Unknown [blocking]\n";
+  $self->add_note( $log->id, $note );
+  return 1;
+}
+
+sub do_examine {
+  my ($self, $choice, $log) = @_;
+  $self->start_pager;
+  say $self->get_diff($log);
+  $self->end_pager;
+  return;
+}
+
+sub do_cherry {
+  my ($self, $choice, $log) = @_;
+  my $id = $log->short_id;
+  $self->y_n("Recommend a cherry pick of '$id' to maint?") or return;
+  my $cherrymaint = dirname($0) . "/cherrymaint";
+  system("$^X $cherrymaint --vote $id");
+  return; # false will re-prompt the same commit
+}
+

 sub do_done {
   my ($self, $choice, $log) = @_;
   my $note = $log->notes;
 sub do_done {
   my ($self, $choice, $log) = @_;
   my $note = $log->notes;


@@ -354,7 +413,7 @@ sub do_edit {
   my ($self, $choice, $log) = @_;
   my $old_note = $log->notes;
   my $new_note = $self->edit_text( $self->note_template( $log, $old_note) );
   my ($self, $choice, $log) = @_;
   my $old_note = $log->notes;
   my $new_note = $self->edit_text( $self->note_template( $log, $old_note) );

-  $self->add_note( $log->id, _strip_comments($new_note) );
+  $self->add_note( $log->id, $new_note );

   return 1;
 }
 
   return 1;
 }
 


@@ -363,15 +422,32 @@ sub do_head2 {
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;

-  my $id = $log->short_id;

 
   my $template = $self->note_template( $log,
 
   my $template = $self->note_template( $log,

-    "perldelta: $section [pending]\n\n=head2 $subject\n\n$body ($id)\n"
+    "perldelta: $section [pending]\n\n=head2 $subject\n\n$body\n"

   );
 
   my $note = $self->edit_text( $template );
   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
   );
 
   my $note = $self->edit_text( $template );
   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {

-    $self->add_note( $log->id, _strip_comments($note) );
+    $self->add_note( $log->id, $note );
+    return 1;
+  }
+  return;
+}
+
+sub do_linked_item {
+  my ($self, $choice, $log) = @_;
+  my $section = _strip_parens($choice->{name});
+  my $subject = $log->subject;
+  my $body = $log->body;
+
+  my $template = $self->note_template( $log,
+    "perldelta: $section [pending]\n\n=head3 L<LINK>\n\n=over\n\n=item *\n\n$subject\n\n$body\n\n=back\n"
+  );
+
+  my $note = $self->edit_text($template);
+  if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
+    $self->add_note( $log->id, $note );

     return 1;
   }
   return;
     return 1;
   }
   return;


@@ -382,10 +458,9 @@ sub do_item {
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;

-  my $id = $log->short_id;

 
   my $template = $self->note_template( $log,
 
   my $template = $self->note_template( $log,

-    "perldelta: $section [pending]\n\n=item *\n\n$subject ($id)\n\n$body\n"
+    "perldelta: $section [pending]\n\n=item *\n\n$subject\n\n$body\n"

   );
 
   my $note = $self->edit_text($template);
   );
 
   my $note = $self->edit_text($template);


@@ -403,8 +478,28 @@ sub do_none {
   return 1;
 }
 
   return 1;
 }
 

+sub do_platform {
+  my ($self, $choice, $log) = @_;
+  my $section = _strip_parens($choice->{name});
+  my $subject = $log->subject;
+  my $body = $log->body;
+
+  my $template = $self->note_template( $log,
+    "perldelta: $section [pending]\n\n=item PLATFORM-NAME\n\n$subject\n\n$body\n"
+  );
+
+  my $note = $self->edit_text($template);
+  if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
+    $self->add_note( $log->id, $note );
+    return 1;
+  }
+  return;
+}
+

 sub do_quit { exit 0 }
 
 sub do_quit { exit 0 }
 

+sub do_repeat { return 0 }
+

 sub do_skip { return 1 }
 
 sub do_special {
 sub do_skip { return 1 }
 
 sub do_special {


@@ -412,19 +507,18 @@ sub do_special {
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;
   my $section = _strip_parens($choice->{name});
   my $subject = $log->subject;
   my $body = $log->body;

-  my $id = $log->short_id;

 
   my $template = $self->note_template( $log, << "HERE" );
 perldelta: $section [pending]
 
 $subject
 
 
   my $template = $self->note_template( $log, << "HERE" );
 perldelta: $section [pending]
 
 $subject
 

-$body ($id)
+$body

 HERE
 
   my $note = $self->edit_text( $template );
   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {
 HERE
 
   my $note = $self->edit_text( $template );
   if ( ($note ne $template) or $self->y_n("Note unchanged. Commit it?") ) {

-    $self->add_note( $log->id, _strip_comments($note) );
+    $self->add_note( $log->id, $note );

     return 1;
   }
   return;
     return 1;
   }
   return;


@@ -432,8 +526,9 @@ HERE
 
 sub do_subsection {
   my ($self, $choice, $log) = @_;
 
 sub do_subsection {
   my ($self, $choice, $log) = @_;

+  my @choices = ( $choice->{subsection}, $self->submenu_choices );

   say "For " . _strip_parens($choice->{name}) . ":";
   say "For " . _strip_parens($choice->{name}) . ":";

-  return $self->dispatch( $self->prompt( $choice->{subsection} ), $log);
+  return $self->dispatch( $self->prompt( @choices ), $log);

 }
 
 #--------------------------------------------------------------------------#
 }
 
 #--------------------------------------------------------------------------#


@@ -443,12 +538,24 @@ sub do_subsection {
 sub action_choices {
   my ($self) = @_;
   state $action_choices = [
 sub action_choices {
   my ($self) = @_;
   state $action_choices = [

+      { name => 'E(x)amine', handler => 'examine' },
+      { name => '(+)Cherrymaint', handler => 'cherry' },
+      { name => '(?)NeedHelp', handler => 'blocking' },

       { name => 'S(k)ip', handler => 'skip' },
       { name => '(Q)uit', handler => 'quit' },
   ];
   return $action_choices;
 }
 
       { name => 'S(k)ip', handler => 'skip' },
       { name => '(Q)uit', handler => 'quit' },
   ];
   return $action_choices;
 }
 

+sub submenu_choices {
+  my ($self) = @_;
+  state $submenu_choices = [
+      { name => '(B)ack', handler => 'repeat' },
+  ];
+  return $submenu_choices;
+}
+
+

 sub review_choices {
   my ($self) = @_;
   state $action_choices = [
 sub review_choices {
   my ($self) = @_;
   state $action_choices = [


@@ -509,11 +616,11 @@ sub section_choices {
       subsection => [
         {
           name => '(N)ew Documentation',
       subsection => [
         {
           name => '(N)ew Documentation',

-          handler => 'item',
+          handler => 'linked_item',

         },
         {
           name => '(C)hanges to Existing Documentation',
         },
         {
           name => '(C)hanges to Existing Documentation',

-          handler => 'item',
+          handler => 'linked_item',

         },
       ],
     },
         },
       ],
     },


@@ -533,7 +640,7 @@ sub section_choices {
     },
     {
       name => '(U)tilities',
     },
     {
       name => '(U)tilities',

-      handler => 'item',
+      handler => 'linked_item',

     },
 
     # Details on building/testing Perl (for porters and packagers)
     },
 
     # Details on building/testing Perl (for porters and packagers)


@@ -551,15 +658,15 @@ sub section_choices {
       subsection => [
         {
           name => '(N)ew Platforms',
       subsection => [
         {
           name => '(N)ew Platforms',

-          handler => 'item',
+          handler => 'platform',

         },
         {
           name => '(D)iscontinued Platforms',
         },
         {
           name => '(D)iscontinued Platforms',

-          handler => 'item',
+          handler => 'platform',

         },
         {
           name => '(P)latform-Specific Notes',
         },
         {
           name => '(P)latform-Specific Notes',

-          handler => 'item',
+          handler => 'platform',

         },
       ],
     },
         },
       ],
     },


@@ -610,6 +717,42 @@ sub section_order {
 }
 
 #--------------------------------------------------------------------------#
 }
 
 #--------------------------------------------------------------------------#

+# Pager handling
+#--------------------------------------------------------------------------#
+
+sub get_pager { $ENV{'PAGER'} || `which less` || `which more` }
+
+sub in_pager { shift->original_stdout ? 1 : 0 }
+
+sub start_pager {
+  my $self = shift;
+  my $content = shift;
+  if (!$self->in_pager) {
+    local $ENV{'LESS'} ||= '-FXe';
+    local $ENV{'MORE'};
+    $ENV{'MORE'} ||= '-FXe' unless $^O =~ /^MSWin/;
+
+    my $pager = $self->get_pager;
+    return unless $pager;
+    open (my $cmd, "|-", $pager) || return;
+    $|++;
+    $self->original_stdout(*STDOUT);
+
+    # $pager will be closed once we restore STDOUT to $original_stdout
+    *STDOUT = $cmd;
+  }
+}
+
+sub end_pager {
+  my $self = shift;
+  return unless ($self->in_pager);
+  *STDOUT = $self->original_stdout;
+
+  # closes the pager
+  $self->original_stdout(undef);
+}
+
+#--------------------------------------------------------------------------#

 # Utility functions
 #--------------------------------------------------------------------------#
 
 # Utility functions
 #--------------------------------------------------------------------------#
 


@@ -639,9 +782,10 @@ BEGIN { our @ISA = qw/Git::Wrapper::Log/; }
 sub subject { shift->attr->{subject} }
 sub body { shift->attr->{body} }
 sub short_id { shift->attr->{short_id} }
 sub subject { shift->attr->{subject} }
 sub body { shift->attr->{body} }
 sub short_id { shift->attr->{short_id} }

+sub author { shift->attr->{author} }

 
 sub from_log {
 
 sub from_log {

-  my ($class, $log) = @_;
+  my ($class, $log, $git) = @_;

 
   my $msg = $log->message;
   my ($subject, $body) = $msg =~ m{^([^\n]+)\n*(.*)}ms;
 
   my $msg = $log->message;
   my ($subject, $body) = $msg =~ m{^([^\n]+)\n*(.*)}ms;


@@ -649,7 +793,7 @@ sub from_log {
   $body //= '';
   $body =~ s/[\r\n]*\z//ms;
 
   $body //= '';
   $body =~ s/[\r\n]*\z//ms;
 

-  my ($short) = Git::Wrapper->new(".")->rev_parse({short => 1}, $log->id);
+  my ($short) = $git->rev_parse({short => 1}, $log->id);

 
   $log->attr->{subject} = $subject;
   $log->attr->{body} = $body;
 
   $log->attr->{subject} = $subject;
   $log->attr->{body} = $body;


@@ -669,25 +813,37 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 

-git-deltatool.pl - Annotate commits for perldelta
+git-deltatool - Annotate commits for perldelta

 
 =head1 SYNOPSIS
 
  # annotate commits back to last 'git describe' tag
 
 
 =head1 SYNOPSIS
 
  # annotate commits back to last 'git describe' tag
 

- $ git-deltatool.pl
+ $ git-deltatool

 
  # review annotations
 
 
  # review annotations
 

- $ git-deltatool.pl --mode review
+ $ git-deltatool --mode review
+
+ # review commits needing help
+
+ $ git-deltatool --mode review --type blocking
+
+ # summarize commits needing help
+
+ $ git-deltatool --mode summary --type blocking
+
+ # assemble annotations by section to STDOUT

 
 

- # summarize annotations by section to STDOUT
+ $ git-deltatool --mode render

 
 

- $ git-deltatool.pl --mode render
+ # Get a list of commits needing further review, e.g. for peer review
+
+ $ git-deltatool --mode summary --type blocking

 
  # mark 'pending' annotations as 'done' (i.e. added to perldelta)
 
 
  # mark 'pending' annotations as 'done' (i.e. added to perldelta)
 

- $ git-deltatool.pl --mode update --type pending --status done
+ $ git-deltatool --mode update --type pending --status done

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 


@@ -697,27 +853,40 @@ git-deltatool.pl - Annotate commits for perldelta
 
 Indicates the run mode for the program.  The default is 'assign' which
 assigns categories and marks the notes as 'pending' (or 'ignored').  Other
 
 Indicates the run mode for the program.  The default is 'assign' which
 assigns categories and marks the notes as 'pending' (or 'ignored').  Other

-modes are 'review', 'render' and 'update'.
+modes are 'review', 'render', 'summary' and 'update'.

 
 =item B<--type>|B<-t> TYPE
 
 
 =item B<--type>|B<-t> TYPE
 

-Indicates what types of commits to process.  The default for 'assign' mode
-is 'new', which processes commits without any perldelta notes.  The
-default for 'review' and 'render' modes is 'pending'.  The options
-must be set explicitly for 'update' mode.
+Indicates what types of commits to process.  The default for 'assign' mode is
+'new', which processes commits without any perldelta notes.  The default for
+'review', 'summary' and 'render' modes is 'pending'.  The options must be set
+explicitly for 'update' mode.
+
+The type 'blocking' is reserved for commits needing further review.

 
 =item B<--status>|B<-s> STATUS
 
 For 'update' mode only, sets a new status.  While there is no restriction,
 
 =item B<--status>|B<-s> STATUS
 
 For 'update' mode only, sets a new status.  While there is no restriction,

-it should be one of 'new', 'pending', 'ignored' or 'done'.
+it should be one of 'new', 'pending', 'blocking', 'ignored' or 'done'.

 
 =item B<--since> REVISION
 
 Defines the boundary for searching git commits.  Defaults to the last
 major tag (as would be given by 'git describe').
 
 
 =item B<--since> REVISION
 
 Defines the boundary for searching git commits.  Defaults to the last
 major tag (as would be given by 'git describe').
 

+=item B<--help>
+
+Shows the manual.
+

 =back
 
 =back
 

+=head1 TODO
+
+It would be nice to make some of the structured sections smarter -- e.g.
+look at changed files in pod/* for Documentation section entries.  Likewise
+it would be nice to collate them during the render phase -- e.g. cluster
+all platform-specific things properly.
+

 =head1 AUTHOR
 
 David Golden <dagolden@cpan.org>
 =head1 AUTHOR
 
 David Golden <dagolden@cpan.org>