add script to read root histograms via web interface to Perl

(JM)

diff --git a/analysis/lib/getrootjson.pm b/analysis/lib/getrootjson.pm
new file mode 100755 (executable)
index 0000000..d508b06
--- /dev/null
+++ b/analysis/lib/getrootjson.pm
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use LWP::Simple qw(get);
+use JSON qw( decode_json encode_json ); 
+use Data::Dumper;
+use CGI qw(:standard);
+
+if (defined $ENV{QUERY_STRING}) {
+ print Dumper  getroothist($ENV{QUERY_STRING});
+ }
+ 
+ 
+#Example URL:  #http://jspc37:9999/Histograms/TRB_A000/A000/A000_Matrix/exe.json?method=Reset
+
+
+
+#######################################
+##  Retrieve histogram as json
+#######################################
+
+sub getroothist {
+  my ($name,$src) = @_;
+  
+  $src //= '';
+
+  my $baseurl = "http://jspc37:9999/";  #the standard analysis go4
+  if($src eq 'double') {$baseurl = 'http://jspc37:8080/';} #"doublesensor" test for correlations
+
+
+  my $rawdata = get ($baseurl.$name."/root.json");
+
+  my $data;
+  
+  if (defined $rawdata) {
+    $data = decode_json($rawdata);
+    
+    if($data->{'_typename'} =~ /^TH1/)   {
+      $data->{"underflow"} = $data->{fArray}[0];
+      $data->{"overflow"}  = $data->{fArray}[-1];
+      @{$data->{"bins"}} = splice(@{$data->{"fArray"}},1,-1);
+      
+      }
+
+    if($data->{'_typename'} =~ /^TH2/)   {
+      my $d;
+      foreach my $y (1..$data->{fYaxis}{fNbins}) {
+        my $offset = $y*($data->{fXaxis}{fNbins}+2);
+        foreach my $x (1..$data->{fXaxis}{fNbins}) {
+          $d->[$x-1][$y-1] = $data->{fArray}[$x+$offset];
+          }
+        }
+    #   foreach my $x (1..$data->{nbins1}) {    
+    #     $data->{underflow}{x}[$x] = $data->{bins}[7+$x];
+    #     $data->{overflow}{x}[$x]  = $data->{bins}[-($data->{nbins1}+$x-2)];
+    #     }
+        
+      $data->{bins} = $d;
+      }
+    return $data;
+    }
+  }  
+
+  
+  
+#######################################
+##  Reset a histogram
+#######################################
+  
+sub resetroothist {
+  my ($name,$src) = @_;
+  
+  $src //= '';
+
+  my $baseurl = "http://jspc37:9999/";  #the standard analysis go4
+  if($src eq 'double') {$baseurl = 'http://jspc37:8080/';} #"doublesensor" test for correlations
+
+
+  my $rawdata = get ($baseurl.$name."/exe.json?method=Reset");
+  
+  }
+
+  
+1;