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 Pod::Usage;
-BEGIN { struct( git => '$', last_tag => '$', opt => '%' ) }
+BEGIN { struct( git => '$', last_tag => '$', opt => '%', original_stdout => '$' ) }
__PACKAGE__->run;
'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 ) {
$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};
- die "Explicit --status argument requrid for update mode\n"
+ die "Explicit --status argument required for update mode\n"
unless defined $opt{status};
$gdt->update;
}
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);
+ $self->show_files($log);
say "-" x 75;
return $self->dispatch( $self->prompt( @choices ), $log);
}
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);
- $self->show_body($log, 1);
$self->show_notes($log, 1);
say "-" x 75;
return $self->dispatch( $self->prompt( @choices ), $log);
return;
}
+sub summary {
+ my ($self) = @_;
+ $self->_iterate_commits(
+ sub {
+ my $log = shift;
+ $self->show_header($log);
+ return 1;
+ }
+ );
+ return;
+}
+
sub update {
my ($self) = @_;
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;
}
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) {
$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;
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;
}
# 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;
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;
}
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 );
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;
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);
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_repeat { return 0 }
+
sub do_skip { return 1 }
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 );
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_subsection {
my ($self, $choice, $log) = @_;
+ my @choices = ( $choice->{subsection}, $self->submenu_choices );
say "For " . _strip_parens($choice->{name}) . ":";
- return $self->dispatch( $self->prompt( $choice->{subsection} ), $log);
+ return $self->dispatch( $self->prompt( @choices ), $log);
}
#--------------------------------------------------------------------------#
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;
}
+sub submenu_choices {
+ my ($self) = @_;
+ state $submenu_choices = [
+ { name => '(B)ack', handler => 'repeat' },
+ ];
+ return $submenu_choices;
+}
+
+
sub review_choices {
my ($self) = @_;
state $action_choices = [
subsection => [
{
name => '(N)ew Documentation',
- handler => 'item',
+ handler => 'linked_item',
},
{
name => '(C)hanges to Existing Documentation',
- handler => 'item',
+ handler => 'linked_item',
},
],
},
},
{
name => '(U)tilities',
- handler => 'item',
+ handler => 'linked_item',
},
# Details on building/testing Perl (for porters and packagers)
subsection => [
{
name => '(N)ew Platforms',
- handler => 'item',
+ handler => 'platform',
},
{
name => '(D)iscontinued Platforms',
- handler => 'item',
+ handler => 'platform',
},
{
name => '(P)latform-Specific Notes',
- handler => 'item',
+ handler => 'platform',
},
],
},
}
#--------------------------------------------------------------------------#
+# 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
#--------------------------------------------------------------------------#
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;
$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;
=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
- $ git-deltatool.pl
+ $ git-deltatool
# 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)
- $ git-deltatool.pl --mode update --type pending --status done
+ $ git-deltatool --mode update --type pending --status done
=head1 OPTIONS
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
-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,
-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<--help>
+
+Shows the manual.
+
=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>
https://perl5.git.perl.org / perl5.git / blobdiff