devel/scanprov: Add in exceptions

[perl5.git] / Porting / git-deltatool

diff --git a/Porting/git-deltatool b/Porting/git-deltatool
old mode 100755 (executable)
new mode 100644 (file)
index c3946ee..33bd595
--- a/Porting/git-deltatool
+++ b/Porting/git-deltatool
@@ -17,7 +17,7 @@ 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;
 
@@ -92,11 +92,12 @@ sub assign {
   my @choices = ( $self->section_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {
-      my $log = shift;
-      say "";
+      my ($log, $i, $count) = @_;
+      say "\n### Commit @{[$i+1]} of $count ###";
       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);
     }
@@ -109,8 +110,8 @@ sub review {
   my @choices = ( $self->review_choices, $self->action_choices );
   $self->_iterate_commits(
     sub {
-      my $log = shift;
-      say "";
+      my ($log, $i, $count) = @_;
+      say "\n### Commit @{[$i+1]} of $count ###";
       say "-" x 75;
       $self->show_header($log);
       $self->show_notes($log, 1);
@@ -177,9 +178,11 @@ sub update {
 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;
 }
@@ -219,22 +222,21 @@ sub edit_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");
   }
-  $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");
-  $_ = 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;
@@ -323,10 +325,21 @@ sub show_body {
   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;
+  $header .= sprintf(' (%s)', $log->author) if $log->author;
   say colored( $header, "yellow");
   return;
 }
@@ -371,6 +384,14 @@ sub do_blocking {
   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;
@@ -401,10 +422,9 @@ sub do_head2 {
   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,
-    "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 );
@@ -420,10 +440,9 @@ sub do_linked_item {
   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,
-    "perldelta: $section [pending]\n\n=head3 L<LINK>\n\n=over\n\n=item *\n\n$subject ($id)\n\n$body\n\n=back\n"
+    "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);
@@ -439,10 +458,9 @@ sub do_item {
   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,
-    "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);
@@ -465,10 +483,9 @@ sub do_platform {
   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,
-    "perldelta: $section [pending]\n\n=item PLATFORM-NAME\n\n$subject ($id)\n\n$body\n"
+    "perldelta: $section [pending]\n\n=item PLATFORM-NAME\n\n$subject\n\n$body\n"
   );
 
   my $note = $self->edit_text($template);
@@ -490,14 +507,13 @@ sub do_special {
   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
 
-$body ($id)
+$body
 HERE
 
   my $note = $self->edit_text( $template );
@@ -522,6 +538,7 @@ sub do_subsection {
 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' },
@@ -700,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
 #--------------------------------------------------------------------------#
 
@@ -729,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 author { shift->attr->{author} }
 
 sub from_log {
-  my ($class, $log) = @_;
+  my ($class, $log, $git) = @_;
 
   my $msg = $log->message;
   my ($subject, $body) = $msg =~ m{^([^\n]+)\n*(.*)}ms;
@@ -739,7 +793,7 @@ sub from_log {
   $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;
@@ -783,6 +837,10 @@ git-deltatool - Annotate commits for perldelta
 
  $ git-deltatool --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)
 
  $ git-deltatool --mode update --type pending --status done
@@ -795,13 +853,13 @@ git-deltatool - 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
-modes are 'review', 'render', 'summarize' and 'update'.
+modes are 'review', 'render', 'summary' and 'update'.
 
 =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', 'summarize' and 'render' modes is 'pending'.  The options must be set
+'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.