[Bps-public-commit] r9691 - in App-Changelogger: bin
sartak at bestpractical.com
sartak at bestpractical.com
Fri Nov 16 14:42:58 EST 2007
Author: sartak
Date: Fri Nov 16 14:42:58 2007
New Revision: 9691
Added:
App-Changelogger/Makefile.PL
App-Changelogger/bin/
App-Changelogger/bin/generate-changelog
App-Changelogger/bin/sort-changelog (contents, props changed)
Modified:
App-Changelogger/ (props changed)
Log:
r45260 at onn: sartak | 2007-11-16 14:42:21 -0500
Initial import. Will work on this more after Jifty comes out
Added: App-Changelogger/Makefile.PL
==============================================================================
--- (empty file)
+++ App-Changelogger/Makefile.PL Fri Nov 16 14:42:58 2007
@@ -0,0 +1,19 @@
+name 'App-Changelogger';
+all_from 'lib/App/Changelogger.pm';
+
+requires 'Term::ANSIScreen';
+requires 'Text::Autoformat';
+requires 'YAML';
+requires 'File::Slurp';
+requires 'XML::Simple';
+requires 'Term::ReadKey';
+requires 'Data::Dumper';
+requires 'File::Temp';
+requires 'Term::CallEditor';
+
+build_requires 'Test::More';
+
+auto_install;
+WriteAll;
+
+
Added: App-Changelogger/bin/generate-changelog
==============================================================================
--- (empty file)
+++ App-Changelogger/bin/generate-changelog Fri Nov 16 14:42:58 2007
@@ -0,0 +1,230 @@
+#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
+# --generate expects the intermediate file as the first argument and a plaintext
+# changelog file as the second argument. This changelog file is clobbered
+#
+# svn log --limit=100 --xml >> changelog.xml
+# generate-changelog --edit changelog.xml changelog.interim.xml
+# generate-changelog --generate changelog.interim.xml Changelog
+#
+# if you wish to do iterative editing, you can do
+# cp changelog.xml changelog.xml.orig
+# mv changelog.interim.xml changelog.xml
+# generate-changelog --edit changelog.xml changelog.interim.xml
+
+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);
+
+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 $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);
+ }
+ }
+
+ 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";
+
+ 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}}){
+
+ 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 $msg = ( $entry->{'edited_msg'} || $entry->{'msg'});
+
+ if ($msg =~ /^[\s\*]*\w/) {
+ $msg =~ s/^[\s\*]*/ * /;
+ }
+
+ $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;
+}
Added: App-Changelogger/bin/sort-changelog
==============================================================================
--- (empty file)
+++ App-Changelogger/bin/sort-changelog Fri Nov 16 14:42:58 2007
@@ -0,0 +1,204 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use File::Slurp;
+use XML::Simple;
+use Term::ReadKey;
+use Term::CallEditor;
+use Term::ANSIScreen;
+use Text::Autoformat;
+
+my %commands = (
+ j => sub { ++$_ },
+ k => sub { --$_ },
+ q => sub { die "Quitting.\n" },
+ e => \&edit_entry,
+ t => \&next_tag,
+);
+
+my %tags = (
+ D => 'doc',
+ I => 'install',
+ C => 'core',
+ P => 'plugin',
+ S => 'security',
+ T => 'testing',
+ V => 'view',
+ F => 'bugfix',
+ X => 'discard',
+ B => 'backward-compatibility-problem',
+ U => 'pubsub',
+ R => 'crud',
+ 8 => 'I18N',
+ M => 'misc',
+ Q => 'performance',
+);
+
+my $command_string = join '', sort keys %commands;
+my $tag_string = join '', sort keys %tags;
+my $untagged;
+
+# each tag gets its own command
+while (my ($k, $v) = each %tags) {
+ $commands{$k} = sub {
+ --$untagged if ($_[0]->{section}||'') eq ''; # update untagged count
+ $_[0]->{section} = $v; # apply tag
+ ++$_ # advance cursor
+ };
+}
+
+# other commands
+$commands{' '} = $commands{j};
+$commands{'?'} = sub {
+ print << "HELP";
+j - next entry
+k - previous entry
+q - write and quit
+e - edit entry
+t - find next entry with a different tag
+
+HELP
+ for (sort keys %tags) {
+ print "$_ - tag as $tags{$_}, next entry\n";
+ }
+
+ print "\nPress any key to continue.\n";
+ key();
+};
+
+# get the files
+ at ARGV == 2
+ or die "Usage: $0 in.xml out.yml";
+
+my $in = shift;
+my $out = shift;
+
+$| = 1;
+
+# read data
+my $data = XMLin(read_file($in)."");
+
+my @entries =
+ # sort by tag
+ sort { ($a->{section}||'') cmp ($b->{section}||'') }
+
+ # help find duplicate messages
+ sort { $a->{msg} cmp $b->{msg} }
+
+ # clean up incoming messages
+ map { $_->{msg} = reformat_message($_->{msg}); $_ }
+
+ # remove no-msg commits
+ grep { !ref($_->{msg}) }
+
+ @{$data->{logentry} || $data->{opt}};
+
+# count untagged entries
+$untagged = grep { ($_->{section}||'') eq '' } @entries;
+
+munge_entries();
+
+# make sure we always print our output out
+END { write_entries() }
+
+sub write_entries {
+ $data->{logentry} = \@entries;
+ open my $outfh, '>', $out
+ or die "Unable to open $out for writing: $!";
+ print $outfh XMLout($data, NoAttr => 1);
+ close $outfh;
+}
+
+sub munge_entries {
+ $_ = 0;
+
+ while (1) {
+ display($entries[$_]);
+
+ # ask the user what to do
+ print "Now what? [$command_string] [$tag_string] or ?: ";
+ my $c = key();
+
+ unless (exists $commands{$c}) {
+ warn "Invalid command '$c'. Press a key to continue.\n";
+ key();
+ next;
+ }
+
+ $commands{$c}->( $entries[$_] );
+
+ if ($_ < 0) {
+ $_ += @entries;
+ }
+ if ($_ >= @entries) {
+ $_ -= @entries;
+ }
+ }
+}
+
+sub display {
+ my $entry = shift;
+
+ my $term = Term::ANSIScreen->new;
+ $term->Cls();
+ $term->Cursor(0, 0);
+
+ print "Number: $_/$#entries ($untagged untagged)\n";
+ print "Author: $entry->{author}\n";
+ print "Date: $entry->{date}\n";
+ print "Tagged as: ", $entry->{section} || '(none)', "\n";
+ print "-" x 79, "\n";
+ print $entry->{msg}, "\n\n";
+}
+
+sub reformat_message {
+ my $msg = shift;
+
+ # try to kill svn header
+ $msg =~ s/^\s*r\d+\@\S+:\s*\S+\s*\|\s*.*\n//;
+
+ # autoformat
+ $msg = autoformat $msg;
+
+ # remove leading whitespace
+ $msg =~ s/(\n|^)\s+/$1/g;
+
+ # chomp off all newlines
+ 1 while chomp $msg;
+
+ return $msg;
+}
+
+sub edit_entry {
+ my $entry = shift;
+ my ($fh, $fn) = solicit($entry->{msg});
+ close $fh;
+ $entry->{msg} = do { local (@ARGV, $/) = $fn; <> };
+ $entry->{msg} = reformat_message($entry->{msg});
+}
+
+sub next_tag {
+ my $start = $_;
+ my $section = $_[0]->{section};
+
+ # wrap in eval just in case this logic screws up, the user can smash ^C and
+ # not kill everything
+ eval {
+ local $SIG{INT} = sub { die };
+ while (1) {
+ ++$_;
+ $_ -= @entries if $_ >= @entries;
+ last if $start == $_;
+ last if $entries[$_]->{section} ne $section;
+ }
+ }
+}
+
+sub key {
+ ReadMode 3;
+ my $c = ReadKey 0;
+ ReadMode 0;
+ print "$c\n";
+ return $c;
+}
+
More information about the Bps-public-commit
mailing list