[svn:parrot] r44962 - trunk/tools/dev

[coke at svn.parrot.org]

Author: coke
Date: Tue Mar 16 16:04:31 2010
New Revision: 44962
URL: https://trac.parrot.org/parrot/changeset/44962

Log:
generate wiki friendly output by default.
Keep old version available with -H for now.

Modified:
   trunk/tools/dev/branch_status.pl

Modified: trunk/tools/dev/branch_status.pl
==============================================================================
--- trunk/tools/dev/branch_status.pl	Tue Mar 16 15:17:14 2010	(r44961)
+++ trunk/tools/dev/branch_status.pl	Tue Mar 16 16:04:31 2010	(r44962)
@@ -10,9 +10,10 @@
 
 Generate a report to help developers determine status of repository branches.
 
-This program uses modules that are not intended to be parrot requirements.
+Defaults to generating wiki-friendly output. Override to human readable
+output with C<-H>.
 
-Prerequisites:  Perl 5.10; XML::Twig; Perl6::Form.
+This program uses modules that are not intended to be parrot requirements.
 
 Assumes that you have a command line svn in your path, but doesn't have
 to be run in a working copy.
@@ -23,13 +24,28 @@
 use strict;
 use warnings;
 
-use XML::Twig;
 use Perl6::Form;
+use Time::Format qw(%time);
+use XML::Twig;
+
+my $human;
+$human = 1 if @ARGV && $ARGV[0] eq '-H';
+
+my $time_format = 'dd Mon yyyy - hh:mm:ss';
 
 my $repo = 'https://svn.parrot.org/parrot/';
 
 my @branches = map {chomp; chop; $_} `svn ls $repo/branches`;
 
+if (!$human) {
+    print '||';
+    say join ('||', map { "'''$_'''" } qw (
+        Branch Revisions Creator Authors Created
+        Updated Components Commits LastMergeRev
+    ));
+} 
+
+
 foreach my $branch (@branches) {
     my $t = XML::Twig->new();
     my $xml = `svn log --stop-on-copy --xml -v $repo/branches/$branch`;
@@ -39,39 +55,50 @@
     my $oldest = $t->root->last_child('logentry');
     my $creator = $oldest->first_child('author')->xml_text;
 
-    my (%authors,%components);
-    my $merge_log;
+    my (%authors, %components, $merge_log, $merge_rev, $author_txt);
+
     foreach my $entry ($t->root->children('logentry')) {
-            $authors{$entry->first_child('author')->xml_text}++;
-            my $msg = $entry->first_child('msg')->xml_text;
-            $msg =~ s/\s+$//;
-            $msg =~ s/^\s+//;
-            if (!defined($merge_log) && $msg =~ /merge/i) {
-                    $merge_log = $msg;
-            }
-            while ($msg =~ m/\[(.+?)\]/g) {
-                    my $component = $1;
-                    $component =~ s/\s+$//;
-                    $component =~ s/^\s+//;
-                    if ($component ne '') {
-                            $components{$1} = undef;
-                    }
-            }
+        $authors{$entry->first_child('author')->xml_text}++;
+        my $msg = $entry->first_child('msg')->xml_text;
+        $msg =~ s/\s+$//;
+        $msg =~ s/^\s+//;
+        if (!defined($merge_log) && $msg =~ /merge/i) {
+            $merge_log = $msg;
+            $merge_rev = 'r' . $entry->atts->{revision};
+        }
+        while ($msg =~ m/\[(.+?)\]/g) {
+            my $component = $1;
+            $component =~ s/\s+$//;
+            $component =~ s/^\s+//;
+            if ($component ne '') {
+                $components{$1} = undef;
+                }
+        }
     }
     $merge_log //= 'N/A';
+    $merge_rev //= 'N/A';
+
+    my $first = $oldest->atts->{revision};
+    my $last  = $newest->atts->{revision};
+
+    my $revisions_human = "r$first:$last";
+    my $revisions_wiki  = "r$first-r$last";
 
-    my $revisions =  'r' .$oldest->atts->{revision} . ':' .
-        $newest->atts->{revision};
     my $created_date = $oldest->first_child('date')->xml_text;
+    $created_date =~ s/Z//; # workaround Time::Format bug
+    $created_date = $time{$time_format, $created_date};
     my $updated_date = $newest->first_child('date')->xml_text;
-    my $author_txt = '';
+    $updated_date =~ s/Z//; # workaround Time::Format bug
+    $updated_date = $time{$time_format, $updated_date};
+
     if (scalar keys %authors != 1) {
         my @counts;
         foreach my $author (sort {$authors{$b} <=> $authors{$a}} keys %authors) {
-            push @counts, "$author [$authors{$author}]";
+            push @counts, $author . "($authors{$author})";
         }
-        $author_txt = join (', ', @counts);
+        $author_txt = join ($human ? ', ' : '[[BR]]', @counts);
     }
+    $author_txt //='';
     my $components = join (', ', sort {lc $a cmp lc $b} keys %components);
     my $number_commits = scalar $t->root->children('logentry');
     my $initial_log = $oldest->first_child('msg')->xml_text;
@@ -80,13 +107,13 @@
     $merge_log =~ s/\n/ /g;
     $initial_log =~ s/\n/ /g;
 
-
-    print form
+    if ($human) {
+        print form
 '+====================================================================+',
 '|        branch: {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<} |',
                   $branch,
 '|     revisions: {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<} |',
-                  $revisions,
+                  $revisions_human,
 '|       creator: {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<} |',
                   $creator,
 ($author_txt ne '') ?
@@ -108,9 +135,17 @@
 {bullet => 'last merge log:'},
 '|last merge log: {[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[} |',
                   $merge_log;
+    }
+    else {
+        say join('||','',
+            "[source:/branches/$branch $branch]", $revisions_wiki, $creator,
+            $author_txt, $created_date, $updated_date, $components,
+            "[log:/branches/$branch $number_commits]", $merge_rev
+        );
+    }
 }
 
-say '+', '=' x 68, '+';
+say '+', '=' x 68, '+' if $human;
 
 # Local Variables:
 #   mode: cperl