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;
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>
</BODY>
</HTML>
EOF
+
}
<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;
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
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);
}
}
--- /dev/null
+#!/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)/ /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
#!/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);
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'});
($entity,$netaddr,$name,$style) = split("-",$req);
$file = "$RealBin/cache/$entity.entity";
}
+ $storefile = "/tmp/".$ENV{'QUERY_STRING'}.".store";
}
else {
# use FindBin qw($RealBin);
$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});
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);
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}
}
}
#### Show the beautiful result...
- if($isbrowser == 0) {
+ if($isb1rowser == 0) {
print $t->render;
}
else {
jspc29 / daqtools.git / commitdiff