From: Jan Michel <j.michel@gsi.de>
Date: Thu, 5 Dec 2013 17:06:10 +0000 (+0100)
Subject: added scaler display and made xmlpage able to access different get scripts
X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=3426816d46c01f4d8f00b03bcd6f1b38a2e2e030;p=daqtools.git

added scaler display and made xmlpage able to access different get scripts
---

diff --git a/web/htdocs/commands/xmlpage.pm b/web/htdocs/commands/xmlpage.pm
index 841f14d..200394f 100644
--- a/web/htdocs/commands/xmlpage.pm
+++ b/web/htdocs/commands/xmlpage.pm
@@ -4,12 +4,11 @@ package xmlpage;
 
 my $active = 0;
 my @setup;
-
+our $getscript;
 
 sub initPage {
   my ($ref_setup,$page) = @_;
   @setup = @$ref_setup;
-  
   my ($command,$style) = split("-",$ENV{'QUERY_STRING'});
   $command = "" unless defined $command;
   $style   = ""  unless defined $style;
@@ -25,6 +24,10 @@ sub initPage {
   my $name = $setup[$active]->{name};
   my ($cmdMod,$cmdAddr,$cmdReg) = split('-',$setup[$active]->{cmd});
 
+  $getscript = $page->{getscript};
+  if(!defined $getscript) {
+    $getscript = "../xml-db/get.pl";
+    }
   
   print <<EOF;
 <HTML>
@@ -81,6 +84,7 @@ print <<EOF ;
 </BODY>
 </HTML>
 EOF
+
 }
 
 
@@ -95,6 +99,7 @@ sub printJavaScripts {
 <script language="javascript" src="../scripts/scriptsnew.js"></script>
 <script language="javascript" src="../scripts/xmlpage.js"></script>
 <script language="javascript">
+  GETCOMMAND = "$getscript";
   var period = |.$setup[$n]->{period}.qq|;
   var command="|.$setup[$n]->{cmd}.qq|";
   var Timeoutvar;
diff --git a/web/htdocs/layout/blue.css b/web/htdocs/layout/blue.css
index 8427360..c88b907 100644
--- a/web/htdocs/layout/blue.css
+++ b/web/htdocs/layout/blue.css
@@ -349,3 +349,18 @@ table.queryresult th div, table.queryresult td div {
   position:relative;
   cursor:default;
 }
+
+.scalers td:nth-child(2){
+  min-width:160px;
+/*   font-family:monospace; */
+  }
+  
+.scalers td:nth-child(3),.scalers td:nth-child(1){
+  min-width:100px;
+  text-align:left;
+/*   font-family:monospace; */
+  }
+
+.scalers tr:first-child {
+  border-bottom:1px solid #555;
+  }
\ No newline at end of file
diff --git a/web/htdocs/scripts/xmlpage.js b/web/htdocs/scripts/xmlpage.js
index 1061621..ea5724c 100644
--- a/web/htdocs/scripts/xmlpage.js
+++ b/web/htdocs/scripts/xmlpage.js
@@ -12,15 +12,15 @@
     
   function refresh(time = 0) {
     if(time == -1) {  //call immediately and only once
-      getdataprint('../xml-db/get.pl?'+command,'content',false,0);
+      getdataprint(GETCOMMAND+'?'+command,'content',false,0);
       }
     else if (time > 0) { //call with timeout
       clearTimeout(Timeoutvar);
-      Timeoutvar = setTimeout("getdataprint('../xml-db/get.pl?'+command,'content',false,"+period+",refresh)",period);
+      Timeoutvar = setTimeout("getdataprint(GETCOMMAND+'?'+command,'content',false,"+period+",refresh)",period);
       }
     else {  //call immediately, then with timeout
       clearTimeout(Timeoutvar);
-      getdataprint('../xml-db/get.pl?'+command,'content',false,period,refresh);
+      getdataprint(GETCOMMAND+'?'+command,'content',false,period,refresh);
       }
     }
   
diff --git a/web/htdocs/tools/scaler.pl b/web/htdocs/tools/scaler.pl
new file mode 100755
index 0000000..ea1bf6d
--- /dev/null
+++ b/web/htdocs/tools/scaler.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+use HADES::TrbNet;
+use Storable qw(lock_store lock_retrieve);
+use CGI::Carp qw(fatalsToBrowser);
+use Data::TreeDumper;
+
+use lib qw|../commands htdocs/commands|;
+use xmlpage;
+
+my $olddata, my $t;
+
+$ENV{'DAQOPSERVER'}="localhost:0" unless (defined $ENV{'DAQOPSERVER'});
+die "can not connect to trbnet-daemon on $ENV{'DAQOPSERVER'}: ".trb_strerror() unless (defined &trb_init_ports());
+
+###############################
+#### The content
+###############################
+if($ENV{'QUERY_STRING'} =~ /get/) {
+  &htsponse(200, "OK");
+  print "Content-type: text/html\r\n\r\n";
+
+  my $q = $ENV{'QUERY_STRING'};
+  if(-e "/tmp/scalers.$q.store") {
+    $olddata = lock_retrieve("/tmp/scalers.$q.store");
+    }
+
+  my $data = trb_registertime_read_mem(0x3820,0xc001,0,64) or die trb_strerror();
+  my $delay = ($data->{0x3820}->{time}->[0]||0) - ($olddata->{0x3820}->{time}->[0]||0);
+  $delay += 0x10000 if ($delay < 0);
+  $delay *= 16.;
+  $delay = 1E6 if $delay == 0;
+
+  my $rate;
+  for(my $i = 0; $i<64;$i++) {
+    $rate->[$i] = (($data->{0x3820}->{value}[$i]||0) & 0x00ffffff) - (($olddata->{0x3820}->{value}[$i]||0) & 0x00ffffff);
+    $rate->[$i] += 0x01000000 if ($rate->[$i] < 0);
+    $rate->[$i] = $rate->[$i] / ($delay/1E6); 
+    }
+
+  my @dat = $data->{0x3820}->{value};
+
+  for(my $i = 0; $i < 4; $i++) {
+    my $sum = 0;
+    for(my $j=0;$j<4;$j++) {
+      $sum += $rate->[2*$j+8+$i*16];
+      }
+    print "<div><hr class=\"queryresult\"><table class='queryresult scalers'><tr>";
+    $t  = sprintf("<tr><td><b>Diamond $i</b>");
+    $t .= sprintf("<td>%d<td>Sum",$sum);
+    for(my $j=0;$j<4;$j++) {
+      $t .= sprintf("<tr><td>INP %d<td title=\"%d\">%d",$j+4+$i*8,$data->{0x3820}->{value}[2*$j+8+$i*16],$rate->[2*$j+8+$i*16]);
+      $t .= sprintf("<td>(%.1f%%)",$rate->[2*$j+8+$i*16]/($sum||1E334)*100);
+      }
+    $t =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/&#8198;/g; 
+    print $t;
+    print "</table></div>\n";
+    }
+
+
+  printf("<hr class=\"queryresult\"><p>Time between last two readings (mod 1.6s) %d ms",$delay/1000.);
+
+  lock_store($data,"/tmp/scalers.$q.store");
+  }
+
+
+###############################
+#### The page
+###############################
+else {
+  &htsponse(200, "OK");
+  print "Content-type: text/html\r\n\r\n";
+
+  my $page;
+  $page->{title} = "Diamond Scaler Display";
+  $page->{link}  = "../";
+  $page->{getscript} = "scaler.pl";
+
+
+  my @setup;
+  $setup[0]->{name}    = "Scalers";
+  $setup[0]->{cmd}     = "get".time();
+  $setup[0]->{period}  = 1000;
+  $setup[0]->{generic} = 0;
+
+
+  xmlpage::initPage(\@setup,$page);
+  }
\ No newline at end of file
diff --git a/xml-db/get.pl b/xml-db/get.pl
index 9b55be6..e66e57a 100755
--- a/xml-db/get.pl
+++ b/xml-db/get.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 use HADES::TrbNet;
-use Storable qw(lock_retrieve);
+use Storable qw(lock_store lock_retrieve);
 use feature "switch";
 use CGI::Carp qw(fatalsToBrowser);
 
@@ -18,7 +18,7 @@ my $verbose = 0;
 my $isbrowser = 0;
 my $server = $ENV{'SERVER_SOFTWARE'} || "";
 my @request;
-my ($file,$entity,$netaddr,$name, $style);
+my ($file,$entity,$netaddr,$name, $style, $storefile);
 
 
 $ENV{'DAQOPSERVER'}="localhost:7" unless (defined $ENV{'DAQOPSERVER'});
@@ -57,6 +57,7 @@ foreach my $req (@request) {
       ($entity,$netaddr,$name,$style) = split("-",$req);
       $file = "$RealBin/cache/$entity.entity";
       }
+    $storefile = "/tmp/".$ENV{'QUERY_STRING'}.".store";
     }
   else {
   #   use FindBin qw($RealBin);
@@ -101,6 +102,12 @@ foreach my $req (@request) {
 
   $db = lock_retrieve($file);
   die "Unable to read cache file\n" unless defined $db;
+  
+  if($rates) {
+    if(-e $storefile) {
+      my $olddata = lock_retrieve($storefile);
+      }
+    }
 
   die "Name not found in entity file\n" unless(exists $db->{$name});
 
@@ -111,6 +118,9 @@ foreach my $req (@request) {
   if ($isbrowser) {
     requestdata($db->{$name},$name,$slice);
     generateoutput($db->{$name},$name,$slice,$once);
+    if($rates) {
+      store_lock($data,$storefile);
+      }
     }
   else {
     runandprint($db->{$name},$name,$slice,$once);
@@ -196,7 +206,7 @@ sub FormatPretty {
       when ("bitmask")  {$ret = sprintf("%0".$obj->{bits}."b",$value);}
       when ("time")     {require Date::Format; $ret = Date::Format::time2str('%Y-%m-%d %H:%M',$value);}
       when ("hex")      {$ret = sprintf("0x%0".int(($obj->{bits}+3)/4)."x",$value);}
-      when ("enum")     { my $t = sprintf("%x",$value);
+      when ("e1num")     { my $t = sprintf("%x",$value);
                           if (exists $obj->{enumItems}->{$t}) {
                             $ret = $obj->{enumItems}->{$t} 
                             }
@@ -418,7 +428,7 @@ sub runandprint {
         }
       
       #### Show the beautiful result...
-      if($isbrowser == 0) {
+      if($isb1rowser == 0) {
         print $t->render;
         }
       else {
