[Bps-public-commit] RT-Extension-rt_cpan_org branch, master, updated. 0b2efe8a4e79e952eb6a932e0cc5ea1c8be4d0fd

[Thomas Sibley]

The branch, master has been updated
       via  0b2efe8a4e79e952eb6a932e0cc5ea1c8be4d0fd (commit)
       via  790fd0ce6c0a4ef26606619c2b7ff4ef357ace39 (commit)
      from  ff5399479b7af52d6332f8beeb65c57573cc4912 (commit)

Summary of changes:
 META.yml                       |  2 ++
 Makefile.PL                    |  2 ++
 bin/rt-cpan-bugs-per-dists     | 65 +++++++++++++++++++++++++++++++-----------
 html/Public/bugs-per-dist.json | 28 ++++++++++++++++++
 inc/Module/Install/RTx.pm      |  2 +-
 5 files changed, 82 insertions(+), 17 deletions(-)
 create mode 100644 html/Public/bugs-per-dist.json

- Log -----------------------------------------------------------------
commit 790fd0ce6c0a4ef26606619c2b7ff4ef357ace39
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Mon May 27 22:07:27 2013 -0700

    Update build toolchain

diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index abf6aea..c9fe996 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
 
 use Module::Install::Base;
 use base 'Module::Install::Base';
-our $VERSION = '0.30';
+our $VERSION = '0.31';
 
 use FindBin;
 use File::Glob     ();

commit 0b2efe8a4e79e952eb6a932e0cc5ea1c8be4d0fd
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Mon May 27 22:23:35 2013 -0700

    Provide the queue summary data in JSON

diff --git a/META.yml b/META.yml
index 59f776f..29e7f5b 100644
--- a/META.yml
+++ b/META.yml
@@ -25,6 +25,8 @@ requires:
   File::Remove: 0
   File::Spec: 0
   IO::Compress::Gzip: 0
+  JSON: 0
+  JSON::XS: 0
   perl: 5.8.3
 resources:
   license: http://opensource.org/licenses/gpl-license.php
diff --git a/Makefile.PL b/Makefile.PL
index 4a6a2ea..3930769 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,5 +12,7 @@ requires 'DBD::SQLite';
 requires 'IO::Compress::Gzip';
 requires 'File::Spec';
 requires 'File::Remove';
+requires 'JSON';
+requires 'JSON::XS';
 
 WriteAll();
diff --git a/bin/rt-cpan-bugs-per-dists b/bin/rt-cpan-bugs-per-dists
index 9d6e429..9581c51 100755
--- a/bin/rt-cpan-bugs-per-dists
+++ b/bin/rt-cpan-bugs-per-dists
@@ -3,11 +3,22 @@ use strict;
 use warnings;
 
 use List::Util "sum";
+use JSON "encode_json";
 
-eval { require RT; 1 } or do {
-    print STDERR "$@\n\nusage: perl -I /opt/rt4/local/lib -I/opt/rt4/lib $0 > results.tsv\n";
+eval { require RT; 1 } or usage($@);
+my $output = shift or usage("No output directory specified");
+
+usage("Output directory '$output' doesn't exist!")
+    unless -d $output;
+
+my $tsv  = "$output/bugs-per-dist.data";
+my $json = "$output/bugs-per-dist.data-json";
+
+sub usage {
+    print STDERR @_, "\n\n" if @_;
+    print STDERR "usage: perl -I /opt/rt4/local/lib -I/opt/rt4/lib $0 output-dir\n";
     exit 1;
-};
+}
 
 RT::LoadConfig();
 RT::Init();
@@ -37,26 +48,48 @@ my @active    = $lifecycle->Valid("initial", "active");
 my @inactive  = grep { $_ ne "deleted" } $lifecycle->Valid("inactive");
 my @statuses  = (@active, @inactive);
 
-my $date = `date`;
-chomp $date;
-print "# Generated on $date\n";
-print "# ", join("\t", "dist", @statuses, "active", "inactive"), "\n";
-
+my @data;
 my %buffer = ('dist' => '');
 while (my ($dist, $status, $count) = $sth->fetchrow_array) {
     if ( $buffer{dist} && $buffer{dist} ne $dist ) {
-        print_line();
+        push @data, { %buffer };
 
-        %buffer = ( dist => $dist, counts => { $status => $count } );
+        %buffer = ( dist => $dist, counts => { $status => $count + 0 } );
     } else {
         $buffer{dist} ||= $dist;
-        $buffer{counts}{ $status } = $count;
+        $buffer{counts}{ $status } = $count + 0; # force numeric context for JSON
+    }
+}
+push @data, { %buffer };
+
+for my $row (@data) {
+    $row->{counts}{$_} ||= 0 for @statuses;
+    $row->{counts}{"active"}   = sum @{ $row->{counts} }{ @active };
+    $row->{counts}{"inactive"} = sum @{ $row->{counts} }{ @inactive };
+}
+
+# Writing JSON before the TSV preserves numeric context destroyed by print()
+write_json(\@data);
+write_tsv(\@data);
+exit;
+
+sub write_tsv {
+    my $data = shift;
+    open my $fh,  ">", $tsv or die "unable to open $tsv for writing: $!";
+
+    my $date = `date`;
+    chomp $date;
+    print { $fh } "# Generated on $date\n";
+    print { $fh } "# ", join("\t", "dist", @statuses, "active", "inactive"), "\n";
+    for my $row (@$data) {
+        print { $fh } join("\t", $row->{dist}, @{ $row->{counts} }{ @statuses, "active", "inactive" } ), "\n";
     }
+    close $fh or die "couldn't close $tsv: $!";
 }
-print_line();
 
-sub print_line {
-    $buffer{counts}{"active"}   = sum map $_ || 0, @{ $buffer{counts} }{ @active };
-    $buffer{counts}{"inactive"} = sum map $_ || 0, @{ $buffer{counts} }{ @inactive };
-    print join("\t", $buffer{dist}, map $_ || 0, @{ $buffer{counts} }{ @statuses, "active", "inactive" } ), "\n";
+sub write_json {
+    my $data = shift;
+    open my $fh,  ">", $json or die "unable to open $json for writing: $!";
+    print { $fh } encode_json($data), "\n";
+    close $fh or die "couldn't close $json: $!";
 }
diff --git a/html/Public/bugs-per-dist.json b/html/Public/bugs-per-dist.json
new file mode 100644
index 0000000..508cf75
--- /dev/null
+++ b/html/Public/bugs-per-dist.json
@@ -0,0 +1,28 @@
+<%flags>
+inherit => undef
+</%flags>
+<%init>
+$r->content_type("application/json");
+
+my $fname = '';
+foreach my $test ( map "$_/Public/bugs-per-dist.data-json", map $_->[1], $m->interp->comp_root_array ) {
+    next unless -f $test;
+
+    $fname = $test;
+    last;
+}
+
+unless ( $fname ) {
+    RT->Logger->error("Couldn't find JSON data file");
+    $m->abort(404);
+}
+
+if ( open my $fh, "<", $fname ) {
+    binmode $fh;
+    local $/ = \(1024 * 10); # read in 10k chunks; the file is a single line
+    $m->out($_) while <$fh>;
+} else {
+    RT->Logger->error("Couldn't open JSON data file: $!");
+    $m->abort(404);
+}
+</%init>

-----------------------------------------------------------------------