[Bps-public-commit] r18303 - App-Changelogger/bin
jesse at bestpractical.com
jesse at bestpractical.com
Mon Feb 9 14:00:58 EST 2009
Author: jesse
Date: Mon Feb 9 14:00:58 2009
New Revision: 18303
Modified:
App-Changelogger/bin/generate-changelog
App-Changelogger/bin/sort-changelog
Log:
* Started to add git support to sort-changelog
* removed dead code from generate-changelog
Modified: App-Changelogger/bin/generate-changelog
==============================================================================
--- App-Changelogger/bin/generate-changelog (original)
+++ App-Changelogger/bin/generate-changelog Mon Feb 9 14:00:58 2009
@@ -1,4 +1,4 @@
-#perl -MFile::Slurp -MXML::Simple -MData::Dumper -e'print scalar Dumper ( XMLin( read_file(shift @ARGV).""))'
+#perl -MFile::Slurp -MXML::Simple -MData::Dumper -e'print scalar Dumper ( XMLin( read_file(shift @ARGV).""))'
# Usage
# --edit expects the output of svn log --xml as the first argument, and an intermediate
# file where we will be storing munged up xml that trags your tags and edits
@@ -16,215 +16,69 @@
use warnings;
use strict;
-use Term::ANSIScreen;
-use Text::Autoformat;
use YAML;
use File::Slurp;
use XML::Simple;
-use Term::ReadKey;
use Data::Dumper;
- use File::Temp qw/ tempfile tempdir /;
-my @tags = qw(doc install core plugin security view f-bug t-discard backward-compatibility-problem u-pubsub r-crud e-testing);
+use File::Temp qw/ tempfile tempdir /;
-my %tags = map { substr($_,0,1) => $_ } @tags;
-my $mode = shift @ARGV;
-my ($source,$dest);
-if ($mode eq '--generate') {
- $source = shift @ARGV;
- $dest = shift @ARGV;
-
-}
-elsif ($mode eq '--edit') {
- $source = shift @ARGV;
- $dest = shift @ARGV;
-
-}
-
-unless ($source && -f $source && $dest) { die "$0 --generate SOURCEFILE DESTFILE\n or \n$0 --edit SOURCEFILE DESTFILE" }
+my ( $source, $dest );
+ $source = shift @ARGV;
+ $dest = shift @ARGV;
-my $data = XMLin(read_file($source)."");
+unless ( $source && -f $source && $dest ) { die "$0 SOURCEFILE DESTFILE\n" }
+my $data = XMLin( read_file($source) . "" );
-if ($mode eq '--edit') {
-
- my $count;
- my $total;
- my %entries;
- foreach my $entry (@{$data->{'logentry'}}) {
- $total++;
- push @{$entries{$entry->{section}||'uncategorized'}}, $entry;
- }
-# iterate over the uncategorized ones first
- my $uncat_total = @{$entries{uncategorized}};
- foreach my $entry (@{$entries{uncategorized}}){
- $count++;
- act_on($entry, $count, $uncat_total);
- }
-# all of them in case you want to frob stuff
- print "All uncategorized changes complete, now iterating the full set\nHit any key to continue\n";
- getchar();
- $count = 0;
- foreach my $key ( keys %entries) {
- foreach my $entry (@{$entries{$key}}){
- $count++;
- act_on($entry, $count, $total);
- }
+ my %entries;
+ foreach my $entry ( @{ $data->{'logentry'} } ) {
+ push @{ $entries{ $entry->{section} || 'uncategorized' } }, $entry;
}
- do_quit();
-} elsif ($mode eq '--generate') {
- my %entries;
- foreach my $entry (@{$data->{'logentry'}}) {
- push @{$entries{$entry->{section}||'uncategorized'}}, $entry;
- }
+ open( my $fh, ">$dest" ) or die "Can't open $dest for writing";
- open (my $fh, ">$dest") or die "Can't open $dest for writing";
-
- foreach my $key (sort keys %entries) {
- my $title = $key;
- $title =~ s/^\w\-//;
- print $fh uc($key)."\n";
- print $fh "=" x length($key) ;
+ foreach my $key ( sort keys %entries ) {
+ my $title = $key;
+ $title =~ s/^\w\-//;
+ print $fh uc($key) . "\n";
+ print $fh "=" x length($key);
print $fh "\n\n";
- foreach my $entry (@{$entries{$key}}){
+ foreach my $entry ( @{ $entries{$key} } ) {
- print $fh format_entry($entry) ;
- print $fh "\n";
+ print $fh format_entry($entry);
+ print $fh "\n";
}
}
close $fh;
-}
-
-sub act_on {
- my $entry = shift;
- my $count = shift;
- my $total = shift;
-
- my $console = Term::ANSIScreen->new;
- while (1) {
- my $command = '';
- while (!$command) {
- $console->Cls;
- $console->Cursor(1,1);
-
-
- if (!$entry->{'edited_msg'} && ref($entry->{msg})) { $entry->{'edited_msg'} = Dumper($entry->{'msg'}); }
- print "change $count / $total\n";
- print format_entry($entry => 1);
-
-
- my $in = getchar();
-
-
- if ($in eq 's') {
- return;
- }
- elsif ($in eq 'c') { $command = 'chomp'; }
- elsif ($in eq 'e') { $command = 'edit'; }
- elsif ($in eq 'q') { $command = 'quit'; }
- elsif ($in eq 't') { $command = 'tag' }
- elsif ($in eq 'x') { $command = 'exclude' }
- elsif ($in eq ' ') {
- return
- }
- }
- if ($command eq 'tag') {
- tag($entry);
- }
- elsif ( $command eq 'write' ) {
- warn "Writing";
- } elsif ( $command eq 'chomp' ) {
- my $msg = ( $entry->{'edited_msg'} || $entry->{'msg'} );
- my @lines = split( "\n", $msg );
- shift @lines;
- $entry->{'edited_msg'} = join( "\n", @lines );
- } elsif ( $command eq 'edit' ) {
- warn "Chomping";
- my ( $fh, $filename ) = tempfile();
- print $fh ( $entry->{'edited_msg'} || $entry->{'msg'} ) || die $!;
- close $fh;
- system( ( $ENV{EDITOR} || 'vi' ), $filename );
- $entry->{'edited_msg'} = read_file($filename);
- } elsif ($command eq 'quit') {
- do_quit();
- } elsif ($command eq 'exclude') {
- $entry->{section} = 't-discard';
- }
-
- }
-
-}
-
-sub tag {
- my $entry = shift;
- my $tag;
- print "Valid tags are: " . join( ', ', @tags ) . "\n";
- while ( !$tag ) {
- my $key = getchar();
- return if ( $key eq ' ' );
- print "You picked " . $key . "\n";
- if ( $tags{$key} ) {
- $tag = $tags{$key};
- print "You tagged it $tag\n";
- } else {
- print "NO. THAT IS NOT A VALID TAG\n";
-
- }
- }
- $entry->{section} = $tag;
-
-}
-
-sub do_quit {
-my $out;
- open( $out, ">$dest" );
-
- print $out XMLout($data, NoAttr => 1 );
- close($out);
- exit;
-
-}
-
-sub getchar {
-
- ReadMode 4;
- my $key = ReadKey(0);
- ReadMode 0;
-
- return $key
-}
-
-
sub format_entry {
- my $entry = shift;
- my $verbose = shift ||0;
- my $text = '';
- if ($verbose ) {
- $text .= "r".$entry->{revision}." - ";
- $text .= $entry->{'section'} || "UNCATEGORIZED - HIT 't'";
- $text .= "\n".("="x60)."\n";
+ my $entry = shift;
+ my $verbose = shift || 0;
+ my $text = '';
+ if ($verbose) {
+ $text .= "r" . $entry->{revision} . " - ";
+ $text .= $entry->{'section'} || "UNCATEGORIZED - HIT 't'";
+ $text .= "\n" . ( "=" x 60 ) . "\n";
}
- my $msg = ( $entry->{'edited_msg'} || $entry->{'msg'});
+ my $msg = ( $entry->{'edited_msg'} || $entry->{'msg'} );
- if ($msg =~ /^[\s\*]*\w/) {
+ if ( $msg =~ /^[\s\*]*\w/ ) {
$msg =~ s/^[\s\*]*/ * /;
}
- $msg =~ s/\n+$//g;
- $msg .= " - ".$entry->{'author'}."\n";
+ $msg =~ s/\n+$//g;
+ $msg .= " - " . $entry->{'author'} . "\n";
-
- $msg = autoformat ($msg, { left=>0, right=>78 });
- $msg =~ s/\n+$//g;
- $text .= $msg."\n";
- if ($verbose ) {
- $text .= YAML::Dump( $entry->{'paths'});
- $text .= "\n";
- }
- return $text;
+ $msg = autoformat( $msg, { left => 0, right => 78 } );
+ $msg =~ s/\n+$//g;
+ $text .= $msg . "\n";
+ if ($verbose) {
+ $text .= YAML::Dump( $entry->{'paths'} );
+ $text .= "\n";
+ }
+ return $text;
}
Modified: App-Changelogger/bin/sort-changelog
==============================================================================
--- App-Changelogger/bin/sort-changelog (original)
+++ App-Changelogger/bin/sort-changelog Mon Feb 9 14:00:58 2009
@@ -14,6 +14,7 @@
q => sub { die "Quitting.\n" },
e => \&edit_entry,
s => \&split_entry,
+ w => \&web_view,
t => \&next_tag,
);
@@ -78,9 +79,88 @@
$| = 1;
# read data
-my $data = XMLin(read_file($in)."");
+my $data = read_changelog($in);
-my @entries =
+sub read_changelog {
+ my $in = shift;
+ if ($in =~ /.git$/) {
+ return read_git_log($in);
+ } else {
+ return XMLin(read_file($in)."");
+ }
+}
+
+
+sub read_git_log {
+ my $in = shift;
+ my @git_entries;
+ open(my $infile, "<",$in) ||die $!;
+ my @stanza;
+ for my $line (<$infile>) {
+ if ($line =~ /^commit /) {
+ my $last_stanza = hashify_git_stanza(@stanza);
+ push @git_entries, $last_stanza if ($last_stanza->{commit_id}); # skip the initial blank this would trigger on
+
+
+ @stanza = ($line);
+ } else {
+ push @stanza, $line;
+ }
+ }
+ my $last_stanza = hashify_git_stanza(@stanza);
+ push @git_entries , $last_stanza;
+
+ return { logentry => \@git_entries};
+}
+
+=begin git-sample
+commit 8837a66df7e8959d3101a5227d7b3c597990c0d0
+Author: Nicholas Clark <nick at ccl4.org>
+AuthorDate: Tue Dec 2 20:16:33 2008 +0000
+Commit: David Mitchell <davem at iabyn.com>
+CommitDate: Wed Jan 28 00:05:55 2009 +0000
+
+ Codify the current behaviour of evals which define subroutines before
+ failing (due to syntax errors).
+
+ p4raw-id: //depot/perl at 34984
+
+ (cherry picked from commit 99d3381e871dbd1d94b47516b4475d85b3935ac6)
+
+ t/comp/retainedlines.t | 23 ++++++++++++++++++++++-
+ 1 files changed, 22 insertions(+), 1 deletions(-)
+=cut
+
+
+sub hashify_git_stanza {
+ my @lines = (@_);
+ my $content = join('', at lines);
+ my $stanza = {};
+ if ($content =~ /^commit (.*)$/im) {
+ $stanza->{commit_id} = $1;
+ }
+ if ($content =~ /^Author:\s*(.*)$/im) {
+ $stanza->{author} = $1;
+ }
+ if ($content =~ /^AuthorDate:\s*(.*)$/im) {
+ $stanza->{date} = $1;
+ }
+ if ($content =~ /^Commit:\s*(.*)$/im) {
+ $stanza->{commit} = $1;
+ }
+ if ($content =~ /^CommitDate:\s*(.*)$/im) {
+ $stanza->{commit_date} = $1;
+ }
+
+ if ($content =~ /.*?^(\s{4}.*)^\s{2}\w/ims) {
+ $stanza->{msg} = $1;
+ }
+ if ($content =~ /\n(\s{2}\w.*)$/ims) {
+ $stanza->{changed_files} = $1;
+ }
+ return $stanza;
+}
+our @entries =
# sort by tag
sort { ($a->{section}||'') cmp ($b->{section}||'') }
@@ -98,7 +178,7 @@
# count untagged entries
$untagged = grep { ($_->{section}||'') eq '' } @entries;
-munge_entries();
+munge_entries(@entries);
# make sure we always print our output out
END { write_entries() }
@@ -112,6 +192,7 @@
}
sub munge_entries {
+ my @entries = (@_);
$_ = 0;
while (1) {
@@ -146,16 +227,21 @@
$term->Cursor(0, 0);
print "Number: $_/$#entries ($untagged untagged)\n";
+ print "SHA1: $entry->{commit_id}\n" if ($entry->{commit_id});
print "Author: $entry->{author}\n";
print "Date: $entry->{date}\n";
+ print "Committed by ".$entry->{commit}. "\n\t ( ".$entry->{commit_date}.
+ " )\n" if (exists $entry->{commit});
print "Tagged as: ", $entry->{section} || '(none)', "\n";
print "-" x 79, "\n";
print $entry->{msg}, "\n\n";
+ print "-" x 79,"\n".$entry->{changed_files} if (exists $entry->{changed_files});
+
}
sub reformat_message {
my $msg = shift;
-
+ return 'No message for this commit?' unless ($msg);
# try to kill svn header
$msg =~ s/^\s*r\d+\@\S+:\s*\S+\s*\|\s*.*\n//;
@@ -176,6 +262,11 @@
$entry->{msg} = reformat_message(invoke_editor($entry->{msg}));
}
+sub web_view {
+ my $entry = shift;
+ `open "http://perl5.git.perl.org/perl.git/commit/@{[$entry->{commit_id}]}"&`
+}
+
sub split_entry {
my $entry = shift;
More information about the Bps-public-commit
mailing list