add tool to read a register to json

diff --git a/web/htdocs/tools/daq2json.pl b/web/htdocs/tools/daq2json.pl
new file mode 100755 (executable)
index 0000000..caea1d4
--- /dev/null
+++ b/web/htdocs/tools/daq2json.pl
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+
+use warnings;
+use POSIX qw(strftime);
+use FileHandle;
+use HADES::TrbNet;
+use Time::HiRes qw(usleep);
+use JSON::XS;
+use Data::Dumper;
+use List::Util qw(min max);
+use Scalar::Util qw(looks_like_number);
+binmode(STDOUT, "encoding(UTF-8)");
+
+$ENV{'DAQOPSERVER'}="hadesp31" unless (defined $ENV{'DAQOPSERVER'});
+trb_init_ports() or die trb_strerror();
+
+my @args = split('-',$ENV{'QUERY_STRING'});
+
+my $addr = 0xffff;
+my $reg  = 0;
+my $start = 20;
+my $end = 31;
+my $scale = 0.0625;
+my $opt = '';
+
+if ($args[0] =~ /0x([0-9a-fA-F]{4})/) {
+  $addr = hex($1);
+  }
+if ($args[1] =~ /0x([0-9a-fA-F]{4})/) {
+  $reg = hex($1);
+  }
+if($args[2] < 32 && $args[2] >= 0) {
+  $start = $args[2];
+  }
+if($args[3] < 32 && $args[3] >= 0 && $args[3] >= $start) {
+  $end = $args[3];
+  }
+if(looks_like_number($args[4])) {
+  $scale = $args[4];
+  }
+if($args[5]) {
+  $opt = $args[5];
+  }
+  
+my $mask = 2**($end-$start+1)-1;  
+  
+print "Cache-Control: no-cache, must-revalidate, max-age=1\r\n";
+print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\r\n";
+print "Content-type: application/json\r\n\r\n";
+
+my ($min,$max) = (0xffffffff,0);
+
+if($opt =~ /^(\d+)$/) {
+  my $len = $1;
+  my $read = trb_register_read_mem($addr, $reg,0,$len);
+
+  if ($read) {
+    foreach my $b (keys %{$read}) {
+      my $bs = sprintf("0x%04x",$b);
+      for my $i (0..$len-1) {
+        my $s = (($read->{$b}[$i]>>$start) & $mask)*$scale;
+        $min = $s if $s < $min;
+        $max = $s if $s > $max;
+        $data->{$bs}{$i}=$s;
+        }
+      }
+    }
+  }
+elsif($opt =~ /^rate(\d+)$/) {
+  my $len = $1;
+  my $read = trb_register_read_mem($addr, $reg,0,$len);
+  sleep 1;
+  my $read2 = trb_register_read_mem($addr, $reg,0,$len);
+
+  if ($read) {
+    foreach my $b (keys %{$read}) {
+      my $bs = sprintf("0x%04x",$b);
+      for my $i (0..$len-1) {
+        my $s = (($read2->{$b}[$i]>>$start) & $mask)*$scale - (($read->{$b}[$i]>>$start) & $mask)*$scale;
+        $s += 2**($end-$start+1) if ($s < 0); 
+        $min = $s if $s < $min;
+        $max = $s if $s > $max;
+        $data->{$bs}{$i}=$s;
+        }
+      }
+    }
+  }
+elsif($opt =~ /^ratesum(\d+)$/) {
+  my $len = $1;
+  my $read = trb_register_read_mem($addr, $reg,0,$len);
+  sleep 1;
+  my $read2 = trb_register_read_mem($addr, $reg,0,$len);
+
+  if ($read) {
+    foreach my $b (keys %{$read}) {
+      my $t = 0;
+      for my $i (0..$len-1) {
+        my $s = (($read2->{$b}[$i]>>$start) & $mask)*$scale - (($read->{$b}[$i]>>$start) & $mask)*$scale;
+        $s += 2**($end-$start+1) if ($s < 0); 
+        $t += $s;
+        }
+      $min = $t if $t < $min;
+      $max = $t if $t > $max;
+      my $s = sprintf("0x%04x",$b);
+      $data->{$s}=$t;
+      }
+    }
+  }
+elsif($opt =~ /^sum(\d+)$/) {
+  my $len = $1;
+  my $read = trb_register_read_mem($addr, $reg,0,$len);
+
+  if ($read) {
+    foreach my $b (keys %{$read}) {
+      my $t = 0;
+      for my $i (0..$len-1) {
+        my $s = (($read->{$b}[$i]>>$start) & $mask)*$scale;
+        $t += $s;
+        }
+      $min = $t if $t < $min;
+      $max = $t if $t > $max;
+      my $s = sprintf("0x%04x",$b);
+      $data->{$s}=$t;
+      }
+    }
+  }
+else {
+  my $read = trb_register_read($addr, $reg);
+  if ($read) {
+    foreach my $b (keys %{$read}) {
+      my $t = (($read->{$b}>>$start) & $mask)*$scale;
+      $min = $t if $t < $min;
+      $max = $t if $t > $max;
+      my $s = sprintf("0x%04x",$b);
+      $data->{$s}=$t;
+      }
+    }
+  }
+  
+  
+$data->{max} = $max;
+$data->{min} = $min;
+  
+my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
+my @days = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
+my ($sec,$minute,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
+my $updatetime = sprintf("%03s, %02d %s %04d  -  %02d:%02d:%02d",$days[$wday], $mday, $months[$mon], 1900 + $year, $hour, $minute, $sec);
+
+$data->{updatetime} = $updatetime;
+$data->{symbol} = "";
+$data->{title} = sprintf("0x%04x 0x%04x(%i..%i)/%f",$addr,$reg,$start,$end,$scale);#$ENV{'QUERY_STRING'};#
+
+print encode_json($data);
+
+1;
+  
+