From: hadaq@CountingHouse Date: Tue, 14 May 2013 14:52:34 +0000 (+0200) Subject: added files for Hmon X-Git-Tag: pre2018~140 X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=ee7252413ce6d26947f4c6a726cb6caeee10f23b;p=hadesdaq.git added files for Hmon --- diff --git a/hmon/HPlot.pm b/hmon/HPlot.pm new file mode 100644 index 0000000..0b4798e --- /dev/null +++ b/hmon/HPlot.pm @@ -0,0 +1,160 @@ +package HPlot; +use POSIX qw/floor ceil strftime/; +use Data::Dumper; +use warnings; +use strict; +use FileHandle; + +my $p; + +use constant {TYPE_HISTORY => 1}; + +use constant {OUT_PNG => 1, + OUT_SVG => 2, #n/a + OUT_SCREEN => 3}; #n/a + +my @color= ('#2222dd','#dd2222','#22dd22','#dd8822','#dd22dd','#22dddd'); + +sub plot_write { + my ($file,$str,$no) = @_; + return unless $str; + if($no || 0) { + print $file $str; + } + else { + print $file $str."\n"; + } + } + + +sub makeTimeString{ + return strftime("set label 100 \"%H:%M:%S\" at screen 0.02,0.02 left tc rgb \"#000044\" font \"monospace,8\"\n", localtime()) + } + + +sub PlotInit { + my ($c) = @_; + + my $name = $c->{name}; + + my $fn = "gnuplot"; + my $fh = new FileHandle ("|$fn") or die "error: no gnuplot"; + $fh->autoflush(1); + + + + $p->{$name} = $c; + $p->{$name}->{fh} = $fh; + $p->{$name}->{run} = 0; + $p->{$name}->{sizex} = $p->{$name}->{sizex} || 600 ; + $p->{$name}->{sizey} = $p->{$name}->{sizey} || 400 ; + $p->{$name}->{file} = $p->{$name}->{file} || "dummy" ; + $p->{$name}->{curves} = $p->{$name}->{curves} || 1 ; + $p->{$name}->{xscale} = $p->{$name}->{xscale} || 1; + $p->{$name}->{type} or die "No plot type specified"; + $p->{$name}->{output} or die "No destination specified"; + + @color = @{$p->{$name}->{colors}} if($p->{$name}->{colors}); + + foreach my $i (0..($c->{entries}-1)) { + for my $j (0..($c->{curves}-1)) { + push(@{$p->{$name}->{value}->[$j]},0) ; + } + } + + if($p->{$name}->{output} == OUT_PNG) { + $p->{$name}->{file} or die "No filename specified"; + plot_write($fh,"set term png size ".$p->{$name}->{sizex}.",".$p->{$name}->{sizey}." font \"monospace,8\""); + plot_write($fh,"set out \"".$p->{$name}->{file}.".png\""); + } + elsif($p->{$name}->{output} == OUT_SCREEN) { + plot_write($fh,"set term x11 size ".$p->{$name}->{sizex}.",".$p->{$name}->{sizey}); + } + else { + die "Output mode not supported yet"; + } + + if ($p->{$name}->{nokey}) { + plot_write($fh,"unset key"); + } + + + plot_write($fh,"set xlabel \"".$p->{$name}->{xlabel}."\"") if $p->{$name}->{xlabel}; + plot_write($fh,"set ylabel \"".$p->{$name}->{ylabel}."\"") if $p->{$name}->{ylabel}; + + if(defined $p->{$name}->{ymin} && defined $p->{$name}->{ymax}) { + plot_write($fh,"set yrange [".$p->{$name}->{ymin}.":".$p->{$name}->{ymax}."]"); + } + elsif(defined $p->{$name}->{ymax}) { + plot_write($fh,"set yrange [:".$p->{$name}->{ymax}."]"); + } + elsif(defined $p->{$name}->{ymin}) { + plot_write($fh,"set yrange [".$p->{$name}->{ymin}.":]"); + } + + if($p->{$name}->{type} == TYPE_HISTORY) { + if($p->{$name}->{fill}) { + plot_write($fh,"set style fill solid 1.00"); + } + else { + plot_write($fh,"set style fill solid 0"); + } + plot_write($fh,"set boxwidth 2 absolute"); + plot_write($fh,"set autoscale fix"); + plot_write($fh,"set xtics autofreq"); #$p->{$name}->{entries} + plot_write($fh,"set grid"); +# plot_write($fh,"set style fill solid 1.0"); + plot_write($fh,"plot ",1); + for(my $j=0; $j<$p->{$name}->{curves};$j++) { + if($p->{$name}->{fill}) { + plot_write($fh,"'-' using 1:2 with filledcurves x1 lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1); + } + elsif($p->{$name}->{dots}) { + plot_write($fh,"'-' using 1:2 with points pointsize 0.6 pointtype 2 lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1); + } + else { + plot_write($fh,"'-' using 1:2 with lines lt rgb \"$color[$j]\" title \"".($p->{$name}->{titles}->[$j] || "$j")."\" ",1); + } + plot_write($fh,', ',1) unless ($j+1==$p->{$name}->{curves}); + } + plot_write($fh," "); + } + else { + die "Plot type not supported"; + } + + } + + +sub PlotDraw { + my($name) = @_; + if($p->{$name}->{run}>=1) { + plot_write($p->{$name}->{fh},"set out \"".$p->{$name}->{file}.".png\""); + plot_write($p->{$name}->{fh},makeTimeString()); + plot_write($p->{$name}->{fh},"replot"); + } + for(my $j=0; $j<$p->{$name}->{curves}; $j++) { + for(my $i=0; $i< scalar @{$p->{$name}->{value}->[$j]}; $i++) { + plot_write($p->{$name}->{fh},(($i-$p->{$name}->{entries})/$p->{$name}->{xscale})." ".$p->{$name}->{value}->[$j]->[$i]) unless $p->{$name}->{countup}; + plot_write($p->{$name}->{fh},($i/$p->{$name}->{xscale})." ".$p->{$name}->{value}->[$j]->[$i]) if $p->{$name}->{countup}; +# print $j." ".$i." ".$p->{$name}->{entries}." ".$p->{$name}->{xscale}." ".$p->{$name}->{value}->[$j]->[$i]."\n"; + } + plot_write($p->{$name}->{fh},"e"); + } + $p->{$name}->{run}++; + } + + +sub PlotAdd { + my($name,$value,$curve) = @_; + $curve = 0 unless $curve; + + if($p->{$name}->{type} == TYPE_HISTORY) { + push(@{$p->{$name}->{value}->[$curve]},$value||0); + shift(@{$p->{$name}->{value}->[$curve]}); + } + + } + + +1; \ No newline at end of file diff --git a/hmon/Hmon.pm b/hmon/Hmon.pm new file mode 100644 index 0000000..eeafa32 --- /dev/null +++ b/hmon/Hmon.pm @@ -0,0 +1,339 @@ +package Hmon; +use POSIX qw/floor ceil strftime/; +use Data::Dumper; +use warnings; +use strict; + +use constant HMONDIR => "/home/hadaq/trbsoft/daq/tools/hmon/"; + +our %hublist; +our $r_hublist = \%hublist; + +print STDERR "Script started at ".strftime("%d.%m.%y %H:%M:%S", localtime()).".\n"; + +############################################################################### +# Make Title & Footer +############################################################################### +sub MakeTitle { + my ($width,$height,$title,$time,$error) = @_; + my $str; + $time = 1 unless defined $time; + $str = "
\n"; + if ($time) { + $str .= "
".strftime("%H:%M:%S", localtime())."
\n"; + } + if (defined $error && $error ne "") { + $str .= "
$error
\n"; + } + $str .= "

$title

"; + return $str; +} + +sub MakeFooter { + my $str; + $str = "
\n"; + return $str; +} + +sub AddStyle { + return ""; +} + +############################################################################### +# Local Logfile +############################################################################### +sub OpenLogfile { + return 0; +# my $fh; +# open($fh, ">>",HMONDIR."/files/locallog"); +# $fh->autoflush(1); +# return $fh; +} + +sub WriteLog { + return 0; +# my ($fh,$title,$format,@vars) = @_; +# # $format =~ s/\s/\t/g; +# if ($fh == 0) { +# $fh = OpenLogfile(); +# } +# my $tmp = sprintf("%s\t%i\t".$format."\n",$title,time(),@vars); +# print $fh $tmp; +} + + +############################################ +# Write to File +############################################ +sub WriteFile { + my ($name,$str) = @_; + open FH,"> ".Hmon::HMONDIR."files/$name.htt"; + print FH $str; + close FH; +} + +############################################ +# Nettrace DB +############################################ +sub TraceDBLoad { + open FILE, "; + close FILE; +} + +sub TraceDBGet { + my ($addr, $port) = @_; + if (defined $r_hublist->{$addr}->{$port}) { + return $r_hublist->{$addr}->{$port}; + } + else { + return 0; + } +} + + +############################################################################### +# Voice Synthesis +############################################################################### +my $speaklog; +sub Speak { + my ($id,$str) = @_; +# print "$id $str $speaklog->{$id}\n"; + if (!defined $speaklog->{$id} || $speaklog->{$id} < time()-120) { +# my $cmd = "ssh hades30 'espeak -ven-male2 -s 120 -g 1 \"$str\" ' 2>/dev/null"; + my $fh; + open($fh, ">>",Hmon::HMONDIR."/files/speaklog"); + $fh->autoflush(1); + print $fh $str."\n"; + $speaklog->{$id} = time(); + close($fh); + } + } + +############################################################################### +# Calculate Colors +############################################################################### +sub findcolor { + my ($v,$min,$max,$lg) = @_; + my ($r,$g,$b); + $v = 0 unless defined $v; + $v = log($v) if $v && $lg; + $min = log($min) if $min && $lg; + $max = log($max) if $max && $lg; + $max = 1 unless $max; + + my $step = (($max-$min)/655); + + + if ($v == 0) { + $r = 220; + $g = 220; + $b = 220; + } else { + $v -= $min; + $v = $v/$step if $step; + if ($v<156) { + $r = 0; + $g = $v+100; + $b = 0; + } elsif ($v<412) { + $v -= 156; + $r = $v; + $g = 255; + $b = 0; + } else { + $v -= 412; + $r = 255; + $g = 255-$v; + $b = 0; + } + } + + my $ret = sprintf("#%02x%02x%02x",$r%256,$g%256,$b%256); + + return $ret; +} + +############################################################################### +# Make a nice colored drawing of MDC +############################################################################### +sub DrawMDC { + my ($plane,$sector,$color,$val) = @_; + my $str; + $str .= "\n"; + if ($plane == 0) { + $str .= "\n"; + } elsif ($plane == 1) { + $str .= "
{12} title=\"$val->{12}\">C{13} title=\"$val->{13}\">D\n"; + $str .= "
{10} title=\"$val->{10}\">A{11} title=\"$val->{11}\">B\n"; + $str .= "
{2} title=\"$val->{2}\">2$sector{7} title=\"$val->{7}\">7\n"; + $str .= "
{4} title=\"$val->{4}\">4{1} title=\"$val->{1}\">1{6} title=\"$val->{6}\">6{9} title=\"$val->{9}\">9\n"; + $str .= "
{3} title=\"$val->{3}\">3{0} title=\"$val->{0}\">0{5} title=\"$val->{5}\">5{8} title=\"$val->{8}\">8
{14} title=\"$val->{14}\">E{15} title=\"$val->{15}\">F\n"; + $str .= "
{12} title=\"$val->{12}\">C{13} title=\"$val->{13}\">D\n"; + $str .= "
{5} title=\"$val->{5}\">5$sector{11} title=\"$val->{11}\">B\n"; + $str .= "
{4} title=\"$val->{4}\">4{10} title=\"$val->{10}\">A\n"; + $str .= "
{3} title=\"$val->{3}\">3{1} title=\"$val->{1}\">1{7} title=\"$val->{7}\">7{9} title=\"$val->{9}\">9\n"; + $str .= "
{2} title=\"$val->{2}\">2{0} title=\"$val->{0}\">0{6} title=\"$val->{6}\">6{8} title=\"$val->{8}\">8\n"; + # $str .= "
{1} title=\"$val->{1}\">1{7} title=\"$val->{7}\">7\n"; + # $str .= "
{0} title=\"$val->{0}\">0{6} title=\"$val->{6}\">6\n"; + } else { + $str .= "
{12} title=\"$val->{12}\">C{13} title=\"$val->{13}\">D{14} title=\"$val->{14}\">E{15} title=\"$val->{15}\">F\n"; + $str .= "
{5} title=\"$val->{5}\">5{11} title=\"$val->{11}\">B\n"; + $str .= "
{4} title=\"$val->{4}\">4$sector{10} title=\"$val->{10}\">A\n"; + $str .= "
{3} title=\"$val->{3}\">3{9} title=\"$val->{9}\">9\n"; + $str .= "
{2} title=\"$val->{2}\">2{8} title=\"$val->{8}\">8\n"; + $str .= "
{1} title=\"$val->{1}\">1{7} title=\"$val->{7}\">7\n"; + $str .= "
{0} title=\"$val->{0}\">0{6} title=\"$val->{6}\">6\n"; + } + $str .= "
\n"; + return $str; +} + +############################################################################### +# Draw Scale +############################################################################### +sub DrawScale { + my ($min,$max,$steps) = @_; + my $str; + # print "$min $max $steps\n"; + return "" if $max == $min; + $str .= ""; + $str .= sprintf("
",Hmon::findcolor(0,0,$steps,0)); + return $str.="
" if $max == $min; + $str .= sprintf("%#2.3G",$min); + for (my $i = 1;$i<$steps;$i++) { + # my $j = ($max-$min)/$steps*$i; + $str .= sprintf("",Hmon::findcolor($i,0,$steps,0)); + } + $str .= sprintf("%#2.3G",$max); + $str .= "\n"; + # $str .= ""; + # $str .= sprintf("
%2.1G%2.1G%2.1G\n",$min+($max-$min)/4,$min+($max-$min)*2/4,$min+($max-$min)*3/4); + # $str .= "
\n"; + + return $str; +} + +############################################################################### +# Makes Diffs to last stored value. +# Loops over last plane/sector/board +############################################################################### +sub MakeDifferences { + my ($store, $laststore, $limit) = @_; + my $values = {}; + for (my $l = 0; $l < 4;$l++) { + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $values->{$l}->{$s}->{$b} = 0; + if (exists $store->{$l}->{$s}->{$b} && exists $laststore->{$l}->{$s}->{$b}) { + # if ($store->{$l}->{$s}->{$b} < $laststore->{$l}->{$s}->{$b}) { + # $values->{$l}->{$s}->{$b} = ($store->{$l}->{$s}->{$b} - $laststore->{$l}->{$s}->{$b}) & 0xFFFFFFFF ; + # } + # else { + $values->{$l}->{$s}->{$b} = ($store->{$l}->{$s}->{$b} - $laststore->{$l}->{$s}->{$b}) ; # & 0xFFFFFFFF + while ($values->{$l}->{$s}->{$b} < 0) { + $values->{$l}->{$s}->{$b} = ($values->{$l}->{$s}->{$b} + $limit); + } # & 0xFFFFFFFF + # } + } + } + } + } + return $values; +} + +############################################################################### +# Find min/max +############################################################################### +sub MakeMinMax3 { + my ($values,$d1,$d2,$d3,$ignore) = @_; + $ignore = 1 unless defined $ignore; + my $max = 0; + my $min = 2**32; + my $avg = 0; + my $num = 0; + for (my $l = 0; $l < $d1;$l++) { + for (my $s = 0; $s < $d2;$s++) { + for (my $b=0;$b<$d3;$b++) { + if (! exists $values->{$l}->{$s}->{$b}) { + $values->{$l}->{$s}->{$b} = 0; + } else { + $num++; + $avg += $values->{$l}->{$s}->{$b}; + } + if ($max < $values->{$l}->{$s}->{$b}) { + $max = $values->{$l}->{$s}->{$b}; + } + if ($min > $values->{$l}->{$s}->{$b} && ($values->{$l}->{$s}->{$b} != 0 || !$ignore)) { + $min = $values->{$l}->{$s}->{$b}; + } + } + } + } + $avg /= ($num || 1); + return ($min,$max,$avg); +} + +sub MakeMinMax2 { + my ($values, $d1, $d2, $ignore) = @_; + $ignore = 1 unless defined $ignore; + my $max = 0; + my $min = 2**32; + my $avg = 0; + my $num = 0; + # print Dumper $values; + for (my $l = 0; $l < $d1;$l++) { + for (my $s = 0; $s < $d2;$s++) { + if (! exists $values->{$l}->{$s}) { + $values->{$l}->{$s} = 0; + } else { + $num++; + $avg += $values->{$l}->{$s}; + } + if ($max < $values->{$l}->{$s}) { + $max = $values->{$l}->{$s}; + } + if ($min > $values->{$l}->{$s} && ($values->{$l}->{$s} != 0 || !$ignore)) { + $min = $values->{$l}->{$s}; + } + } + } + $avg /= $num; + return ($min,$max,$avg); +} + +sub MakeMinMax1 { + my ($values,$d1,$ignore) = @_; + $ignore = 1 unless defined $ignore; + my $max = 0; + my $min = 2**32; + for (my $l = 0; $l < $d1;$l++) { + if (! exists $values->{$l}) { + $values->{$l} = 0; + } + if ($max < $values->{$l}) { + $max = $values->{$l}; + } + if ($min > $values->{$l} && ($values->{$l} != 0 || !$ignore)) { + $min = $values->{$l}; + } + } + return ($min,$max); +} + +sub qxtimeout { + my ($cmd, $time) = @_; + my @out; + $SIG{ALRM} = sub { $out[0] = "qxtimeout"; die }; + $SIG{CHLD} = "IGNORE"; + eval { + alarm($time); + @out = qx($cmd); + alarm(0); + }; + return @out; +} + +1; +__END__ diff --git a/hmon/Perl2Epics.pm b/hmon/Perl2Epics.pm new file mode 100644 index 0000000..c886dbd --- /dev/null +++ b/hmon/Perl2Epics.pm @@ -0,0 +1,156 @@ +package Perl2Epics; +use warnings; +use strict; +use Data::Dumper; +# use Hmon; + +use lib '/home/scs/EPICS/gcc-4.4/EPICS-3.14.12.2_linux-x86_64/base/' . '/lib/perl'; +use CA; + +$ENV{EPICS_CA_AUTO_ADDR_LIST} = 'YES'; +$ENV{EPICS_CA_ADDR_LIST} = "192.168.100.11 192.168.100.12 192.168.100.13 192.168.100.14 192.168.100.15 localhost"; + + +my $EpicsValues = {}; +my $EpicsStore = {}; +my @EpicsChans = (); +my $EpicsNames = {}; +my $errcnt = {}; + +sub callback { + my ($chan, $status, $data) = @_; +# print Dumper $data; + if ($status) { + printf "%-30s %s\n", $chan->name, $status; + } + else { +# print $chan->name . ": $data->{value}\n"; +# print scalar @{$EpicsStore->{$chan->name}->{tme}}."\n"; + if(scalar @{$EpicsStore->{$chan->name}->{tme}} > 10) { + shift @{$EpicsStore->{$chan->name}->{tme}}; + shift @{$EpicsStore->{$chan->name}->{val}}; + } + push(@{$EpicsStore->{$chan->name}->{tme}}, $data->{stamp}); + push(@{$EpicsStore->{$chan->name}->{val}}, $data->{value}); + $EpicsValues->{$chan->name}->{tme} = $data->{stamp}; + $EpicsValues->{$chan->name}->{val} = $data->{value}; + } +} + + +sub Connect { + my ($title,$varname,$type,$wait) = @_; + # push(@EpicsChans,CA->new($name)); + # $EpicsChans[-1]->create_subscription('v', \&callback, 'DBR_TIME_DOUBLE'); + ## print $varname."\n"; + $type = 'DBR_TIME_DOUBLE' unless defined $type; + $EpicsStore->{$varname}->{tme} = []; + $EpicsStore->{$varname}->{val} = []; + $EpicsNames->{$title} = $varname; + $errcnt->{$varname} = 0; + my $success; + eval { + my $c = CA->new($varname); + CA->pend_io($wait || 0.05); + $c->create_subscription('v', \&callback, $type); +# $c->get_callback(\&callback, $type, 1); + $EpicsStore->{$varname}->{ca} = $c; + $success = $c->is_connected(); + }; + +return ($success); +} + +sub Update { + CA->pend_event($_[0]); + } + + +sub GetAll { + my $store = {}; + my $time; + my $val; + + Update(0.001); + + foreach my $el (keys %{$EpicsNames}) { + my $varname = $EpicsNames->{$el}; + my $ca = $EpicsStore->{$varname}->{ca}; + my $r = $ca->is_connected() if(defined $ca); + my $success = 1; + if(!$r && (!defined $errcnt->{$el} || $errcnt->{$el} < 20)) { + $success = Connect($el, $varname); + $errcnt->{$el}++; + } + + if(!$success) { + $time = -1; + $val = 0; + } + elsif (scalar @{$EpicsStore->{$varname}->{tme}} > 0) { + $errcnt->{$el}-=.3 if ($errcnt->{$el}||0) >= 0; + $time = (@{$EpicsStore->{$varname}->{tme}})[-1]; + $val = (@{$EpicsStore->{$varname}->{val}})[-1]; + } + else { + $time = $EpicsStore->{$varname}->{lasttime}; + $val = $EpicsStore->{$varname}->{lastval}; + } + $store->{$el}->{tme} = $time; + $store->{$el}->{val} = $val; + $EpicsStore->{$varname}->{lasttime} = $time; + $EpicsStore->{$varname}->{lastval} = $val; + } + + return $store; + } + + + + + +sub Get { + my ($title,$latest) = @_; + my $varname = $EpicsNames->{$title}; + my $time; + my $val; +# print $varname; + + my $c = $EpicsStore->{$varname}->{ca}; + my $r = $c->is_connected() if(defined $c); + + my $success = 1; + if(!$r) { + $success = Connect($title, $varname); + } + + if(!$success) { + return (-1, 0); + } + + + Update(0.00001); + + if (scalar @{$EpicsStore->{$varname}->{tme}} > 0) { + if(defined $latest && $latest == 1) { + $time = (@{$EpicsStore->{$varname}->{tme}})[-1]; + $val = (@{$EpicsStore->{$varname}->{val}})[-1]; + } + else { #if (scalar @{$EpicsStore->{$varname}->{tme}} > 1) + $time = shift (@{$EpicsStore->{$varname}->{tme}}); + $val = shift (@{$EpicsStore->{$varname}->{val}}); + } + } + else { + $time = $EpicsStore->{$varname}->{lasttime}; + $val = $EpicsStore->{$varname}->{lastval}; + } + $EpicsStore->{$varname}->{lasttime} = $time; + $EpicsStore->{$varname}->{lastval} = $val; + $time = $time || -1; + $val = $val || 0; + return ($time,$val); + } + +1; +__END__ diff --git a/hmon/QA.pm b/hmon/QA.pm new file mode 100644 index 0000000..3978841 --- /dev/null +++ b/hmon/QA.pm @@ -0,0 +1,262 @@ +package QA; + +use Hmon; +############################################################################### +# Screen Configuration +############################################################################### +# List of categories & names +our $cats = {'main'=>"Main", + 'daq'=>"DAQ", + 'trg'=>"Trig", + 'server'=>"Srv", + 'eb'=>"EB", + 'mdc'=>"MDC", + 'endp'=>"Endp", + 'feeerr'=>"Fee", + 'other'=>"Other"}; + +# Order of categories +our $entries->{'cats'} = ["main", + "daq", + "trg", + "server", + "eb", + "mdc", + "endp", + "feeerr", + "other"]; + +# Order of entries in each cat +$entries->{'main'} = ['time', 'rate','onlineqa']; +$entries->{'daq'} = ['trbnet', 'timeouts', 'busy','readout']; +$entries->{'trg'} = ['spill', 'source', 'accepted', 'ptrate', 'start']; +$entries->{'server'} = ['fill', 'cpu', 'icinga', 'etrax', 'pwrsup']; +$entries->{'eb'} = ['run', 'rate','bytes', 'lostevt', 'errbits']; +$entries->{'mdc'} = ['token', 'blocked', 'temp', 'linkqual', 'voltage']; +$entries->{'endp'} = ['mdc', 'rich', 'tof', 'rpc', 'other']; +$entries->{'feeerr'} = ['rich', 'trb', 'feeerr','trginp','trgqual']; +$entries->{'other'} = ['magnet','speech','shower','rich','mdcinvalid']; + + +our $QAServer = "hades33"; + +############################################################################### +# Thresholds +############################################################################### +# #MDC Temperatures +# use constant {MdcTempOk => 78, MdcTempWarn => 85, MdcTempErr => 90}; +# +# #MDC locked OEP +# use constant {MdcLockOk => 0, MdcLockWarn => 3, MdcLockErr => 5}; +# +# #MDC OEP Numbers +# use constant {MdcOepOk => 326}; +# use constant {MdcOepWarn => MdcOepOk-2}; +# use constant {MdcOepErr => MdcOepOk-4}; +# +# #Frontend errors +# use constant { FeeErrOk => 0, FeeErrWarn => 2, FeeErrErr => 5}; + +our @FeeErrLimits = (0, 5, 10); +our @MdcOepLimits = (372, 372-1, 372-3); +our @MdcVoltageLimits = (50, 60, 100); +our @MdcLockLimits = (0, 3, 5); +our @MdcTempLimits = (78, 85, 90); +our @TrgErrLimits = (100, 1000, 10000); +our @CPULimits = (95, 100, 100); +our @TimeoutLimits = (0, 0, 1); +our @LinkErrLimits = (50, 500, 1000); +our @MdcEndpMissingLimits = (0, 0, 1); +our @RichEndpMissingLimits = (0, 0, 0); +our @TofEndpMissingLimits = (0, 0, 0); +our @RpcEndpMissingLimits = (0, 0, 0); +our @OtherEndpMissingLimits = (0, 0, 0); +our @EBDeltaRateLimits = (10, 15, 25); +our $TrgCheckPolarity = 1; +our @Eventsbroken = (.5,5,10); +our @MdcTokenMissLimits = (10,50,100); + + +our @LimitTriggerPerSpill = (1000, 0, 0); +our $AcceleratorCycle = 12; +use constant {CTSAddress => 0x0003}; + +############################################################################### +# Missing Boards +############################################################################### + +our @mdc_boards_removed =(0x2233); +our @mdc_chambers_removed =(); +our @rich_boards_removed =(); +our @tof_boards_removed =(); +our @rpc_boards_removed =(); +our @other_boards_removed =(); + + +############################################################################### +# Error Levels +############################################################################### +use constant { + SCRIPTERROR => -1, + NA => 0, + OK => 10, + NOTE => 20, + NOTE_2 => 22, + WARN => 40, + WARN_2 => 42, + ERROR => 70, + ERROR_2 => 72, + LETHAL => 100, + FATAL => 100 +}; + +############################################################################### +# Functions +############################################################################### + + +############################################ +# Opens QA Logfile and gives back a filehandle +sub OpenQAFile { + my $fh; + open($fh, ">>",Hmon::HMONDIR."/files/qalog"); + $fh->autoflush(1); + return $fh; +} + + + +############################################ +# Writes an entry to the QA file. Arguments: +# $fh file handle of logfile +# $cat category of entry +# $entry name of entry +# $ttl time the entry is valid (in seconds) +# $status Status, one of the constants defined above +# $title First line of monitor entry +# $value Second line of monitor entry +# $longtext Long description text (PopUp) +sub WriteQALog { + my ($fh, $category, $entry, $ttl, $status, $title, $value, $longtext) = @_; + my $close = 0; + my $tmp = time()."\t$category\t$entry\t$ttl\t$status\t$title\t$value\t$longtext\n"; + + if ($fh eq "remote") { + system("ssh $QAServer \"echo '$tmp' >> /home/hadaq/trbsoft/daq/tools/hmon/files/qalog\""); + return; + } + + # $format =~ s/\s/\t/g; + if ($fh == 0) { + $fh = OpenQAfile(); + $close = 1; + } + + print $fh $tmp; + close $fh if($close); +} + +############################################ +# Returns the appropriate status flag (simplified). Arguments: +# $mode how to determine status, supported: "below","above" +# $val the value +# @limits Array with limits +sub GetQAState { + my ($mode, $val, @limits) = @_; + my ($ok, $warn, $err) = @limits; + if (!defined($val)) { + return NA; + } + if ($val eq "err") { + return SCRIPTERROR; + } + if ($_[0] eq 'below') { + if ($val <= $ok) { + return OK; + } + if ($val <= $warn) { + return WARN; + } + if ($val <= $err) { + return ERROR; + } + if ($val > $err) { + return FATAL; + } + } elsif ($_[0] eq 'above') { + if ($val >= $ok) { + return OK; + } + if ($val >= $warn) { + return WARN; + } + if ($val >= $err) { + return ERROR; + } + if ($val < $err) { + return FATAL; + } + } elsif ($_[0] eq 'inside') { + if (abs($val) <= $ok) { + return OK; + } + if (abs($val) <= $warn) { + return WARN; + } + if (abs($val) <= $err) { + return ERROR; + } + return FATAL; + } + return SCRIPTERROR; +} + +############################################ +#Returns a string matching the given severity level +sub LevelName { + my ($level) = @_; + if ($level == SCRIPTERROR) { + return "Script Error"; + } + if ($level == NA) { + return "Not available"; + } + if ($level < NOTE ) { + return "OK"; + } + if ($level < WARN ) { + return "Note"; + } + if ($level < ERROR ) { + return "Warning"; + } + if ($level < FATAL ) { + return "Error"; + } + return "Severe Error"; + } + +############################################ +# Tries to nicely format an integer +sub SciNotation { + my $v = shift; + return "undef" if (!defined $v); + return "0" if $v == 0; +# print $v."\n"; + if(abs($v) >= 1) { + return sprintf("%i", $v) if (abs($v) < 1000) ; + return sprintf("%.1fk", $v / 1000.) if (abs($v) < 20000) ; + return sprintf("%ik", $v / 1000.) if (abs($v) < 1E6) ; + return sprintf("%.1fM", $v / 1000000.) if (abs($v) < 20E6) ; + return sprintf("%iM", $v / 1000000.) if (abs($v) < 1E9) ; + return sprintf("%i",$v); + } + else { + return sprintf("%in", $v*1E9) if (abs($v) < 1E-6) ; + return sprintf("%iu", $v*1E6) if (abs($v) < 1E-3) ; + return sprintf("%.1fm", $v*1E3); + } +} + +1; +__END__ diff --git a/hmon/background.png b/hmon/background.png new file mode 100755 index 0000000..d17851d Binary files /dev/null and b/hmon/background.png differ diff --git a/hmon/doc.cgi b/hmon/doc.cgi new file mode 100755 index 0000000..9a14ab9 --- /dev/null +++ b/hmon/doc.cgi @@ -0,0 +1,92 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use constant { + SCRIPTERROR => -1, + NA => 0, + OK => 10, + NOTE => 20, + NOTE_2 => 22, + WARN => 40, + WARN_2 => 42, + ERROR => 70, + ERROR_2 => 72, + LETHAL => 100, + FATAL => 100 +}; + + +my @args = split('-',$ENV{'QUERY_STRING'}); +my ($class,$entry) = @args; + +print "Content-type: text/html\r\n\r\n"; + +my $out = qq~ + + + +Tactical Overview Documentation + + + + + + +
+
+

Tactical Overview Guide

+
+
+
+
+
+
Status:
+~; + + +unless (defined $class && defined $entry) { + $out .= "

This script should not be called directly, but only with correct options.

"; + goto END; + } + + + my $MYF; + my $str = ""; + open ($MYF, ""; + goto END; + }; + $out .= $_ while (<$MYF>); + +END: + +$out .= qq$ + + + + +$; + +print $out; diff --git a/hmon/editlogfiles.pl b/hmon/editlogfiles.pl new file mode 100755 index 0000000..45413ec --- /dev/null +++ b/hmon/editlogfiles.pl @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use Data::Dumper; +# use Hmon; +# use QA; +# use Perl2Epics; +use HADES::TrbNet; + +my $pathtoarchive = "/home/hadaq/trbsoft/daq/tools/hmon/archive"; + +my $cmd = "ls $pathtoarchive/*/logfile.htm"; +my @files = qx($cmd); + +foreach my $f (@files) { + my ($fin,$fout); + chop $f; + print $f."\n"; + open($fin,"<",$f) or die "can't open file"; + chop $f; chop $f; chop $f; + open($fout,">",$f."ht"); + + my @lines = <$fin>; + foreach my $l (@lines) { + + $l =~ s//\n/gi; + $l =~ s##\n#gi; + print $fout $l."\n" ; + } + close($fin); + close($fout); + } + +my $cmd = "ls $pathtoarchive/*/logfile.ht"; +my @files = qx($cmd); + +my $store; +my $fout; +open($fout,">","$pathtoarchive/logfile.htm"); +print $fout "\n"; + +foreach my $f (@files) { + my $fin; + chop $f; +# print $f."\n"; + open($fin,"<",$f) or die "can't open file"; + my @lines = <$fin>; + + foreach my $l (@lines) { + next if ($l =~ m#<.*div#); + next if ($l =~ m#<.*table#); + next if ($l =~ m#Online QA#); + next if ($l =~ m#EVTBLD#); + next if ($l =~ m#NETMEM#); + next if ($l =~ m#30 boards complain#); + next if ($l =~ m#Eventbuilders#); + #next if ($l =~ m#Included#); + #next if ($l =~ m#Power#); + next if ($l =~ m#counter mismatch#); + #next if ($l =~ m#Timeouts found#); + next if ($l =~ m#0x2\w\w\w missing#); + next if ($l =~ m#Load thresh#); +# next if ($l =~ m#Trigger#); + next if ($l =~ m#DAQ is going#); + $l =~ s#>9.Apr#>09.Apr#; + if(!(defined $store->{$l}) && $l =~ m#^# ) { + $store->{$l}=1; + print $fout $l; + } + } + } + $cmd = "sort $pathtoarchive/logfile.htm >$pathtoarchive/logfile2.htm"; + system($cmd); diff --git a/hmon/files b/hmon/files new file mode 120000 index 0000000..83f9da1 --- /dev/null +++ b/hmon/files @@ -0,0 +1 @@ +/dev/shm/hmon \ No newline at end of file diff --git a/hmon/get.cgi b/hmon/get.cgi new file mode 100755 index 0000000..b730787 --- /dev/null +++ b/hmon/get.cgi @@ -0,0 +1,71 @@ +#!/usr/bin/perl +use warnings; +use strict; +use Data::Dumper; +use MIME::Base64; + +print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\r\n"; +print "Content-type: text/html\r\n\r\n"; + +my @args = split('-',$ENV{'QUERY_STRING'}); + +sub addpng { + my ($file) = @_; + my $out = "data:image/png;base64,"; + open (my $fh, "<$file"); + + local $/; + my $bin = <$fh>; + $fh->close(); + $/='\n'; + $out .= encode_base64($bin); + chomp $out; + return $out; + } + +sub addfile { + my ($file,$strip) = @_; + my $MYF; + $strip = 0 unless defined $strip; + my $str = ""; + open ($MYF, "<$file") or return ""; + while (<$MYF>){ +# print $_; + if ($_ =~ m%ADDFILE\s([/\w]*).svg%) { + $str .= addfile("$1.svg",1); + } + elsif ($_ =~ m!^(.*)\%ADDPNG\s+(.+)\%(.*)$!) { + $str .= $1; + $str .= addpng($2); + $str .= $3; + } + else { + $_ =~ s/\t*/ /; + if($_ =~ m/^$/) {next;} + if($strip==1) { + $_ =~ s/\n"; + +my @args = split('-',$ENV{'QUERY_STRING'}); +my $query = $ENV{'QUERY_STRING'}; + +unless( $query =~ m/^\w+-\w+$/) { + print "Invalid Query.\n"; + exit; + } + +sub LevelName { + my ($level) = @_; + if ($level == -1) { return "Script Error"; } + if ($level == 0) { return "Not available"; } + if ($level < 20 ) { return "OK"; } + if ($level < 40 ) { return "Note"; } + if ($level < 70 ) { return "Warning"; } + if ($level < 100 ) { return "Error"; } + return "Severe Error"; + } + +my $out = ""; +my $MYF; +open ($MYF, "){ + if($_ =~ m/$query/i) { +# print $_."
"; + $out .= "
Entry$query - "; + $_ =~ m/class="(\d+)/; + $out .= LevelName($1); + $_ =~ m/alt=".+\((\d\d:\d\d:\d\d)\)/; + $out .= " @ ".$1; + + $_ =~ m$>(.+)
(.+)$; + $out .= "
Short$1 - $2"; + + $_ =~ m$alt=".+<br />(.+)"\sonmouseover$; + my $s = $1; + $s =~ s$\s-\s$
$gi; + $out .= "
Msg
"; + $out .= $s; + $out .= "
"; + } + } + +#
#EB running
active: 0/1
+ +close $MYF; +print $out; + diff --git a/hmon/hmon_busy.pl b/hmon/hmon_busy.pl new file mode 100755 index 0000000..5f074ca --- /dev/null +++ b/hmon/hmon_busy.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl -w + +use Hmon; + +my $str; + + + $str = Hmon::MakeTitle(5,6,"Busy Times",0); +# $str .= "\"Sorry,\n"; + $str .= "\n"; +# $str .= "\n#ADDFILE files/busy.svg\n"; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("busy",$str); + + +qx(./hmon_hadplot.sh -d 500 -output "PNG.files/busy.380.265" busyrate); + + diff --git a/hmon/hmon_busyhist.pl b/hmon/hmon_busyhist.pl new file mode 100755 index 0000000..e53a07a --- /dev/null +++ b/hmon/hmon_busyhist.pl @@ -0,0 +1,16 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use Hmon; + +my $str = ""; + +$str = Hmon::MakeTitle(8,6,"Busy Times",0); +# $str .= "\n#ADDFILE files/busyhist.svg\n"; +$str .= "\n"; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("busyhist",$str); + + +qx(./hmon_hadplot.sh -d 100 -o 10 -n 300 -output "PNG.files/busyhist.620.265" busytime); diff --git a/hmon/hmon_datarate.pl b/hmon/hmon_datarate.pl new file mode 100755 index 0000000..96dde09 --- /dev/null +++ b/hmon/hmon_datarate.pl @@ -0,0 +1,21 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Hmon; + +my $str = ""; + + +$str = Hmon::MakeTitle(9,6,"Data Rates",0); +#$str .= "\n#ADDFILE files/eventratehist.svg\n"; +$str .= "\n"; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("datarate",$str); + + + + + qx(./hmon_hadplot.sh -d 1000 -n 600 -ytitle "MByte/s" -output "PNG.files/datarate.700.265" datarate); + + diff --git a/hmon/hmon_eb_rate.pl b/hmon/hmon_eb_rate.pl new file mode 100755 index 0000000..7c32bbc --- /dev/null +++ b/hmon/hmon_eb_rate.pl @@ -0,0 +1,118 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use Data::Dumper; +use Hmon; +use QA; +use Perl2Epics; +use HADES::TrbNet; + +my $SLEEP_TIME = 0.5; # in seconds +my $NUM_AVERAGES = 10; +my $offset = 2; +my $last_rate_endp = 0; +my $opt_addr = 3; #CTS +my $error_ctr = 0; +my $error_limit = 3; + +trb_init_ports() or die trb_strerror(); + +my $flog = QA::OpenQAFile(); + +for (my $i = 0; $i <= 15; $i++) { + my $s = sprintf("HAD:eb%02i", $i + 1); + Perl2Epics::Connect("ebrate$i", $s.":evtCRate"); + Perl2Epics::Connect("ebstat$i", $s.":status"); +} +#Perl2Epics::Connect("totalEvts","HAD:eb:totalEvtsComp"); + +while (1) { + + # 0x03 => CTS + # my $rh_result = trb_register_read(QA::CTSAddress, 0xa0f0) + # or sleep 5 and next; + # my $sentmask = ($rh_result->{QA::CTSAddress} || 0) & 0xFFFF; + + # 0x3000 => ?? + my $actmask = 0; + my $evtrate_eb_tot = 0; + my $evtrate_endp_tot = 0; + my $ctr = 0; + my $starttime = time(); + my $data; + my $last_spill_on = 0; + my $spill_on = 0; + my $use_spill_detect = 0; + + while (($ctr < ($NUM_AVERAGES + $offset)) && (!($last_spill_on == 1 && $spill_on == 0) || $use_spill_detect == 0)) { + my $rh_result = trb_register_read(0x2, 0x1) or sleep 5 and next; + my $rate_endp = ($rh_result->{0x2} & 0xffff); + if ($ctr < $NUM_AVERAGES) { + $evtrate_endp_tot += + $rate_endp >= $last_rate_endp ? $rate_endp - $last_rate_endp + : ($rate_endp + 2**16) - $last_rate_endp; + } + if ($ctr >= $offset) { + $data = Perl2Epics::GetAll(); + my $i = 0; + for ($i = 0; $i <= 15; $i++) { + $evtrate_eb_tot += $data->{"ebrate$i"}->{val} || 0; + if ($data->{"ebstat$i"}->{val}) { + $actmask |= (1 << $i); + } + } + } + $last_rate_endp = $rate_endp; + + ###cancel integration when spill break is detected + my @result = trb_register_read_c($opt_addr, 0xa002 ); + $last_spill_on = $spill_on; + $spill_on = !(($result[1] & 0x10) >> 4); + + usleep($SLEEP_TIME * 1e6); + $ctr++; + } + + my $tottime = time() - $starttime; + my $rate_eb = $evtrate_eb_tot / $ctr; + my $rate_eb_str = sprintf "%.1f", $rate_eb; + my $rate_endp = $evtrate_endp_tot / $tottime; + my $rate_endp_str = sprintf "%.1f", $rate_endp; + my $diff = $rate_eb - $rate_endp; + my $diff_str = sprintf "%d", $diff; + my $diff_p = $diff / ($rate_endp || 1) * 100; + my $diff_p_str = sprintf "%d", $diff_p; + if (! $rate_endp) { + $evtrate_endp_tot, $diff_p_str = "---"; + } + + my $limit = $diff / sqrt($rate_endp || 1); + my $status = QA::GetQAState('inside', $limit, @QA::EBDeltaRateLimits); + if ($rate_endp < 50) { + $status = QA::OK; + } + if (! $actmask) { + $status = QA::WARN_2; + $diff_p_str = "---"; + $rate_eb_str = "EB is stopped"; + } + if (($status >= QA::ERROR) && ($error_ctr < $error_limit)) { + $error_ctr++; + $status = QA::OK; + } else { + $error_ctr = 0; + } + my $title = "ΔRate EB-CTS"; + my $shorttext = "$diff_str ($diff_p_str%)"; + my $longtext = "CurrentRate CTS: $rate_endp_str - Rate Eventbuilders: $rate_eb_str - ΔRate: $diff_str ($diff_p_str%)"; + $longtext = " $longtext ErrorCtr: $error_ctr" if ($error_ctr > 0); + QA::WriteQALog($flog, "eb", "rate", $SLEEP_TIME * $ctr * 2, + $status, $title, $shorttext, $longtext); + if ($status >= QA::ERROR) { + my $speakermsg = "CTS and Eventbuilder rate differ by "; + my $pmesg = sprintf "%d", abs($diff_p); + Hmon::Speak('dataloss', "Eventbuilder and CTS rate differ by $pmesg per cent") + } +} diff --git a/hmon/hmon_endpoints.pl b/hmon/hmon_endpoints.pl new file mode 100755 index 0000000..dca2e69 --- /dev/null +++ b/hmon/hmon_endpoints.pl @@ -0,0 +1,283 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use POSIX qw(strftime); +use FileHandle; +use Hmon; +use QA; +use Getopt::Long; +use Data::Dumper; + +use HADES::TrbNet; + +trb_init_ports() or die trb_strerror(); +my $flog = QA::OpenQAFile(); +my $waittime = 15; +my $loggerperiod = 12; #times 5 seconds sleep +my $timecnt; + +while(1) { + my @result = trb_register_read_c(0xffff, 0x0) or sleep 5 and next; + + ####config + my @all_boards =(); + my @mdc_boards =( + ###OEPS + # 0x2010,0x2011,0x2012,0x2013,0x2014,0x2015,0x2016,0x2017,0x2018,0x2019,0x201a, + # 0x201b,0x201c,0x201d,0x2020,0x2021,0x2022,0x2023,0x2024,0x2025,0x2026,0x2027, + # 0x2028,0x2029,0x202a,0x202b,0x202c,0x202d,0x2030,0x2031,0x2032,0x2033,0x2034, + # 0x2035,0x2036,0x2037,0x2038,0x2039,0x203a,0x203b,0x203c,0x203d,0x2040,0x2041, + # 0x2042,0x2043,0x2044,0x2045,0x2046,0x2047,0x2048,0x2049,0x204a,0x204b,0x204c, + # 0x204d,0x2050,0x2051,0x2052,0x2053,0x2054,0x2055,0x2056,0x2057,0x2058,0x2059, + # 0x205a,0x205b,0x205c,0x205d,0x2100,0x2101,0x2102,0x2103,0x2104,0x2105,0x2106, + # 0x2107,0x2108,0x2109,0x210a,0x210b,0x210c,0x210d,0x210e,0x210f,0x2110,0x2111, + # 0x2112,0x2113,0x2114,0x2115,0x2116,0x2117,0x2118,0x2119,0x211a,0x211b,0x211c, + # 0x211d,0x211e,0x211f,0x2120,0x2121,0x2122,0x2123,0x2124,0x2125,0x2126,0x2127, + # 0x2128,0x2129,0x212a,0x212b,0x212c,0x212d,0x212e,0x212f,0x2130,0x2131,0x2132, + # 0x2133,0x2134,0x2135,0x2136,0x2137,0x2139,0x213a,0x213b,0x213c,0x213d,0x213e, + # 0x213f,0x2140,0x2141,0x2142,0x2143,0x2144,0x2145,0x2146,0x2147,0x2148,0x2149, + # 0x214a,0x214b,0x214c,0x214d,0x214e,0x214f,0x2150,0x2151,0x2152,0x2153,0x2154, + # 0x2155,0x2156,0x2157,0x2158,0x2159,0x215a,0x215b,0x215c,0x215d,0x215e,0x215f, + # 0x2200,0x2201,0x2202,0x2203,0x2204,0x2205,0x2206,0x2207,0x2208,0x2209,0x220a, + # 0x220b,0x220c,0x220d,0x220e,0x220f,0x2220,0x2221,0x2222,0x2223,0x2224,0x2225, + # 0x2226,0x2227,0x2228,0x2229,0x222a,0x222b,0x222c,0x222d,0x222e,0x222f,0x2240, + # 0x2241,0x2242,0x2243,0x2244,0x2245,0x2246,0x2247,0x2248,0x2249,0x224a,0x224b, + # 0x224c,0x224d,0x224e,0x224f,0x2250,0x2251,0x2252,0x2253,0x2254,0x2255,0x2256, + # 0x2257,0x2258,0x2259,0x225a,0x225b,0x225c,0x225d,0x225e,0x225f,0x2300,0x2301, + # 0x2302,0x2303,0x2304,0x2305,0x2306,0x2307,0x2308,0x2309,0x230a,0x230b,0x230c, + # 0x230d,0x230e,0x230f,0x2320,0x2321,0x2322,0x2323,0x2324,0x2325,0x2326,0x2327, + # 0x2328,0x2329,0x232a,0x232b,0x232c,0x232d,0x232e,0x232f,0x2340,0x2341,0x2342, + # 0x2343,0x2344,0x2345,0x2346,0x2347,0x2348,0x2349,0x234a,0x234c,0x234d,0x234e, + # 0x234f,0x2350,0x2351,0x2352,0x2353,0x2354,0x2355,0x2356,0x2357,0x2358,0x2359, + # 0x235a,0x235b,0x235c,0x235d,0x235e,0x235f, + # ###MDC Concentrator + 0x1000,0x1001,0x1002,0x1003,0x1004,0x1010,0x1011,0x1012,0x1013,0x1014,0x1020, + 0x1021,0x1022,0x1023,0x1024,0x1030,0x1031,0x1032,0x1033,0x1034,0x1040,0x1041,0x1042,0x1043,0x1044,0x1050, + 0x1051,0x1052,0x1053,0x1054,0x1100,0x1101,0x1102,0x1103,0x1104,0x1120,0x1121, + 0x1122,0x1123,0x1124,0x1140,0x1131,0x1132,0x1133,0x1134,0x1140,0x1141,0x1142,0x1143,0x1144,0x1150,0x1151,0x1152, + 0x1153,0x1154, + ### + 0x8100,0x8101,0x8110,0x8111 + ); + + foreach my $p (0..3) { + foreach my $s (0..5) { + foreach my $m (0..15) { + next if($p==0 && $m >=14); + my $address = 0x2000 + $p*0x100 + $s*0x10 + $m; + push (@mdc_boards, $address); + } + } + } + + foreach my $mdc_sec (@QA::mdc_chambers_removed) { + foreach my $m (0..15) { + next if($mdc_sec<0x10 && $m >=14); + my $address = 0x2000 + $mdc_sec*0x10 + $m; + push (@QA::mdc_boards_removed, $address); + } + } + + my @rich_boards =(0x3000,0x3001,0x3002,0x3003,0x3004,0x3010,0x3011,0x3012,0x3013,0x3014,0x3020, + 0x3021,0x3022,0x3023,0x3024,0x3030,0x3031,0x3032,0x3033,0x3034,0x3040,0x3041, + 0x3042,0x3043,0x3044,0x3050,0x3051,0x3052,0x3053,0x3054,0x8300,0x8301,0x8310, + 0x8311,0x8320,0x8321); + + + my @tof_boards =(0x4c00,0x4c10,0x4c20,0x4c30,0x4c31,0x4c40,0x4c50,0x8600,0x8601); + + my @rpc_boards =(0x4800,0x4801,0x4802,0x4803,0x4810,0x4811,0x4812,0x4813,0x4820,0x4821,0x4822, + 0x4823,0x4830,0x4831,0x4832,0x4833,0x4840,0x4841,0x4842,0x4843,0x4850,0x4851, + 0x4852,0x4853,0x8400,0x8401,0x8410,0x8411); + + my @other_boards =( + #shower + 0x3200,0x3201,0x3202,0x3210,0x3211,0x3212,0x3220,0x3221,0x3222,0x3230,0x3231,0x3232,0x3240,0x3241,0x3242, + 0x3250,0x3251,0x3252, + #shower-hub + 0x8500,0x8501, + #cts + 0x0002,0x0003, + #central hub + 0x8000,0x8001, + #start/veto + 0x4000, + #start/veto hub + 0x8800,0x8801, + #fw + 0x4400,0x4410,0x4420, + #fw hub + 0x8700,0x8701 + ); + + ###strip the register value + for (my $k = 0; $k < scalar @result; $k += 2) { + push @all_boards, $result[$k]; + } + + ###mdc + my(%mdc_mask, @mdc_results); + $mdc_results[$_] = [] foreach (0 .. 7); + foreach my $element (@all_boards) { $mdc_mask{$element} |= 1 } + foreach my $element (@mdc_boards) { $mdc_mask{$element} |= 2 } + foreach my $element (@QA::mdc_boards_removed) { $mdc_mask{$element} |= 4 } + foreach my $element (keys %mdc_mask) { + push @{$mdc_results[0]}, sprintf("0x%x",$element); + push @{$mdc_results[$mdc_mask{$element}]}, sprintf("0x%x",$element); + } + + my $num_mdc_missing = (scalar @{$mdc_results[2]}); + my $num_mdc_mistake = (scalar @{$mdc_results[4]}); + my @sorted_mdc_results = sort @{$mdc_results[2]}; + + my $title = "MDC system"; + my $value = "OK"; + if ($num_mdc_missing > 0) {$value = "$num_mdc_missing missing";} + if ($num_mdc_mistake > 0) {$value = "Check Script";} + my $longtext = ""; + if ($num_mdc_missing > 0) {$longtext = "Endp @sorted_mdc_results missing"}; + if ($num_mdc_mistake > 0) {$longtext .= " Endp @{$mdc_results[4]} not known";} + + + my $qastate = QA::GetQAState('below',$num_mdc_missing,@QA::MdcEndpMissingLimits); + Hmon::Speak('mdcmiss',"$num_mdc_missing MDC Frontends missing") if($qastate > 60); + QA::WriteQALog($flog,"endp","mdc",$waittime,$qastate,$title,$value,$longtext); + if($qastate > 60) { + system("logger -p local1.info -t DAQ Endp \\ $longtext") unless (($timecnt->{mdc}++)%$loggerperiod); + } + else {$timecnt->{mdc} = 0;} + + ###rich + my(%rich_mask, @rich_results); + $rich_results[$_] = [] foreach (0 .. 7); + foreach my $element (@all_boards) { $rich_mask{$element} |= 1 } + foreach my $element (@rich_boards) { $rich_mask{$element} |= 2 } + foreach my $element (@QA::rich_boards_removed) { $rich_mask{$element} |= 4 } + foreach my $element (keys %rich_mask) { + push @{$rich_results[0]}, sprintf("0x%x",$element); + push @{$rich_results[$rich_mask{$element}]}, sprintf("0x%x",$element); + } + + my $num_rich_missing = (scalar @{$rich_results[2]}); + my $num_rich_mistake = (scalar @{$rich_results[4]}); + my @sorted_rich_results = sort @{$rich_results[2]}; + + my $rich_title = "RICH system"; + my $rich_value = "OK"; + if ($num_rich_missing > 0) {$rich_value = "$num_rich_missing missing";} + if ($num_rich_mistake > 0) {$rich_value = "Check Script";} + my $rich_longtext = ""; + if ($num_rich_missing > 0) {$rich_longtext = "Endp @sorted_rich_results missing"}; + if ($num_rich_mistake > 0) {$rich_longtext .= " Endp @{$rich_results[4]} not known";} + + $qastate = QA::GetQAState('below',$num_rich_missing,@QA::RichEndpMissingLimits); + Hmon::Speak('richmiss',"$num_rich_missing Rich Frontends missing") if($qastate > 60); + QA::WriteQALog($flog,"endp","rich",$waittime,$qastate, + $rich_title,$rich_value,$rich_longtext); + if($qastate > 60) { + system("logger -p local1.info -t DAQ Endp \\ $rich_longtext") unless (($timecnt->{rich}++)%$loggerperiod); + } + else {$timecnt->{rich} = 0;} + + + ###tof + my(%tof_mask, @tof_results); + $tof_results[$_] = [] foreach (0 .. 7); + foreach my $element (@all_boards) { $tof_mask{$element} |= 1 } + foreach my $element (@tof_boards) { $tof_mask{$element} |= 2 } + foreach my $element (@QA::tof_boards_removed) { $tof_mask{$element} |= 4 } + foreach my $element (keys %tof_mask) { + push @{$tof_results[0]}, sprintf("0x%x",$element); + push @{$tof_results[$tof_mask{$element}]}, sprintf("0x%x",$element); + } + + my $num_tof_missing = (scalar @{$tof_results[2]}); + my $num_tof_mistake = (scalar @{$tof_results[4]}); + my @sorted_tof_results = sort @{$tof_results[2]}; + + my $tof_title = "TOF system"; + my $tof_value = "OK"; + if ($num_tof_missing > 0) {$tof_value = "$num_tof_missing missing";} + if ($num_tof_mistake > 0) {$tof_value = "Check Script";} + my $tof_longtext = ""; + #if ($num_tof_missing > 0) {$tof_longtext = "Endp @{$tof_results[2]} missing"}; + if ($num_tof_missing > 0) {$tof_longtext = "Endp @sorted_tof_results missing"}; + if ($num_tof_mistake > 0) {$tof_longtext .= " Endp @{$tof_results[4]} not known";} + + $qastate = QA::GetQAState('below',$num_tof_missing,@QA::TofEndpMissingLimits); + Hmon::Speak('tofmiss',"$num_tof_missing Tof Frontends missing") if($qastate > 60); + QA::WriteQALog($flog,"endp","tof",$waittime,$qastate, + $tof_title,$tof_value,$tof_longtext); + if($qastate > 60) { + system("logger -p local1.info -t DAQ Endp \\ $tof_longtext") unless (($timecnt->{tof}++)%$loggerperiod); + } + else {$timecnt->{tof} = 0;} + + + ###rpc + my(%rpc_mask, @rpc_results); + $rpc_results[$_] = [] foreach (0 .. 7); + foreach my $element (@all_boards) { $rpc_mask{$element} |= 1 } + foreach my $element (@rpc_boards) { $rpc_mask{$element} |= 2 } + foreach my $element (@QA::rpc_boards_removed) { $rpc_mask{$element} |= 4 } + foreach my $element (keys %rpc_mask) { + push @{$rpc_results[0]}, sprintf("0x%x",$element); + push @{$rpc_results[$rpc_mask{$element}]}, sprintf("0x%x",$element); + } + + my $num_rpc_missing = (scalar @{$rpc_results[2]}); + my $num_rpc_mistake = (scalar @{$rpc_results[4]}); + my @sorted_rpc_results = sort @{$rpc_results[2]}; + + my $rpc_title = "RPC system"; + my $rpc_value = "OK"; + if ($num_rpc_missing > 0) {$rpc_value = "$num_rpc_missing missing";} + if ($num_rpc_mistake > 0) {$rpc_value = "Check Script";} + my $rpc_longtext = ""; + if ($num_rpc_missing > 0) {$rpc_longtext = "Endp @sorted_rpc_results missing"}; + if ($num_rpc_mistake > 0) {$rpc_longtext .= " Endp @{$rpc_results[4]} not known";} + + $qastate = QA::GetQAState('below',$num_rpc_missing,@QA::RpcEndpMissingLimits); + Hmon::Speak('rpcmiss',"$num_rpc_missing RPC Frontends missing") if($qastate > 60); + QA::WriteQALog($flog,"endp","rpc",$waittime,$qastate, + $rpc_title,$rpc_value,$rpc_longtext); + if($qastate > 60) { + system("logger -p local1.info -t DAQ Endp \\ $rpc_longtext") unless (($timecnt->{rpc}++)%$loggerperiod); + } + + ###other + my(%other_mask, @other_results); + $other_results[$_] = [] foreach (0 .. 7); + foreach my $element (@all_boards) { $other_mask{$element} |= 1 } + foreach my $element (@other_boards) { $other_mask{$element} |= 2 } + foreach my $element (@QA::other_boards_removed) { $other_mask{$element} |= 4 } + foreach my $element (keys %other_mask) { + push @{$other_results[0]}, sprintf("0x%x",$element); + push @{$other_results[$other_mask{$element}]}, sprintf("0x%x",$element); + } + + my $num_other_missing = (scalar @{$other_results[2]}); + my $num_other_mistake = (scalar @{$other_results[4]}); + my @sorted_other_results = sort @{$other_results[2]}; + + my $other_title = "Sh/FW/S/V/CTS"; + my $other_value = "OK"; + if ($num_other_missing > 0) {$other_value = "$num_other_missing missing";} + if ($num_other_mistake > 0) {$other_value = "Check Script";} + my $other_longtext = ""; + if ($num_other_missing > 0) {$other_longtext = "Endp @sorted_other_results missing"}; + if ($num_other_mistake > 0) {$other_longtext .= " Endp @{$other_results[4]} not known";} + + + $qastate = QA::GetQAState('below',$num_other_missing,@QA::OtherEndpMissingLimits); + Hmon::Speak('othermiss',"$num_other_missing Frontends missing") if($qastate > 60); + QA::WriteQALog($flog,"endp","other",$waittime,$qastate, + $other_title,$other_value,$other_longtext); + if($qastate > 60) { + system("logger -p local1.info -t DAQ Endp \\ $other_longtext") unless (($timecnt->{oth}++)%$loggerperiod); + } + else {$timecnt->{oth} = 0;} + + sleep(5); +} diff --git a/hmon/hmon_eventrate.pl b/hmon/hmon_eventrate.pl new file mode 100755 index 0000000..bf45792 --- /dev/null +++ b/hmon/hmon_eventrate.pl @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Hmon; + +my $str = ""; + + +$str = Hmon::MakeTitle(9,8,"Event Rates",0); +#$str .= "\n#ADDFILE files/eventratehist.svg\n"; +$str .= "\n"; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("eventrate",$str); + +$str = Hmon::MakeTitle(9,7,"Event Rates",0); +#$str .= "\n#ADDFILE files/eventratehist.svg\n"; +$str .= "\n"; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("eventratelong",$str); + +$str = Hmon::MakeTitle(9,8,"Event Rates",0); +#$str .= "\n#ADDFILE files/eventratehist.svg\n"; +$str .= "\n"; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("eventrateshort",$str); + +my $f = fork(); +if($f) { + qx(./hmon_hadplotnew.sh -d 50 -o 20 -n 1200 -yscale 1000 -yoverflow 65.536 -ytitle "Event Rate [kHz]" -xtitle "" -output "PNG.files/eventratehist.700.365" eventrate); + } +else { + my $g = fork(); + if($g) { + qx(./hmon_hadplotnew.sh -d 400 -o 5 -n 1500 -yscale 1000 -yoverflow 65.536 -ytitle "Event Rate [kHz]" -xtitle "" -output "PNG.files/eventratehistlong.700.315" eventrate); + } + else{ + qx(./hmon_hadplotnew.sh -d 10 -o 50 -n 1000 -yscale 1000 -yoverflow 65.536 -ytitle "Event Rate [kHz]" -xtitle "" -output "PNG.files/eventratehistshort.700.365" eventrate); + } + } + diff --git a/hmon/hmon_filllevel.pl b/hmon/hmon_filllevel.pl new file mode 100755 index 0000000..527d45c --- /dev/null +++ b/hmon/hmon_filllevel.pl @@ -0,0 +1,52 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die trb_strerror(); + +my $fqa = QA::OpenQAFile(); + +while (1) { + my $msg = ""; + my $cnt = 0; + + + my $data_oep = trb_register_read(0xfffd, 0x7100) or sleep 5 and next; + my $data_shw = trb_register_read_mem(0xfff7, 0x7100,0,6) or sleep 5 and next; + my $data_trb = trb_register_read(0xffef, 0x7100) or sleep 5 and next; + my $data_lvl1 = trb_register_read(0x3000, 0x1) or sleep 5 and next; + +# print Dumper $data_trb; + + my $maxoep = 0; + foreach my $o (values %$data_oep) { + if (($o & 0xFFFF ) > $maxoep) { + $maxoep = $o & 0xFFFF; + } + } + + my $maxshw = 0; + foreach my $o (values %$data_shw) { + for my $i (0..5) { + if (($o->[$i] & 0xFFFF) > $maxshw) { + $maxshw = $o->[$i] & 0xFFFF; + } + } + } + + my $maxtrb = 0; + my $i = 0; + foreach my $o (values %$data_trb) { + if (($o & 0xFFFF) > $maxtrb) { + $maxtrb = $o & 0xFFFF; + } + } + +# print("$maxoep, $maxshw, $maxtrb\n"); + + sleep(10); + } \ No newline at end of file diff --git a/hmon/hmon_gberate.pl b/hmon/hmon_gberate.pl new file mode 100755 index 0000000..5128499 --- /dev/null +++ b/hmon/hmon_gberate.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl -w + +use Hmon; + +my $str; + + $str = Hmon::MakeTitle(6,6,"GbE Data Rates",0); +# $str .= "\n"; +# $str .= "\n#ADDFILE files/gberate.svg\n"; + $str .= "\n"; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("GbeRate",$str); + + +system('./hmon_hadplot.sh -yscale 1024 -yoverflow 4096 -ytitle "Data Rate [MiB]" -ymax 52 -output "PNG.files/gberate.460.265" gberate &'); + + +# diff --git a/hmon/hmon_hadplot.sh b/hmon/hmon_hadplot.sh new file mode 100755 index 0000000..d1e9277 --- /dev/null +++ b/hmon/hmon_hadplot.sh @@ -0,0 +1,1455 @@ +#!/usr/bin/perl -w +use warnings; + +use FileHandle; +use Time::HiRes qw( gettimeofday usleep time ); +use Getopt::Long; +use Data::Dumper; +use POSIX qw/floor strftime/; + +use constant AXISISTIME => 1; +use constant AXISISNOTIME => 0; +use constant DIFFY => 1; +use constant DIFFX => 1; +use constant NODIFFY => 0; +use constant NODIFFX => 0; +use constant NODELAY => 0; +use constant NO => 0; +use constant YES => 1; +use constant NONEWLINE => 1; + +my $GPbuffer = ""; +my $buffercount = 0; + +my $windowtitle = ""; #Global var to store real name of GUI window + +my $PlotBuffer = {}; +my $PlotBufferCnt = 0; + +my @PlotBufArr = (); + +#my @color = ("#1155bb","#bb1111","#999900","#660000","#006633","#990066","#6633CC","#00CCCC"); +my @color = ("#2222dd","#880000","#00cc00","#ee00dd","#ffcc00","#00cc88","#6633CC","#00CCCC"); +our $write2file = ""; +our $plotendedbefore = 0; + + + +################################################# +# Variables... +################################################# +my $delay = 1000; +my $samples = 100; +my $downscale = 1; +# my $system = 0; +my $address = []; +my $register = []; +my $regoffset = []; +my $regwidth = []; +my $title = []; +my $timeref = []; +my $geom = "700x400"; +my $style = 0; +my $nametmp = ""; +my $regamount = []; +my $xscale = []; +my $yscale = []; +my $xtitle = ""; +my $ytitle = ""; +my $windowname = "No Name"; +my $xistime = AXISISNOTIME; +my $xoverflow = []; +my $yoverflow = []; +my $ydiff = 0; +my $outputcfg = ""; +my $name = "HadPlot"; +my $key ; +my $curvestyle= 'points'; #points, steps, histo or histostacked +my $xticks = 0; #show labels on x-axis +my $yticks = 1; #show labels on y-axis +my $plotoption= ""; #string with additional gnuplot commands +my $curveoption= []; #options for plot command +my $xgrid = 1; +my $ygrid = 1; +my $ymax; +my $ymin; +my $xmin; +my $xmax; + +GetOptions('d=i' => \$delay, + 'n=i' => \$samples, + 'o=i' => \$downscale, + 'a=s' => $address, + 'r=s' => $register, + 'w=i' => $regwidth, + 'p=i' => $regoffset, + 't=s' => $title, + 'm=i' => $regamount, + 'g=s' => \$geom, + 'z=i' => \$style, + 'output=s' => \$outputcfg, + 'windowname=s' => \$windowname, + 'xscale=f' => $xscale, + 'yscale=f' => $yscale, + 'xtitle=s' => \$xtitle, + 'ytitle=s' => \$ytitle, + 'xistime!' => \$xistime, + 'timeref=s' => $timeref, + 'xoverflow=f' => $xoverflow, + 'yoverflow=f' => $yoverflow, + 'ydiff!' => \$ydiff, + 'name=s' => \$name, + 'key!' => \$key, + 'xticks!' => \$xticks, + 'yticks!' => \$yticks, + 'xgrid!' => \$xgrid, + 'ygrid!' => \$ygrid, + 'ymax=i' => \$ymax, + 'ymin=i' => \$ymin, + 'xmax=i' => \$xmax, + 'xmin=i' => \$xmin, + 'curvestyle=s' => \$curvestyle, + 'curveoption=s'=> $curveoption, + 'plotoption=s' => \$plotoption + ); + +for(my $i=0;$i<16;$i++) { + $regoffset->[$i] = 0 unless defined $regoffset->[$i]; + $regwidth->[$i] = 32 unless defined $regwidth->[$i]; + $xoverflow->[$i] = 2**20 unless defined $xoverflow->[$i]; + $yoverflow->[$i] = 2**32 unless defined $yoverflow->[$i]; + $xscale->[$i] = 1 unless defined $xscale->[$i]; + $yscale->[$i] = 1 unless defined $yscale->[$i]; + $title->[$i] = "" unless defined $title->[$i]; + $curveoption->[$i] = "" unless defined $curveoption->[$i]; + } + +for(my $i=0;$i < scalar @{$address};$i++) { + if(!defined($title->[$i])) { + $title->[$i] = hex($address->[$i])." $register->[$i] $regoffset->[$i]..".($regoffset->[$i]+$regwidth->[$i]-1); + } + } + + +$delay *= 1000; +if($style == 1) {$curvestyle="points"; $xticks=1;} +if($style == 2) {$curvestyle="histo"; $xticks=0;} +if($style == 3) {$curvestyle="histo"; $xticks=1;} +if($style == 4) {$curvestyle="histostacked"; $xticks=0;} +if($style == 5) {$curvestyle="histostacked"; $xticks=1;} + + + +#Open Gnuplot +our $fh; +my $fn = "gnuplot -geometry $geom -bg 'ghost white'"; +$fh = new FileHandle ("|$fn") or die "error: no gnuplot"; +$fh->autoflush(1); + + +sub makeTimeString{ + return strftime("set label 100 \"%H:%M:%S\" at screen 0.02,0.02 left tc rgb \"#000044\" font \"monospace,8\"\n", localtime()) + } + +################################################# +# When exiting, close Gnuplot window +################################################# +sub finish { + print $fh "exit;\n"; + close $fh; + exit; +} + +$SIG{INT} = \&finish; +$SIG{PIPE} = \&finish; + + + +my $last_wakeup; + +sub max { + my $a = shift; + my $b = shift; + return $a > $b ? $a : $b; + } + +sub min { + my $a = shift; + my $b = shift; + return $a < $b ? $a : $b; + } + +sub usleep_total { + my $delay = shift; + if(defined $last_wakeup) { + my $time = time(); +# printf "%.0f\n",$delay-($time-$last_wakeup)*1E6; + usleep(max(0,$delay-($time-$last_wakeup)*1E6)); + } + else { + usleep($delay); + } + $last_wakeup = time(); + return $last_wakeup; + } + + +################################################# +# Write to gnuplot +################################################# +sub plot_write { + my ($str,$no) = @_; + if(defined($no) && $no) { + print $fh $str; +# print $str; + } + else { + print $fh $str."\n"; +# print $str."\n"; + } + } + +sub plot_add { + my ($x,$y) = @_; + $x = $x || $PlotBufferCnt; + $PlotBufArr[$PlotBufferCnt]->{x} = $x; + $PlotBufArr[$PlotBufferCnt]->{y} = $y; + + $PlotBufferCnt++; +# $PlotBuffer->{$x} = $y; +# print $x." ".$y."\n"; + } + +sub plot_end { + my ($single) = @_; + for(my $i = 0;$i{y}."\n"; + } + else { + print $fh $PlotBufArr[$i]->{x}." ".$PlotBufArr[$i]->{y}."\n"; + } + } +# foreach my $line (sort keys %{$PlotBuffer}) { +# if($single) { +# print $fh $PlotBuffer->{$line}."\n"; +# # print "plot_end: ".$PlotBuffer->{$line}."\n"; +# } +# else { +# print $fh $line." ".$PlotBuffer->{$line}."\n"; +# # print "plot_end: ".$line." ".$PlotBuffer->{$line}."\n"; +# } +# } + @PlotBufArr = (); + $PlotBuffer = {}; + $PlotBufferCnt = 0; + print $fh "e\n"; + $plotendedbefore = 1 unless $plotendedbefore; + } + + +sub plot_reset { + if($write2file eq ""){ + system("xwininfo -name '$windowtitle' >/dev/null 2>/dev/null"); + #print $?."\n"; + if($? != 0) { + usleep(1E5); + system("xwininfo -name '$windowtitle' >/dev/null 2>/dev/null"); + if($? != 0) { + finish(); + } + } + if ($plotendedbefore != 0) { + $plotendedbefore = 0; +# my $datestring = makeTimeString(); + print $fh makeTimeString(); + print $fh "replot\n"; + } + } + else { + if ($plotendedbefore != 0) { + system("mv $write2file.tmp $write2file"); + plot_write("set out \"$write2file.tmp\"\n"); + $plotendedbefore = 0; +# my $datestring = makeTimeString(); + print $fh makeTimeString(); + print $fh "replot\n"; + +# print "reset\n"; + } + } + } + +sub plot_finished { + my ($store) = @_; + if($write2file ne "") { + if(defined $store) { + if($store->{"initing"} != 2 and $store->{"iteration"} % $store->{"downscale"} == 0) { +# system("mv $write2file.tmp $write2file"); + } + } + else { + if($write2file ne "") { +# system("mv $write2file.tmp $write2file"); + } + } + } + } + +sub plot_init { + my ($xtics) = @_; + $windowtitle = $name ." - ".$windowname; + if ($outputcfg =~ m$PNG.([/\w]*).(\d+).(\d+)$) { + print "Writing PNG to file $1\n"; + $write2file = $1.".png"; + plot_write("set term png size $2,$3 font \"monospace,8\""); + plot_write("set out \"$write2file.tmp\""); + } + elsif ($outputcfg =~ m$SVG.([/\w]*).(\d+).(\d+)$) { + print "Writing SVG to file $1\n"; + $write2file = $1.".svg"; + plot_write("set term svg size ".($2*2).",".($3*2)." dynamic font \"monospace,18\" lw 1.5 \n"); + plot_write("set out \"$write2file.tmp\"\n"); + } + else { + plot_write("set term x11 title '$windowtitle'"); + } + plot_write("set grid"); + plot_write("set xlabel \"$xtitle\""); + plot_write("set ylabel \"$ytitle\""); + + plot_write(makeTimeString()); + + if(defined $xtics) { + plot_write("set xtics $xtics\n"); + } + if(defined $xmin && defined $xmax) { + plot_write("set xrange [$xmin:$xmax]"); + } + if(defined $ymin && defined $ymax) { + plot_write("set yrange [$ymin:$ymax]"); + } + elsif(defined $ymax) { + plot_write("set yrange [:$ymax]"); + } + elsif(defined $ymin) { + plot_write("set yrange [$ymin:]"); + } + if (!defined $key || $key == 0) { + plot_write("unset key"); + } + if($xgrid == 0) { + plot_write("set grid noxtics"); + } + if($ygrid == 0) { + plot_write("set grid noytics"); + } + if($plotoption ne "") { + plot_write($plotoption); + } + } + +sub plot_sleep { + my ($delay) = @_; + my $t = usleep_total($delay); + plot_reset(); + return $t; + } + +sub plot_end_sleep { + my ($delay,$single) = @_; + plot_end($single); + return plot_sleep($delay); + } + +sub plot_storage_end_sleep { + my ($store, $single) = @_; + my $delay = $store->{"delay"}; + my $t; + if($store->{"initing"} == 0) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_end($single); + $t = usleep_total($delay); + plot_reset(); + } + else { + $t = usleep_total($delay); + } + } + return $t; + } + +sub plot_storage_sleep { + my ($store,$noreset) = @_; + my $t; + my $delay = $store->{"delay"}; + #print $store->{"initing"}.$store->{"iteration"}.$store->{"downscale"}."\n"; + if($store->{"initing"} != 2) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + $t = usleep_total($delay); + plot_storage_reset() unless $noreset; + } + else { + $t = usleep_total($delay); + } + } + return $t; + } + +sub plot_storage_reset { + my ($store) = @_; + if(defined $store->{"initing"} && $store->{"initing"} != 2) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_reset(); + } + } + } + +sub plot_storage_end { + my ($store) = @_; + if($store->{"initing"} == 0) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_end(); + } + } + } + +################################################# +# Writes a new value pair to storage +################################################# +sub store_push { + my ($storage,$x,$y,$divtime) = @_; + my $xval = $x; + my $yval = $y; + my $curtime = time(); + + if ($storage->{"initing"} != 2) { + if (scalar(@{$storage->{"datax"}}) == $storage->{"size"}) { + my $tmp = shift(@{$storage->{"datax"}}); + my $tmpy = shift(@{$storage->{"datay"}}); + $storage->{"totalx"} -= $tmp; +# if($storage->{"initing"} == 0 && (($tmpy <= $storage->{"miny"}) || ($tmpy >= $storage->{"maxy"}))) { +# store_calc_range($storage); +# } + } + if($storage->{"diffx"}) { + if(defined($storage->{"xmax"}) && $x < $storage->{"lastx"}) { + $xval = ($x - $storage->{"lastx"} + $storage->{"xmax"}); + } + else { + $xval = ($x - $storage->{"lastx"}); + } + if(defined($storage->{"last_push"}) && $storage->{"last_push"} != 0) { + while (floor($xval/$storage->{"xmax"}) < floor(($curtime - $storage->{"last_push"})/($storage->{"xmax"}/1E6))){ + $xval += $storage->{"xmax"}; + } + } + } + if($storage->{"diffy"}) { + $yval = $y - $storage->{"lasty"}; + if(defined($storage->{"ymax"}) && $y < $storage->{"lasty"}) { + while($yval < 0) { + $yval += $storage->{"ymax"}; + } + } + if($divtime) { + $yval /= ($xval?$xval:1)/1000000; + } + } + + + if($storage->{"initing"} == 1) { + $storage->{"initing"} = 0; + for(my $i = $storage->{"size"}-1; $i>0; $i--) { + push(@{$storage->{"datax"}},$storage->{"delay"}); + push(@{$storage->{"datay"}},$yval); + $storage->{"totalx"} += $storage->{"delay"}; + } + } + + push(@{$storage->{"datax"}},$xval?$xval:0); + push(@{$storage->{"datay"}},$yval?$yval:0); + $storage->{"totalx"} += $xval?$xval:0; + } + else { + $storage->{"initing"} = 1; + } + + $storage->{"last_push"} = $curtime; + $storage->{"lasty"} = $y; + $storage->{"lastx"} = $x; + } + +################################################# +# Writes storage contents to stream +################################################# +sub store_print { + my $str = ""; + my ($storage) = @_; + if($storage->{"initing"} != 2) { + if($storage->{"iteration"} % $storage->{"downscale"} == 0) { + my $xcnt = - $storage->{"totalx"} /1000000.0; + for (my $i = 0; $i < $storage->{"size"}; $i++) { + my $xval = $storage->{"datax"}->[$i]; #${}[] + my $yval = $storage->{"datay"}->[$i]; + $xval = 0 unless defined($xval); + $yval = 0 unless defined($yval); + $xcnt += $xval/1000000.0; +# $str .= $xcnt." ".$yval."\n"; + $str .= sprintf "%.3f %.2f\n", $xcnt,$yval; + #plot_write($xcnt/1000000.0." ".$yval); + } + plot_write($str,1); +# print $str; + plot_end(1); + } + $storage->{"iteration"}++; + } + } + + +################################################# +# Initialize storage +################################################# +sub store_init { + my ($storage,$size,$diffx,$diffy,$delay,$downscale,$xmax,$ymax) = @_; + + $storage->{"datax"} = []; + $storage->{"datay"} = []; + $storage->{"size"} = $size; + $storage->{"diffx"} = $diffx; + $storage->{"diffy"} = $diffy; + $storage->{"delay"} = $delay; + $storage->{"downscale"} = $downscale; + $storage->{"initing"} = 2; + $storage->{"iteration"} = 0; + $storage->{"totalx"} = 0; + $storage->{"xmax"} = $xmax; + $storage->{"ymax"} = $ymax; + $storage->{"maxy"} = 0; + $storage->{"miny"} = 1E100; + $storage->{"last_push"} = 0; + $storage->{"last_sleep"} = 0; + } + +################################################# +# Help Message +################################################# +sub help { + print <[$i])) || ($title->[$i] eq "")) { +# $title->[$i] = hex($address->[$i])." ".$register->[$i]." ".$regoff->[$i]."..".($regoff->[$i]+$regwidth->[$i]-1); +# } + if (!(defined $regamount->[$i])) { + $regamount->[$i] = 1; + } + } + $ymin = $regoff->[0]; + $ymax = $regoff->[0]+$regwidth->[0]; + plot_init(256); +# if ($style == 0) { +# plot_write("plot",1); +# for(my $i = 0; $i[$i]\" ",1); +# plot_write(", ",1) unless $i == scalar(@{$address})-1; +# } +# plot_write(""); +# } +# elsif($style == 1) { + plot_write("set xtics rotate by 90 offset .7,-2 scale 0 "); + plot_write("set style fill solid 1.00 border -1"); + plot_write("set boxwidth 1 absolute"); + plot_write("unset key"); + plot_write('set format x "%x"'); + plot_write("plot ",1); + for(my $i = 0; $i[$i]\" ",1); #using 2:xticlabels(1) + plot_write(", ",1) unless $i == scalar(@{$address})-1; + } + plot_write(""); +# } + while(1) { + for(my $i = 0; $i[$i] == 1) { + $c = "trbcmd r $address->[$i] $register->[$i] | sort"; + } + else { + $c = "trbcmd rm $address->[$i] $register->[$i] $regamount->[$i] 0"; + } + my @out = qx($c); + my $addr = undef; + my $cnt = 0; + foreach my $s (@out) { + if($s =~ /^H:\s*0x(\w\w\w\w)/) { + $addr = $1; + } + if($s =~ /^0x(\w\w\w\w)\s*0x(\w{8})/) { + $addr = hex($1) if($regamount->[$i] == 1); + if ($regamount->[$i] == 1) { plot_add($addr,-1); } + else { plot_add("\"$addr.$1\"",-1); } + for(my $j = $regoff->[$i]; $j < $regoff->[$i] + $regwidth->[$i];$j++) { + if(hex($2) & (1<<$j)) { + if ($regamount->[$i] == 1) { plot_add("$addr",$j); } + else { plot_add("\"$addr.$1\"",$j); } + } + } + $cnt++; + } + } + plot_end(1); + } + plot_sleep($delay); + } + } + + + +################################################# +# Generic Register differences +################################################# +sub genreg { + my %oldvals; + + plot_init(undef); + + if($xticks) { + plot_write("set xtics rotate by 90 offset .7,-1.7 scale .7 "); + } + if($curvestyle eq "histo") { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set boxwidth 2 absolute"); + } + elsif($curvestyle eq "histostacked") { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set style histogram rowstacked"); + plot_write("set boxwidth 1 absolute"); + plot_write("set key outside") unless defined $key && $key==0; + plot_write("set autoscale xfix "); + } + + plot_write("plot",1); + for(my $i = 0; $i[$i]\" ",NONEWLINE); + } + elsif ($curvestyle eq "steps") { + plot_write("with histeps title \"$title->[$i]\" ",NONEWLINE); + } + else { + plot_write("with points pt 5 title \"$title->[$i]\" ",NONEWLINE); + } + plot_write(" ".$curveoption->[$i],NONEWLINE); + plot_write(", ",NONEWLINE) unless $i == scalar(@{$address})-1; + } + plot_write(""); + + + while(1) { + for(my $i = 0; $i[$i]) || $regamount->[$i] == 1) { + $c = "trbcmd r $address->[$i] $register->[$i] | sort"; + } + else { + $c = "trbcmd rm $address->[$i] $register->[$i] $regamount->[$i] 0"; + } + my @out = qx($c); + my $addr = undef; + foreach my $s (@out) { + if($s =~ /^H:\s*0x(\w\w\w\w)/) { + $addr = $1; + $cnt = -1; + } + if($s =~ /^0x(\w{4})\s*0x(\w{8})/) { + my $tmp = (hex($2)>>$regoffset->[$i])&(2**$regwidth->[$i]-1); + my $val = 0; + my $board = $1; + if(defined $addr) {$board = $addr;} + $cnt++; + my $reg = $1; + if($ydiff) { + if(defined $oldvals{$i}->{$board.$reg}) { + if ($oldvals{$i}->{$board.$reg} > $tmp) { + $val = $tmp - $oldvals{$i}->{$board.$reg} + 2**$regwidth->[$i]; + } + else { + $val = $tmp - $oldvals{$i}->{$board.$reg}; + } + } + $oldvals{$i}->{$board.$reg} = $tmp; + } + else { + $val = $tmp; + } + if($xticks) { + if (!(defined $regamount->[$i]) || $regamount->[$i] == 1) { + plot_add("\"$board\"",$val/($yscale->[$i]||1)); + } + else { + plot_add("\"$board.$reg\"",$val/($yscale->[$i]||1)); + } + } + else { + plot_add("",$val/($yscale->[$i]||1)); + } + } + } + plot_end(!$xticks); + } + plot_sleep($delay); + } + } + +################################################# +# Generic Histogram +################################################# +sub genhist { + my %storearr; + my %oldvals; +# $xtitle = "Time [s]" unless $xtitle ne ""; + plot_init(); + plot_write("set autoscale fix"); + plot_write("plot",1); + $diff = 0 unless defined($diff); + for(my $i = 0; $i[$i],$yoverflow->[$i]); + plot_write("'-' with lines title \"$title->[$i]\" ",1); + plot_write(", ",1) unless $i == scalar(@{$address})-1; + } + plot_write(""); + + while(1) { + my $a, my $s, my $t; + my $val = 0 , my $time; + plot_storage_reset($storearr{0}); + for(my $i = 0; $i>($regoffset->[$i]))&(2**($regwidth->[$i])-1)); + $time = hex($t)*16; + } + } + store_push($storearr{$i},$time/$xscale->[$i],$val/($yscale->[$i]||1),AXISISTIME); + store_print($storearr{$i}); + } + plot_storage_sleep($storearr{0}); + plot_finished($storearr{0}); + } + } + +################################################# +# Deadtime histogram +################################################# +sub deadtimehist2 { + my %values, my %lastvalues, my %diffvalues; + my @keys = ("33","34","36","31","38","37","3b","35"); + my @keys2 = ("43","44","46","41","48","47","4b","45"); + my @names = ("MDC12","MDC34","TOF","RPC","RICH","SHW","Start","FW"); + my %storearr; + + if ($style != 0) { + for(my $i= 0; $i < scalar(@keys); $i++) { + $storearr{$keys[$i]} = {}; + store_init($storearr{$keys[$i]},$samples,0,0,$delay*.0,$downscale,2**32,2**32); + } + for(my $i= 0; $i < scalar(@keys2); $i++) { + $storearr{$keys2[$i]} = {}; + store_init($storearr{$keys2[$i]},$samples,0,0,$delay*.0,$downscale,2**32,2**32); + } + } + + plot_init(); + plot_write("set key left top Left"); + plot_write("set autoscale fix"); + plot_write("set yrange [-1:101]"); + + if ($style != 0) { + plot_write("plot ",1); + plot_write("\"-\" title \"MDC12\" with lines,",1); + plot_write("\"-\" title \"MDC34\" with lines,",1); + plot_write("\"-\" title \"TOF\" with lines,",1); + plot_write("\"-\" title \"RPC\" with lines,",1); + plot_write("\"-\" title \"RICH\" with lines,",1); + plot_write("\"-\" title \"SHW\" with lines,",1); + plot_write("\"-\" title \"Start\" with lines,",1); + plot_write("\"-\" title \"FW\" with lines"); + } + else { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set grid noxtics ytics"); + plot_write("set boxwidth 2 absolute"); + plot_write("set xtics ('MDC12' 0,'MDC34' 1,'TOF' 2, 'RPC' 3, 'RICH' 4, 'SHW' 5, 'Start' 6, 'FW' 7) offset 2,0 scale 0"); + plot_write("set style histogram title offset character 0, 0, 0"); + plot_write("set style data histograms"); + plot_write("plot \"-\" title 'incl. busy' lt rgb \"#1155bb\", \"-\" title 'excl. busy' lt rgb \"#bb1111\""); + } + my $cmd = sprintf("trbcmd -n-1 -s%d rmt 0x8001 0x4031 31 0",$delay/1000); + if($style != 0) { + $cmd = sprintf("trbcmd -n-1 -s%d rmt 0x8001 0x4031 12 0",$delay/1000); + } + open(FTRB, "$cmd|"); + + while(my $a = ) { + if($a =~ /^0x\w{2}(\w{2})\s*0x(\w{8})\s*0x(\w{4})/) { + $values{$1} = hex($2); + $values{"50"} = hex($3)*16; + } + if ($a eq "---\n") { + $diffvalues{"50"} = 1E6; + if (defined $lastvalues{"50"}) { + if ($values{"50"} > $lastvalues{"50"}) { + $diffvalues{"50"} = $values{"50"} - $lastvalues{"50"}; + } + else { + $diffvalues{"50"} = $values{"50"} - $lastvalues{"50"} + 2**20; + } + } + #$diffvalues{"50"} = $values{"50"} - $lastvalues{"50"} if defined $lastvalues{"50"}; + my $time = $diffvalues{"50"}; + foreach my $key (keys %values) { + next unless hex($key)<0x50; + $diffvalues{$key} = 0; + if (defined $lastvalues{$key}) { + if ($values{$key} >= $lastvalues{$key}) { + $diffvalues{$key} = $values{$key} - $lastvalues{$key}; + } + else { + $diffvalues{$key} = $values{$key} - $lastvalues{$key} + 2**32; + } + } + $diffvalues{$key} /= $time if $time; + #print $key." ".$values{$key}." ".$lastvalues{$key}." ".$diffvalues{$key}."\n"; + } + #print "=====\n"; + $diffvalues{"31"} = max($diffvalues{"31"},$diffvalues{"32"}); + $diffvalues{"38"} = max(max($diffvalues{"38"},$diffvalues{"39"}),$diffvalues{"3a"}); + if ($style == 0) { + $diffvalues{"41"} = max($diffvalues{"41"},$diffvalues{"42"}); + $diffvalues{"48"} = max(max($diffvalues{"48"},$diffvalues{"49"}),$diffvalues{"4a"}); + } + %lastvalues = %values; + if($style != 0) { + plot_storage_reset($storearr{$keys[0]}); + for(my $i= 0; $i < scalar(@keys); $i++) { + store_push($storearr{$keys[$i]},$time,$diffvalues{$keys[$i]},0); + store_print($storearr{$keys[$i]}); + } + plot_storage_sleep($storearr{$keys[0]},1); + plot_finished($storearr{$keys[0]}); + } + else { + plot_reset(); + for(my $i= 0; $i < scalar(@keys); $i++) { + plot_add("",$diffvalues{$keys[$i]}); #"\"".$names[$i]."\"", + } + plot_end(1); + for(my $i= 0; $i < scalar(@keys2); $i++) { + plot_add("",$diffvalues{$keys2[$i]}); #"\"".$names[$i]."\"", + } + plot_end(1); + plot_finished(); + } + } + } + } + + +################################################# +# Select Operation +################################################# + +if(!(defined $ARGV[0]) || $ARGV[0] =~ /help/) {help(); exit;} + +if($ARGV[0] =~ /oep5V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8010,0x8011]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [.5,.5]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["5.8V input","5V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep3.3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8012,0x8013]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["3.8V input","3.3V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep1.2V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8014,0x8015]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["1.8V input","1.2V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8016,0x8017]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["+3V input","-3V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oepminmaxp3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x801e,0x801e]; + $regwidth = [12,12]; + $regoffset = [0,16]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["+3V minimum","+3V maximum"]; + genreg(); + } + +if($ARGV[0] =~ /oepminmaxn3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x801f,0x801f]; + $regwidth = [12,12]; + $regoffset = [0,16]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["-3V minimum","-3V maximum"]; + genreg(); + } + +if($ARGV[0] =~ /oepminmax5Vin/) { + $address = [0xfffd,0xfffd,0xfffd]; + $register = [0x8018,0x8018,0x8010]; + $regwidth = [12,12,12]; + $regoffset = [0,16,0]; + $yscale = [.5,.5,.5]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["5Vin minimum","5Vin maximum","5Vin"]; + genreg(); + } + +if($ARGV[0] =~ /oeptemp/) { + oeptemp(($delay)?$delay:5000000,[$name." - OEP Temperature"]); + } + + +if($ARGV[0] =~ /rpcdatarate/) { + $delay = 1000000 unless $delay; + $xticks = 1 ; + $xtitle = "Sender ((Sector mod 3)*4+TRB)"; + $ytitle = "Data Words /1024"; + $windowname = "Data Words sent by RPC"; + $curvestyle = "histo"; + $key = YES; + $ydiff = DIFFY; + $ymin = 0; + $yscale = [512,512]; + $address = [0x8401,0x8411]; + $register = [0x4001,0x4001]; + $regamount = [12,12]; + $title = ["Sector 0,1,2","Sector 3,4,5"]; + $regoffset = [0,0]; + $regwidth = [32,32]; + genreg(); + } + +#hadplot -a 2 -r 1 -p 0 -w 16 -d 5 -o 200 -n 1000 -yoverflow 65536 genhistdiff + +if($ARGV[0] =~ /eventratehighres/) { + $delay = 5000 ; #unless $delay; + $samples = 1000; # unless $samples; + $downscale = 200;# unless $downscale; +# $style = 0 unless $style; + $windowname = "Eventrate High Resolution"; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $title = ["Event rate"]; + $address = [0x2]; + $register = [0x1]; + $regoffset = [0]; + $regwidth = [16]; + $yoverflow = [65536]; + genhist(); + } + + +if($ARGV[0] =~ /eventrate/) { + $address = [0x2]; + $register = [0x1]; + $regwidth = [16]; + $regoffset = [0]; + $timeref = [0x2]; + $delay = 100000 unless $delay; + $samples = 500 unless $samples; + $downscale = 10 unless $downscale; + $windowname = "Event rate history"; + $key = NO; + $ytitle = "Event rate [Hz]" if $ytitle eq ""; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $yoverflow = [2**16] unless $yoverflow->[0] != 2**32; + genhist(); + } + +if($ARGV[0] =~ /datarate/) { + $address = [0xff7f]; + $register = [0x83f3]; + $regwidth = [32]; + $regoffset = [0]; + $timeref = [0x8000]; + $delay = 100000 unless $delay; + $samples = 500 unless $samples; + $downscale = 5 unless $downscale; + $windowname = "Total data rate history"; + $xtitle = "Time [s]" unless defined $xtitle; + $ytitle = "Data rate [MiByte]" unless defined $ytitle; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $yoverflow = [2**12]; + $yscale = [2**20]; + $key = NO; + genhist(); + } + +if($ARGV[0] =~ /busytime/) { + $delay = 100000 unless $delay; + $samples = 100 unless $samples; + $downscale = 5 unless $downscale; + $style = 1; + $windowname = "Busytime history"; + deadtimehist2(); + } + +if($ARGV[0] =~ /busy/) { + $delay = 100000 unless $delay; + $style = 0; + $windowname = "Busy time"; + deadtimehist2(); + } + +if($ARGV[0] =~ /oepspikehist/) { + $delay = 100000 unless $delay; + $samples = 1000 unless $samples; + $downscale = 10 unless $downscale; +# $style = 0 unless $style; + $windowname = "OEP CMS Spikes"; + $ydiff = DIFFY; + $title = ["OEP CMS Spikes"]; + $address = [0xfffd]; + $register = [7]; + $regoffset = [0]; + $regwidth = [16]; + genhist(); + } + +if($ARGV[0] =~ /oepretrhist/) { + $delay = 500000 unless $delay; + $samples = 600 unless $samples; + $downscale = 2 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP Retransmissions"; + $ydiff = DIFFY; + $title = ["Retransmit Received","Retransmit Sent"]; + $address = [0xfffd,0xfffd]; + $register = [4,4]; + $regoffset = [16,24]; + $regwidth = [8,8]; + genhist(); + } + +if($ARGV[0] =~ /oeptokenmisshist/) { + $delay = 500000 unless $delay; + $samples = 2000 unless $samples; + $downscale = 4 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP Token Missing"; + $ydiff = DIFFY; + $title = ["Missing Tokens"]; + $address = [0xfffd]; + $register = [0x9101]; + $regoffset = [0]; + $regwidth = [24]; + genhist(); + } + + +if($ARGV[0] =~ /oeptrgerrhist/) { + $delay = 500000 unless $delay; + $samples = 2000 unless $samples; + $downscale = 2 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP CMS Errors"; + $ydiff = DIFFY; + $title = ["Spikes","Spurious","Invalid","Multiple"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [7,7,6,6]; + $regoffset = [0,16,0,16]; + $regwidth = [16,16,16,16]; + genhist(); + } + + +if($ARGV[0] =~ /histdiff/) { + $delay = 1000000 unless $delay; + $samples = 200 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $ydiff = DIFFY; + genhist(); + } + +if($ARGV[0] =~ /hist/) { + $delay = 1000000 unless $delay; + $samples = 200 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $ydiff = NODIFFY; + genhist(); + } + +if($ARGV[0] =~ /oepworktime/) { + $delay = 1000000 unless $delay; + $curvestyle = "histostacked"; + $xticks = 0 unless $xticks; + $ymax = $delay*1.1/1000; + $yscale = [1000]; + $xtitle = "OEP"; + $ytitle = "Time [ms]"; + $windowname = "OEP Trigger Handling Times"; + $ydiff = DIFFY; + $title = ["Readout","Waiting","Initialization","Calibration","Idle"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [0x9113,0x9114,0x9111,0x9112,0x9110]; + $regoffset = [0,0,0,0,0]; + $regwidth = [32,32,32,32,32]; + genreg(); + } + +if($ARGV[0] =~ /gberate/) { + $delay = 1000000 unless $delay; + $curvestyle = "histostacked"; + $xticks = 1 unless $xticks; + $xtitle = "Sender"; + $ytitle = "Data Rate (kiB)" if $ytitle eq ""; + $windowname = "Gbe Data Rate"; + $key = NO; + $ydiff = DIFFY; + $xgrid = NO; + $address = [0xff7f]; + $register = [0x83f3]; + $regoffset = [10]; + $regwidth = [22]; + genreg(); + } + +if($ARGV[0] =~ /oepwords/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Sender"; + $ytitle = "Data Words"; + $windowname = "Data Words sent by OEP"; + $yscale = [1]; + $key = NO; + $ydiff = DIFFY; + $address = [0xfffd]; + $register = [0x910B]; + $regoffset = [0]; + $regwidth = [32]; + genreg(); + } + + +if($ARGV[0] =~ /mdcchan/) { + $delay = 1000000 unless $delay; + $xticks = 1; + $xtitle = "Sender"; + $ytitle = "Data Words"; + $windowname = "Data words per TDC channel"; + $yscale = [1]; + $key = NO; + $ydiff = NODIFFY; + if ($ARGV[0] =~ /diff/) { + $ydiff = DIFFY; + } + $address = [$address->[0]?$address->[0]:0xfffd]; + $register = [0xc088]; + $regamount = [96]; + $regoffset = [0]; + $regwidth = [32]; + genreg(); + } + + +if($ARGV[0] =~ /regdiff/) { + $delay = 1000000 unless $delay; +# $xticks = 1 unless $xticks; + $ydiff = DIFFY; +# $key = NO unless defined $key; + $windowname = "General Plot" unless $windowname; + genreg(); + } + +if($ARGV[0] =~ /reg/) { + $delay = 1000000 unless $delay; +# $xticks = 1 unless $xticks; + $ydiff = NODIFFY; +# $key = NO unless defined $key; + $windowname = "General Plot" unless $windowname; + genreg(); + } + +if($ARGV[0] =~ /oeptrgerr/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "# of errors"; + $windowname = "OEP CMS Errors"; + $key = YES; + $ydiff = NODIFFY; + $title = ["Spikes","Spurious","Invalid","Multiple"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [7,7,6,6]; + $regoffset = [0,16,0,16]; + $regwidth = [16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /oepfill/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "OEP Buffer Fill Level"; + $key = NO; + $ydiff = NODIFFY; + $address = [0xfffd]; + $register = [0x7100]; + $regoffset = [0]; + $regwidth = [16]; + genreg(); + } + +if($ARGV[0] =~ /showerfill/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "Shower Data Buffer Fill Level"; + $key = $key || NO; + $ydiff = NODIFFY; + $address = [0xfff7,0xfff7,0xfff7,0xfff7,0xfff7,0xfff7]; + $register = [0x7100,0x7101,0x7102,0x7103,0x7104,0x7105]; + $regoffset = [0,0,0,0,0,0]; + $regwidth = [16,16,16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /filllevel/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "Front-end Data Buffer Fill Level"; + $key = NO; + $ydiff = NODIFFY; + $address = [0xffff,0xffff,0xffff,0xffff,0xffff,0xffff]; + $register = [0x7100,0x7101,0x7102,0x7103,0x7104,0x7105]; + $regoffset = [0,0,0,0,0,0]; + $regwidth = [16,16,16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /oepretr/) { + $delay = 1000000 unless $delay; + $windowname = "OEP Retransmissions"; + $key = YES; + $ydiff = NODIFFY; + $title = ["Retransmit Received","Retransmit Sent"]; + $address = [0xfffd,0xfffd]; + $register = [4,4]; + $regoffset = [16,24]; + $regwidth = [8,8]; + genreg(); + } + +if($ARGV[0] =~ /timecmslvl1/) { + $delay = 1000000 unless $delay; + $windowname = "Trigger Delay"; + $key = NO; + $ydiff = NODIFFY; + $ytitle = "Time between CMS and LVL1 [10ns]"; + $address = [0xfffd]; + $register = [2]; + $regoffset = [16]; + $regwidth = [11]; + genreg(); + } + +if($ARGV[0] =~ /oeptokenmiss/) { + $delay = 1000000 unless $delay; + $windowname = "OEP Token Missing"; + $key = NO; + $ydiff = NODIFFY; + $ytitle = "# of missing token"; + $address = [0xfffd]; + $register = [0x9101]; + $regoffset = [0]; + $regwidth = [24]; + genreg(); + } + +if($ARGV[0] =~ /slowcontrolrate/) { + $delay = 1000000 unless $delay; + $samples = 240 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $windowname = "Slow Control Data Rate"; + $ydiff = DIFFY; + $ytitle = "Slow Control Data / kByte/s"; + $address = [0x8000]; + $register = [0x4012]; + $regoffset = [0]; + $regwidth = [32]; + $yscale = [102.4]; + genhist(); + } + + + +if($ARGV[0] =~ /commonstatus/) { + bitmap(($delay)?$delay:1000000,[0xffff],[0],[1],[0],[20],["Common Status Bits"],0,$name." - Common Status Bit"); + } +if($ARGV[0] =~ /genbit/ || $ARGV[0] =~ /bitmap/) { + bitmap(($delay)?$delay:1000000,$address,$register,$regamount,$regoffset,$regwidth,$title,$style,$name." - ".$windowname); + } + diff --git a/hmon/hmon_hadplotnew.sh b/hmon/hmon_hadplotnew.sh new file mode 100755 index 0000000..f5f571a --- /dev/null +++ b/hmon/hmon_hadplotnew.sh @@ -0,0 +1,1449 @@ +#!/usr/bin/perl -w +use warnings; + +use FileHandle; +use Time::HiRes qw( gettimeofday usleep time ); +use Getopt::Long; +use Data::Dumper; +use POSIX qw/floor strftime/; +use HADES::TrbNet; + +use constant AXISISTIME => 1; +use constant AXISISNOTIME => 0; +use constant DIFFY => 1; +use constant DIFFX => 1; +use constant NODIFFY => 0; +use constant NODIFFX => 0; +use constant NODELAY => 0; +use constant NO => 0; +use constant YES => 1; +use constant NONEWLINE => 1; + +my $GPbuffer = ""; +my $buffercount = 0; + +my $windowtitle = ""; #Global var to store real name of GUI window + +my $PlotBuffer = {}; +my $PlotBufferCnt = 0; + +my @PlotBufArr = (); + +#my @color = ("#1155bb","#bb1111","#999900","#660000","#006633","#990066","#6633CC","#00CCCC"); +my @color = ("#2222dd","#880000","#00cc00","#ee00dd","#ffcc00","#00cc88","#6633CC","#00CCCC"); +our $write2file = ""; +our $plotendedbefore = 0; + +trb_init_ports() or die trb_strerror(); + +################################################# +# Variables... +################################################# +my $delay = 1000; +my $samples = 100; +my $downscale = 1; +# my $system = 0; +my $address = []; +my $register = []; +my $regoffset = []; +my $regwidth = []; +my $title = []; +my $timeref = []; +my $geom = "700x400"; +my $style = 0; +my $nametmp = ""; +my $regamount = []; +my $xscale = []; +my $yscale = []; +my $xtitle = ""; +my $ytitle = ""; +my $windowname = "No Name"; +my $xistime = AXISISNOTIME; +my $xoverflow = []; +my $yoverflow = []; +my $ydiff = 0; +my $outputcfg = ""; +my $name = "HadPlot"; +my $key ; +my $curvestyle= 'points'; #points, steps, histo or histostacked +my $xticks = 0; #show labels on x-axis +my $yticks = 1; #show labels on y-axis +my $plotoption= ""; #string with additional gnuplot commands +my $curveoption= []; #options for plot command +my $xgrid = 1; +my $ygrid = 1; +my $ymax; +my $ymin; +my $xmin; +my $xmax; + +GetOptions('d=f' => \$delay, + 'n=i' => \$samples, + 'o=i' => \$downscale, + 'a=s' => $address, + 'r=s' => $register, + 'w=i' => $regwidth, + 'p=i' => $regoffset, + 't=s' => $title, + 'm=i' => $regamount, + 'g=s' => \$geom, + 'z=i' => \$style, + 'output=s' => \$outputcfg, + 'windowname=s' => \$windowname, + 'xscale=f' => $xscale, + 'yscale=f' => $yscale, + 'xtitle=s' => \$xtitle, + 'ytitle=s' => \$ytitle, + 'xistime!' => \$xistime, + 'timeref=s' => $timeref, + 'xoverflow=f' => $xoverflow, + 'yoverflow=f' => $yoverflow, + 'ydiff!' => \$ydiff, + 'name=s' => \$name, + 'key!' => \$key, + 'xticks!' => \$xticks, + 'yticks!' => \$yticks, + 'xgrid!' => \$xgrid, + 'ygrid!' => \$ygrid, + 'ymax=i' => \$ymax, + 'ymin=i' => \$ymin, + 'xmax=i' => \$xmax, + 'xmin=i' => \$xmin, + 'curvestyle=s' => \$curvestyle, + 'curveoption=s'=> $curveoption, + 'plotoption=s' => \$plotoption + ); + +for(my $i=0;$i<16;$i++) { + $regoffset->[$i] = 0 unless defined $regoffset->[$i]; + $regwidth->[$i] = 32 unless defined $regwidth->[$i]; + $xoverflow->[$i] = 2**20 unless defined $xoverflow->[$i]; + $yoverflow->[$i] = 2**32 unless defined $yoverflow->[$i]; + $xscale->[$i] = 1 unless defined $xscale->[$i]; + $yscale->[$i] = 1 unless defined $yscale->[$i]; + $title->[$i] = "" unless defined $title->[$i]; + $curveoption->[$i] = "" unless defined $curveoption->[$i]; + } + +for(my $i=0;$i < scalar @{$address};$i++) { + if(!defined($title->[$i])) { + $title->[$i] = hex($address->[$i])." $register->[$i] $regoffset->[$i]..".($regoffset->[$i]+$regwidth->[$i]-1); + } + } + + +$delay *= 1000; +if($style == 1) {$curvestyle="points"; $xticks=1;} +if($style == 2) {$curvestyle="histo"; $xticks=0;} +if($style == 3) {$curvestyle="histo"; $xticks=1;} +if($style == 4) {$curvestyle="histostacked"; $xticks=0;} +if($style == 5) {$curvestyle="histostacked"; $xticks=1;} + +for(my $k = 0; $k < scalar @$address; $k++) { + $address->[$k] = hex($address->[$k]); + $register->[$k] = hex($register->[$k]); + } + +#Open Gnuplot +our $fh; +my $fn = "gnuplot -geometry $geom -bg 'ghost white'"; +$fh = new FileHandle ("|$fn") or die "error: no gnuplot"; +$fh->autoflush(1); + +sub makeTimeString{ + return strftime("set label 100 \"%H:%M:%S\" at screen 0.92,0.02 left tc rgb \"#000044\" font \"monospace,8\"\n", localtime()) + } + +################################################# +# When exiting, close Gnuplot window +################################################# +sub finish { + print $fh "exit;\n"; + close $fh; + exit; +} + +$SIG{INT} = \&finish; +$SIG{PIPE} = \&finish; + + + +my $last_wakeup; + +sub max { + my $a = shift; + my $b = shift; + return $a > $b ? $a : $b; + } + +sub min { + my $a = shift; + my $b = shift; + return $a < $b ? $a : $b; + } + +sub usleep_total { + my $delay = shift; + if(defined $last_wakeup) { + my $time = time(); +# printf "%.0f\n",$delay-($time-$last_wakeup)*1E6; + usleep(max(0,$delay-($time-$last_wakeup)*1E6)); + } + else { + usleep($delay); + } + $last_wakeup = time(); + return $last_wakeup; + } + + +################################################# +# Write to gnuplot +################################################# +sub plot_write { + my ($str,$no) = @_; + if(defined($no) && $no) { + print $fh $str; +# print $str; + } + else { + print $fh $str."\n"; +# print $str."\n"; + } + } + +sub plot_add { + my ($x,$y) = @_; + $x = $x || $PlotBufferCnt; + $PlotBufArr[$PlotBufferCnt]->{x} = $x; + $PlotBufArr[$PlotBufferCnt]->{y} = $y; + + $PlotBufferCnt++; +# $PlotBuffer->{$x} = $y; +# print $x." ".$y."\n"; + } + +sub plot_end { + my ($single) = @_; + for(my $i = 0;$i{y}."\n"; + } + else { + print $fh $PlotBufArr[$i]->{x}." ".$PlotBufArr[$i]->{y}."\n"; + } + } +# foreach my $line (sort keys %{$PlotBuffer}) { +# if($single) { +# print $fh $PlotBuffer->{$line}."\n"; +# # print "plot_end: ".$PlotBuffer->{$line}."\n"; +# } +# else { +# print $fh $line." ".$PlotBuffer->{$line}."\n"; +# # print "plot_end: ".$line." ".$PlotBuffer->{$line}."\n"; +# } +# } + @PlotBufArr = (); + $PlotBuffer = {}; + $PlotBufferCnt = 0; + print $fh "e\n"; + $plotendedbefore = 1 unless $plotendedbefore; + } + + +sub plot_reset { + if($write2file eq ""){ + system("xwininfo -name '$windowtitle' >/dev/null 2>/dev/null"); + #print $?."\n"; + if($? != 0) { + usleep(1E5); + system("xwininfo -name '$windowtitle' >/dev/null 2>/dev/null"); + if($? != 0) { + finish(); + } + } + if ($plotendedbefore != 0) { + $plotendedbefore = 0; + print $fh makeTimeString(); + print $fh "replot\n"; + } + } + else { + if ($plotendedbefore != 0) { + system("mv $write2file.tmp $write2file"); + plot_write("set out \"$write2file.tmp\"\n"); + $plotendedbefore = 0; + print $fh makeTimeString(); + print $fh "replot\n"; +# print "reset\n"; + } + } + } + +sub plot_finished { + my ($store) = @_; + if($write2file ne "") { + if(defined $store) { + if($store->{"initing"} != 2 and $store->{"iteration"} % $store->{"downscale"} == 0) { +# system("mv $write2file.tmp $write2file"); + } + } + else { + if($write2file ne "") { +# system("mv $write2file.tmp $write2file"); + } + } + } + } + +sub plot_init { + my ($xtics) = @_; + $windowtitle = $name ." - ".$windowname; + if ($outputcfg =~ m$PNG.([/\w]*).(\d+).(\d+)$) { + print "Writing PNG to file $1\n"; + $write2file = $1.".png"; + plot_write("set term png size $2,$3 font \"monospace,8\""); + plot_write("set out \"$write2file.tmp\""); + } + elsif ($outputcfg =~ m$SVG.([/\w]*).(\d+).(\d+)$) { + print "Writing SVG to file $1\n"; + $write2file = $1.".svg"; + plot_write("set term svg size ".($2*2).",".($3*2)." dynamic font \"monospace,18\" lw 1.5 \n"); + plot_write("set out \"$write2file.tmp\"\n"); + } + else { + plot_write("set term x11 title '$windowtitle'"); + } + plot_write("set grid"); + plot_write("set xlabel \"$xtitle\""); + plot_write("set ylabel \"$ytitle\""); + if(defined $xtics) { + plot_write("set xtics $xtics\n"); + } + if(defined $xmin && defined $xmax) { + plot_write("set xrange [$xmin:$xmax]"); + } + if(defined $ymin && defined $ymax) { + plot_write("set yrange [$ymin:$ymax]"); + } + elsif(defined $ymax) { + plot_write("set yrange [:$ymax]"); + } + elsif(defined $ymin) { + plot_write("set yrange [$ymin:]"); + } + if (!defined $key || $key == 0) { + plot_write("unset key"); + } + if($xgrid == 0) { + plot_write("set grid noxtics"); + } + if($ygrid == 0) { + plot_write("set grid noytics"); + } + if($plotoption ne "") { + plot_write($plotoption); + } + } + +sub plot_sleep { + my ($delay) = @_; + my $t = usleep_total($delay); + plot_reset(); + return $t; + } + +sub plot_end_sleep { + my ($delay,$single) = @_; + plot_end($single); + return plot_sleep($delay); + } + +sub plot_storage_end_sleep { + my ($store, $single) = @_; + my $delay = $store->{"delay"}; + my $t; + if($store->{"initing"} == 0) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_end($single); + $t = usleep_total($delay); + plot_reset(); + } + else { + $t = usleep_total($delay); + } + } + return $t; + } + +sub plot_storage_sleep { + my ($store,$noreset) = @_; + my $t; + my $delay = $store->{"delay"}; + #print $store->{"initing"}.$store->{"iteration"}.$store->{"downscale"}."\n"; + if($store->{"initing"} != 2) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + $t = usleep_total($delay); + plot_storage_reset() unless $noreset; + } + else { + $t = usleep_total($delay); + } + } + return $t; + } + +sub plot_storage_reset { + my ($store) = @_; + if(defined $store->{"initing"} && $store->{"initing"} != 2) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_reset(); + } + } + } + +sub plot_storage_end { + my ($store) = @_; + if($store->{"initing"} == 0) { + if($store->{"iteration"} % $store->{"downscale"} == 0) { + plot_end(); + } + } + } + +################################################# +# Writes a new value pair to storage +################################################# +sub store_push { + my ($storage,$x,$y,$divtime) = @_; + my $xval = $x; + my $yval = $y; + my $curtime = time(); + + if ($storage->{"initing"} != 2) { + if (scalar(@{$storage->{"datax"}}) == $storage->{"size"}) { + my $tmp = shift(@{$storage->{"datax"}}); + my $tmpy = shift(@{$storage->{"datay"}}); + $storage->{"totalx"} -= $tmp; +# if($storage->{"initing"} == 0 && (($tmpy <= $storage->{"miny"}) || ($tmpy >= $storage->{"maxy"}))) { +# store_calc_range($storage); +# } + } + if($storage->{"diffx"}) { + if(defined($storage->{"xmax"}) && $x < $storage->{"lastx"}) { + $xval = ($x - $storage->{"lastx"} + $storage->{"xmax"}); + } + else { + $xval = ($x - $storage->{"lastx"}); + } + if(defined($storage->{"last_push"}) && $storage->{"last_push"} != 0) { + while (floor($xval/$storage->{"xmax"}) < floor(($curtime - $storage->{"last_push"})/($storage->{"xmax"}/1E6))){ + $xval += $storage->{"xmax"}; + } + } + } + if($storage->{"diffy"}) { + $yval = $y - $storage->{"lasty"}; + if(defined($storage->{"ymax"}) && $y < $storage->{"lasty"}) { + while($yval < 0) { + $yval += $storage->{"ymax"}; + } + } + if($divtime) { + $yval /= ($xval?$xval:1)/1000000; + } + } + + + if($storage->{"initing"} == 1) { + $storage->{"initing"} = 0; + for(my $i = $storage->{"size"}-1; $i>0; $i--) { + push(@{$storage->{"datax"}},$storage->{"delay"}); + push(@{$storage->{"datay"}},$yval); + $storage->{"totalx"} += $storage->{"delay"}; + } + } + + push(@{$storage->{"datax"}},$xval?$xval:0); + push(@{$storage->{"datay"}},$yval?$yval:0); + $storage->{"totalx"} += $xval?$xval:0; + } + else { + $storage->{"initing"} = 1; + } + + $storage->{"last_push"} = $curtime; + $storage->{"lasty"} = $y; + $storage->{"lastx"} = $x; + } + +################################################# +# Writes storage contents to stream +################################################# +sub store_print { + my $str = ""; + my ($storage) = @_; + if($storage->{"initing"} != 2) { + if($storage->{"iteration"} % $storage->{"downscale"} == 0) { + my $xcnt = - $storage->{"totalx"} /1000000.0; + for (my $i = 0; $i < $storage->{"size"}; $i++) { + my $xval = $storage->{"datax"}->[$i]; #${}[] + my $yval = $storage->{"datay"}->[$i]; + $xval = 0 unless defined($xval); + $yval = 0 unless defined($yval); + $xcnt += $xval/1000000.0; +# $str .= $xcnt." ".$yval."\n"; + $str .= sprintf "%.3f %.2f\n", $xcnt,$yval; + #plot_write($xcnt/1000000.0." ".$yval); + } + plot_write($str,1); +# print $str; + plot_end(1); + } + $storage->{"iteration"}++; + } + } + + +################################################# +# Initialize storage +################################################# +sub store_init { + my ($storage,$size,$diffx,$diffy,$delay,$downscale,$xmax,$ymax) = @_; + + $storage->{"datax"} = []; + $storage->{"datay"} = []; + $storage->{"size"} = $size; + $storage->{"diffx"} = $diffx; + $storage->{"diffy"} = $diffy; + $storage->{"delay"} = $delay; + $storage->{"downscale"} = $downscale; + $storage->{"initing"} = 2; + $storage->{"iteration"} = 0; + $storage->{"totalx"} = 0; + $storage->{"xmax"} = $xmax; + $storage->{"ymax"} = $ymax; + $storage->{"maxy"} = 0; + $storage->{"miny"} = 1E100; + $storage->{"last_push"} = 0; + $storage->{"last_sleep"} = 0; + } + +################################################# +# Help Message +################################################# +sub help { + print <[$i])) || ($title->[$i] eq "")) { +# $title->[$i] = hex($address->[$i])." ".$register->[$i]." ".$regoff->[$i]."..".($regoff->[$i]+$regwidth->[$i]-1); +# } + if (!(defined $regamount->[$i])) { + $regamount->[$i] = 1; + } + } + $ymin = $regoff->[0]; + $ymax = $regoff->[0]+$regwidth->[0]; + plot_init(256); +# if ($style == 0) { +# plot_write("plot",1); +# for(my $i = 0; $i[$i]\" ",1); +# plot_write(", ",1) unless $i == scalar(@{$address})-1; +# } +# plot_write(""); +# } +# elsif($style == 1) { + plot_write("set xtics rotate by 90 offset .7,-2 scale 0 "); + plot_write("set style fill solid 1.00 border -1"); + plot_write("set boxwidth 1 absolute"); + plot_write("unset key"); + plot_write('set format x "%x"'); + plot_write("plot ",1); + for(my $i = 0; $i[$i]\" ",1); #using 2:xticlabels(1) + plot_write(", ",1) unless $i == scalar(@{$address})-1; + } + plot_write(""); +# } + while(1) { + for(my $i = 0; $i[$i] == 1) { + $c = "trbcmd r $address->[$i] $register->[$i] | sort"; + } + else { + $c = "trbcmd rm $address->[$i] $register->[$i] $regamount->[$i] 0"; + } + my @out = qx($c); + my $addr = undef; + my $cnt = 0; + foreach my $s (@out) { + if($s =~ /^H:\s*0x(\w\w\w\w)/) { + $addr = $1; + } + if($s =~ /^0x(\w\w\w\w)\s*0x(\w{8})/) { + $addr = hex($1) if($regamount->[$i] == 1); + if ($regamount->[$i] == 1) { plot_add($addr,-1); } + else { plot_add("\"$addr.$1\"",-1); } + for(my $j = $regoff->[$i]; $j < $regoff->[$i] + $regwidth->[$i];$j++) { + if(hex($2) & (1<<$j)) { + if ($regamount->[$i] == 1) { plot_add("$addr",$j); } + else { plot_add("\"$addr.$1\"",$j); } + } + } + $cnt++; + } + } + plot_end(1); + } + plot_sleep($delay); + } + } + + + +################################################# +# Generic Register differences +################################################# +sub genreg { + my %oldvals; + + plot_init(undef); + + if($xticks) { + plot_write("set xtics rotate by 90 offset .7,-1.7 scale .7 "); + } + if($curvestyle eq "histo") { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set boxwidth 2 absolute"); + } + elsif($curvestyle eq "histostacked") { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set style histogram rowstacked"); + plot_write("set boxwidth 1 absolute"); + plot_write("set key outside") unless defined $key && $key==0; + plot_write("set autoscale xfix "); + } + + plot_write("plot",1); + for(my $i = 0; $i[$i]\" ",NONEWLINE); + } + elsif ($curvestyle eq "steps") { + plot_write("with histeps title \"$title->[$i]\" ",NONEWLINE); + } + else { + plot_write("with points pt 5 title \"$title->[$i]\" ",NONEWLINE); + } + plot_write(" ".$curveoption->[$i],NONEWLINE); + plot_write(", ",NONEWLINE) unless $i == scalar(@{$address})-1; + } + plot_write(""); + + + while(1) { + for(my $i = 0; $i[$i]) || $regamount->[$i] == 1) { +# $c = "trbcmd r $address->[$i] $register->[$i] | sort"; + $c = trb_register_read(($address->[$i]),($register->[$i])); + foreach my $s (keys $c) { + $c->{$s}=[$c->{$s}]; + } + } + else { +# $c = "trbcmd rm $address->[$i] $register->[$i] $regamount->[$i] 0"; + $c = trb_register_read_mem(($address->[$i]),($register->[$i]),0,$regamount->[$i]); + print Dumper $c; + } +# my @out = qx($c); + foreach my $s (sort keys $c) { + for(my $r = 0; $r < scalar @{$c->{$s}};$r++) { + my $tmp = ($c->{$s}->[$r]>>$regoffset->[$i])&(2**$regwidth->[$i]-1); + my $val = $tmp; + my $board = sprintf("%04x",$s); + if($ydiff) { + if(defined $oldvals{$i}->{$board.($r+$register->[$i])}) { + if ($oldvals{$i}->{$board.($r+$register->[$i])} > $tmp) { + $val = $tmp - $oldvals{$i}->{$board.($r+$register->[$i])} + 2**$regwidth->[$i]; + } + else { + $val = $tmp - $oldvals{$i}->{$board.($r+$register->[$i])}; + } + } + $oldvals{$i}->{$board.($r+$register->[$i])} = $tmp; + } + + if($xticks) { + if (!(defined $regamount->[$i]) || $regamount->[$i] == 1) { + plot_add("\"$board\"",$val/$yscale->[$i]); + } + else { + plot_add("\"$board.($r+$register->[$i])\"",$val/$yscale->[$i]); + } + } + else { + plot_add("",$val/$yscale->[$i]); + } + } + } + plot_end(!$xticks); + } + plot_sleep($delay); + } + } + +################################################# +# Generic Histogram +################################################# +sub genhist { + my %storearr; + my %oldvals; +# $xtitle = "Time [s]" unless $xtitle ne ""; + plot_init(); + plot_write("set autoscale fix"); + plot_write("plot",1); + $diff = 0 unless defined($diff); + for(my $i = 0; $i[$i],$yoverflow->[$i]); + plot_write("'-' with lines title \"$title->[$i]\" ",1); + plot_write(", ",1) unless $i == scalar(@{$address})-1; + } + plot_write(""); + + while(1) { + my $a, my $s, my $t; + my $val = 0 , my $time; + plot_storage_reset($storearr{0}); + for(my $i = 0; $i[$i], $register->[$i]) or sleep 1 and print "Error\n" and next; + foreach my $o (sort keys $c) { +# if (($a,$s,$t) = $o =~ /^0x(\w{4})\s*0x(\w{8})\s*0x(\w{4})/) { + + $val += (($c->{$o}->{'value'}->[0]>>($regoffset->[$i]))&(2**($regwidth->[$i])-1)); + $time = $c->{$o}->{'time'}->[0]*16; +# } + } + store_push($storearr{$i},$time/$xscale->[$i],$val/$yscale->[$i],AXISISTIME); + store_print($storearr{$i}); + } + plot_storage_sleep($storearr{0}); + plot_finished($storearr{0}); + } + } + +################################################# +# Deadtime histogram +################################################# +sub deadtimehist2 { + my %values, my %lastvalues, my %diffvalues; + my @keys = ("33","34","36","31","38","37","3b","35"); + my @keys2 = ("43","44","46","41","48","47","4b","45"); + my @names = ("MDC12","MDC34","TOF","RPC","RICH","SHW","Start","FW"); + my %storearr; + + if ($style != 0) { + for(my $i= 0; $i < scalar(@keys); $i++) { + $storearr{$keys[$i]} = {}; + store_init($storearr{$keys[$i]},$samples,0,0,$delay*.0,$downscale,2**32,2**32); + } + for(my $i= 0; $i < scalar(@keys2); $i++) { + $storearr{$keys2[$i]} = {}; + store_init($storearr{$keys2[$i]},$samples,0,0,$delay*.0,$downscale,2**32,2**32); + } + } + + plot_init(); + plot_write("set key left top Left"); + plot_write("set autoscale fix"); + plot_write("set yrange [-1:101]"); + + if ($style != 0) { + plot_write("plot ",1); + plot_write("\"-\" title \"MDC12\" with lines,",1); + plot_write("\"-\" title \"MDC34\" with lines,",1); + plot_write("\"-\" title \"TOF\" with lines,",1); + plot_write("\"-\" title \"RPC\" with lines,",1); + plot_write("\"-\" title \"RICH\" with lines,",1); + plot_write("\"-\" title \"SHW\" with lines,",1); + plot_write("\"-\" title \"Start\" with lines,",1); + plot_write("\"-\" title \"FW\" with lines"); + } + else { + plot_write("set style fill solid 1.00 border -1"); + plot_write("set grid noxtics ytics"); + plot_write("set boxwidth 2 absolute"); + plot_write("set xtics ('MDC12' 0,'MDC34' 1,'TOF' 2, 'RPC' 3, 'RICH' 4, 'SHW' 5, 'Start' 6, 'FW' 7) offset 2,0 scale 0"); + plot_write("set style histogram title offset character 0, 0, 0"); + plot_write("set style data histograms"); + plot_write("plot \"-\" title 'incl. busy' lt rgb \"#1155bb\", \"-\" title 'excl. busy' lt rgb \"#bb1111\""); + } + my $cmd = sprintf("trbcmd -n-1 -s%d rmt 0x8001 0x4031 31 0",$delay/1000); + if($style != 0) { + $cmd = sprintf("trbcmd -n-1 -s%d rmt 0x8001 0x4031 12 0",$delay/1000); + } + open(FTRB, "$cmd|"); + + while(my $a = ) { + if($a =~ /^0x\w{2}(\w{2})\s*0x(\w{8})\s*0x(\w{4})/) { + $values{$1} = hex($2); + $values{"50"} = hex($3)*16; + } + if ($a eq "---\n") { + $diffvalues{"50"} = 1E6; + if (defined $lastvalues{"50"}) { + if ($values{"50"} > $lastvalues{"50"}) { + $diffvalues{"50"} = $values{"50"} - $lastvalues{"50"}; + } + else { + $diffvalues{"50"} = $values{"50"} - $lastvalues{"50"} + 2**20; + } + } + #$diffvalues{"50"} = $values{"50"} - $lastvalues{"50"} if defined $lastvalues{"50"}; + my $time = $diffvalues{"50"}; + foreach my $key (keys %values) { + next unless hex($key)<0x50; + $diffvalues{$key} = 0; + if (defined $lastvalues{$key}) { + if ($values{$key} >= $lastvalues{$key}) { + $diffvalues{$key} = $values{$key} - $lastvalues{$key}; + } + else { + $diffvalues{$key} = $values{$key} - $lastvalues{$key} + 2**32; + } + } + $diffvalues{$key} /= $time if $time; + #print $key." ".$values{$key}." ".$lastvalues{$key}." ".$diffvalues{$key}."\n"; + } + #print "=====\n"; + $diffvalues{"31"} = max($diffvalues{"31"},$diffvalues{"32"}); + $diffvalues{"38"} = max(max($diffvalues{"38"},$diffvalues{"39"}),$diffvalues{"3a"}); + if ($style == 0) { + $diffvalues{"41"} = max($diffvalues{"41"},$diffvalues{"42"}); + $diffvalues{"48"} = max(max($diffvalues{"48"},$diffvalues{"49"}),$diffvalues{"4a"}); + } + %lastvalues = %values; + if($style != 0) { + plot_storage_reset($storearr{$keys[0]}); + for(my $i= 0; $i < scalar(@keys); $i++) { + store_push($storearr{$keys[$i]},$time,$diffvalues{$keys[$i]},0); + store_print($storearr{$keys[$i]}); + } + plot_storage_sleep($storearr{$keys[0]},1); + plot_finished($storearr{$keys[0]}); + } + else { + plot_reset(); + for(my $i= 0; $i < scalar(@keys); $i++) { + plot_add("",$diffvalues{$keys[$i]}); #"\"".$names[$i]."\"", + } + plot_end(1); + for(my $i= 0; $i < scalar(@keys2); $i++) { + plot_add("",$diffvalues{$keys2[$i]}); #"\"".$names[$i]."\"", + } + plot_end(1); + plot_finished(); + } + } + } + } + + +################################################# +# Select Operation +################################################# + +if(!(defined $ARGV[0]) || $ARGV[0] =~ /help/) {help(); exit;} + +if($ARGV[0] =~ /oep5V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8010,0x8011]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [.5,.5]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["5.8V input","5V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep3.3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8012,0x8013]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["3.8V input","3.3V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep1.2V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8014,0x8015]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["1.8V input","1.2V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oep3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x8016,0x8017]; + $regwidth = [12,12]; + $regoffset = [0,0]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["+3V input","-3V reg."]; + genreg(); + } + +if($ARGV[0] =~ /oepminmaxp3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x801e,0x801e]; + $regwidth = [12,12]; + $regoffset = [0,16]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["+3V minimum","+3V maximum"]; + genreg(); + } + +if($ARGV[0] =~ /oepminmaxn3V/) { + $address = [0xfffd,0xfffd]; + $register = [0x801f,0x801f]; + $regwidth = [12,12]; + $regoffset = [0,16]; + $yscale = [1,1]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["-3V minimum","-3V maximum"]; + genreg(); + } + +if($ARGV[0] =~ /oepminmax5Vin/) { + $address = [0xfffd,0xfffd,0xfffd]; + $register = [0x8018,0x8018,0x8010]; + $regwidth = [12,12,12]; + $regoffset = [0,16,0]; + $yscale = [.5,.5,.5]; + $xtitle = "Board"; + $ytitle = "Voltage [mV]"; + $key = YES; + $windowname = "OEP Voltages"; + $title = ["5Vin minimum","5Vin maximum","5Vin"]; + genreg(); + } + +if($ARGV[0] =~ /oeptemp/) { + oeptemp(($delay)?$delay:5000000,[$name." - OEP Temperature"]); + } + + +if($ARGV[0] =~ /rpcdatarate/) { + $delay = 1000000 unless $delay; + $xticks = 1 ; + $xtitle = "Sender ((Sector mod 3)*4+TRB)"; + $ytitle = "Data Words /1024"; + $windowname = "Data Words sent by RPC"; + $curvestyle = "histo"; + $key = YES; + $ydiff = DIFFY; + $ymin = 0; + $yscale = [512,512]; + $address = [0x8401,0x8411]; + $register = [0x4001,0x4001]; + $regamount = [12,12]; + $title = ["Sector 0,1,2","Sector 3,4,5"]; + $regoffset = [0,0]; + $regwidth = [32,32]; + genreg(); + } + +#hadplot -a 2 -r 1 -p 0 -w 16 -d 5 -o 200 -n 1000 -yoverflow 65536 genhistdiff + + +if($ARGV[0] =~ /slowcontrolrate/) { + $delay = 1000000 unless $delay; + $samples = 240 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $windowname = "Slow Control Data Rate"; + $ydiff = DIFFY; + $ytitle = "Slow Control Data / kByte/s"; + $address = [0x8000]; + $register = [0x4012]; + $regoffset = [0]; + $regwidth = [32]; + $yscale = [102.4]; + genhist(); + } + +if($ARGV[0] =~ /eventratehighres/) { + $delay = 5000 ; #unless $delay; + $samples = 1000; # unless $samples; + $downscale = 200;# unless $downscale; +# $style = 0 unless $style; + $windowname = "Eventrate High Resolution"; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $title = ["Event rate"]; + $address = [0x2]; + $register = [0x1]; + $regoffset = [0]; + $regwidth = [16]; + $yoverflow = [65536]; + genhist(); + } + + +if($ARGV[0] =~ /eventrate/) { + $address = [0x2]; + $register = [0x1]; + $regwidth = [16]; + $regoffset = [0]; + $timeref = [0x2]; + $delay = 100000 unless $delay; + $samples = 500 unless $samples; + $downscale = 10 unless $downscale; + $windowname = "Event rate history"; + $key = NO; + $ytitle = "Event rate [Hz]" if $ytitle eq ""; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $yoverflow = [2**16] unless $yoverflow->[0] != 2**32; + genhist(); + } + +if($ARGV[0] =~ /datarate/) { + $address = [0xff7f]; + $register = [0x83f3]; + $regwidth = [32]; + $regoffset = [0]; + $timeref = [0x8000]; + $delay = 100000 unless $delay; + $samples = 500 unless $samples; + $downscale = 5 unless $downscale; + $windowname = "Total data rate history"; + $xtitle = "Time [s]" unless defined $xtitle; + $ytitle = "Data rate [MiByte]" unless defined $ytitle; + $xistime = AXISISTIME; + $ydiff = DIFFY; + $xoverflow = [2**20]; + $yoverflow = [2**12]; + $yscale = [2**20]; + $key = NO; + genhist(); + } + +if($ARGV[0] =~ /busytime/) { + $delay = 100000 unless $delay; + $samples = 100 unless $samples; + $downscale = 5 unless $downscale; + $style = 1; + $windowname = "Busytime history"; + deadtimehist2(); + } + +if($ARGV[0] =~ /busy/) { + $delay = 100000 unless $delay; + $style = 0; + $windowname = "Busy time"; + deadtimehist2(); + } + +if($ARGV[0] =~ /oepspikehist/) { + $delay = 100000 unless $delay; + $samples = 1000 unless $samples; + $downscale = 10 unless $downscale; +# $style = 0 unless $style; + $windowname = "OEP CMS Spikes"; + $ydiff = DIFFY; + $title = ["OEP CMS Spikes"]; + $address = [0xfffd]; + $register = [7]; + $regoffset = [0]; + $regwidth = [16]; + genhist(); + } + +if($ARGV[0] =~ /oepretrhist/) { + $delay = 500000 unless $delay; + $samples = 600 unless $samples; + $downscale = 2 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP Retransmissions"; + $ydiff = DIFFY; + $title = ["Retransmit Received","Retransmit Sent"]; + $address = [0xfffd,0xfffd]; + $register = [4,4]; + $regoffset = [16,24]; + $regwidth = [8,8]; + genhist(); + } + +if($ARGV[0] =~ /oeptokenmisshist/) { + $delay = 500000 unless $delay; + $samples = 2000 unless $samples; + $downscale = 4 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP Token Missing"; + $ydiff = DIFFY; + $title = ["Missing Tokens"]; + $address = [0xfffd]; + $register = [0x9101]; + $regoffset = [0]; + $regwidth = [24]; + genhist(); + } + + +if($ARGV[0] =~ /oeptrgerrhist/) { + $delay = 500000 unless $delay; + $samples = 2000 unless $samples; + $downscale = 2 unless $downscale; + $style = 0 unless $style; + $windowname = "OEP CMS Errors"; + $ydiff = DIFFY; + $title = ["Spikes","Spurious","Invalid","Multiple"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [7,7,6,6]; + $regoffset = [0,16,0,16]; + $regwidth = [16,16,16,16]; + genhist(); + } + + +if($ARGV[0] =~ /histdiff/) { + $delay = 1000000 unless $delay; + $samples = 200 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $ydiff = DIFFY; + genhist(); + } + +if($ARGV[0] =~ /hist/) { + $delay = 1000000 unless $delay; + $samples = 200 unless $samples; + $downscale = 1 unless $downscale; + $style = 0 unless $style; + $ydiff = NODIFFY; + genhist(); + } + +if($ARGV[0] =~ /oepworktime/) { + $delay = 1000000 unless $delay; + $curvestyle = "histostacked"; + $xticks = 0 unless $xticks; + $ymax = $delay*1.1/1000; + $yscale = [1000]; + $xtitle = "OEP"; + $ytitle = "Time [ms]"; + $windowname = "OEP Trigger Handling Times"; + $ydiff = DIFFY; + $title = ["Readout","Waiting","Initialization","Calibration","Idle"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [0x9113,0x9114,0x9111,0x9112,0x9110]; + $regoffset = [0,0,0,0,0]; + $regwidth = [32,32,32,32,32]; + genreg(); + } + +if($ARGV[0] =~ /gberate/) { + $delay = 1000000 unless $delay; + $curvestyle = "histostacked"; + $xticks = 1 unless $xticks; + $xtitle = "Sender"; + $ytitle = "Data Rate (kiB)" if $ytitle eq ""; + $windowname = "Gbe Data Rate"; + $key = NO; + $ydiff = DIFFY; + $xgrid = NO; + $address = [0xff7f]; + $register = [0x83f3]; + $regoffset = [10]; + $regwidth = [22]; + genreg(); + } + +if($ARGV[0] =~ /oepwords/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Sender"; + $ytitle = "Data Words"; + $windowname = "Data Words sent by OEP"; + $yscale = [1]; + $key = NO; + $ydiff = DIFFY; + $address = [0xfffd]; + $register = [0x910B]; + $regoffset = [0]; + $regwidth = [32]; + genreg(); + } + + +if($ARGV[0] =~ /mdcchan/) { + $delay = 1000000 unless $delay; + $xticks = 1; + $xtitle = "Sender"; + $ytitle = "Data Words"; + $windowname = "Data words per TDC channel"; + $yscale = [1]; + $key = NO; + $ydiff = NODIFFY; + if ($ARGV[0] =~ /diff/) { + $ydiff = DIFFY; + } + $address = [$address->[0]?$address->[0]:0xfffd]; + $register = [0xc088]; + $regamount = [96]; + $regoffset = [0]; + $regwidth = [32]; + genreg(); + } + + +if($ARGV[0] =~ /regdiff/) { + $delay = 1000000 unless $delay; +# $xticks = 1 unless $xticks; + $ydiff = DIFFY; +# $key = NO unless defined $key; + $windowname = "General Plot" unless $windowname; + genreg(); + } + +if($ARGV[0] =~ /reg/) { + $delay = 1000000 unless $delay; +# $xticks = 1 unless $xticks; + $ydiff = NODIFFY; +# $key = NO unless defined $key; + $windowname = "General Plot" unless $windowname; + genreg(); + } + +if($ARGV[0] =~ /oeptrgerr/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "# of errors"; + $windowname = "OEP CMS Errors"; + $key = YES; + $ydiff = NODIFFY; + $title = ["Spikes","Spurious","Invalid","Multiple"]; + $address = [0xfffd,0xfffd,0xfffd,0xfffd]; + $register = [7,7,6,6]; + $regoffset = [0,16,0,16]; + $regwidth = [16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /oepfill/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "OEP Buffer Fill Level"; + $key = NO; + $ydiff = NODIFFY; + $address = [0xfffd]; + $register = [0x7100]; + $regoffset = [0]; + $regwidth = [16]; + genreg(); + } + +if($ARGV[0] =~ /showerfill/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "Shower Data Buffer Fill Level"; + $key = $key || NO; + $ydiff = NODIFFY; + $address = [0xfff7,0xfff7,0xfff7,0xfff7,0xfff7,0xfff7]; + $register = [0x7100,0x7101,0x7102,0x7103,0x7104,0x7105]; + $regoffset = [0,0,0,0,0,0]; + $regwidth = [16,16,16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /filllevel/) { + $delay = 1000000 unless $delay; + $xticks = 1 unless defined $xticks; + $xtitle = "Board"; + $ytitle = "Words in Buffer"; + $windowname = "Front-end Data Buffer Fill Level"; + $key = NO; + $ydiff = NODIFFY; + $address = [0xffff,0xffff,0xffff,0xffff,0xffff,0xffff]; + $register = [0x7100,0x7101,0x7102,0x7103,0x7104,0x7105]; + $regoffset = [0,0,0,0,0,0]; + $regwidth = [16,16,16,16,16,16]; + genreg(); + } + +if($ARGV[0] =~ /oepretr/) { + $delay = 1000000 unless $delay; + $windowname = "OEP Retransmissions"; + $key = YES; + $ydiff = NODIFFY; + $title = ["Retransmit Received","Retransmit Sent"]; + $address = [0xfffd,0xfffd]; + $register = [4,4]; + $regoffset = [16,24]; + $regwidth = [8,8]; + genreg(); + } + +if($ARGV[0] =~ /timecmslvl1/) { + $delay = 1000000 unless $delay; + $windowname = "Trigger Delay"; + $key = NO; + $ydiff = NODIFFY; + $ytitle = "Time between CMS and LVL1 [10ns]"; + $address = [0xfffd]; + $register = [2]; + $regoffset = [16]; + $regwidth = [11]; + genreg(); + } + +if($ARGV[0] =~ /oeptokenmiss/) { + $delay = 1000000 unless $delay; + $windowname = "OEP Token Missing"; + $key = NO; + $ydiff = NODIFFY; + $ytitle = "# of missing token"; + $address = [0xfffd]; + $register = [0x9101]; + $regoffset = [0]; + $regwidth = [24]; + genreg(); + } + + + + +if($ARGV[0] =~ /commonstatus/) { + bitmap(($delay)?$delay:1000000,[0xffff],[0],[1],[0],[20],["Common Status Bits"],0,$name." - Common Status Bit"); + } +if($ARGV[0] =~ /genbit/ || $ARGV[0] =~ /bitmap/) { + bitmap(($delay)?$delay:1000000,$address,$register,$regamount,$regoffset,$regwidth,$title,$style,$name." - ".$windowname); + } + diff --git a/hmon/hmon_logerrors.pl b/hmon/hmon_logerrors.pl new file mode 100755 index 0000000..bf8b569 --- /dev/null +++ b/hmon/hmon_logerrors.pl @@ -0,0 +1,150 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use POSIX qw(floor); +use FileHandle; +use Hmon; +use QA; +use Getopt::Long; +use Data::Dumper; +use HADES::TrbNet; + +my @bitnames = ("serious error","error","warning","note","LVL1 counter mismatch","IPU counter mismatch", + "frontend not configured","frontend error","timing trigger missing / spike / multiple","Event not found", + "data missing","severe data buffer problem","broken event","timing trigger input error", + "SEU detected","link error","Bit16","Bit17","Bit18","Bit19"); +my @severity = ('E','E','W','I','E','E', + 'E','I','W','E', + 'E','E','W','E', + 'W','I','I','I','I','I'); + +my @lvl1bits = ("0","1","2","3","spike on CMS","missing CMS","spurious signal on CMS","CMS wrong polarity","8","9","10","11","12", + "multiple CMS","14","15","16"); +my @lvl1severity = ('I','I','I','I','I','E','I','E','I','I','I','I','I','I','I','I','I'); +my @lvl1list = (0,0,0,0,0,1,1,1,0,0,0,0,0,1,0,0,0); + +my $flog = Hmon::OpenLogfile(); +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die "could not reach trbnet-daemon.", trb_strerror(); + +my $rh_all; + + trb_register_write(0xffff,0x20,0x10); + sleep(1); + +my $feeerrinmdc = 0; + +while (1) { + + + my $errfnd = 0; + my $store = {}; + my $store2 = {}; + my $feeerrcnt = 0; + my $trginperr = 0; + my $feeerrlist = ""; + my $trginperrlist = ""; + my $feeerrinrich = 0; + + #Parse CSR0 contents + $rh_all = trb_register_read(0xffff, 0x0000) or sleep 5 and next; + + foreach my $board (sort keys %$rh_all) { + my $val = $rh_all->{$board}; + + for (my $b=0;$b<20; $b++) { + if ($val & (1<<$b) && $b != 13) { + if ($b == 6 || ($b == 7 && $board > 0x2400)) {#no frontend error from MDC here + $feeerrcnt++; + $feeerrlist .= sprintf("%04x ",$board); + $feeerrinmdc+=3 if $board < 0x2400; + $feeerrinrich=1 if $board >= 0x3000 && $board < 0x3200; + } + $store->{$b}->{$board}=1; + } + } + } + + + + #Parse CSR2 contents (MDC only at the moment) + $rh_all = trb_register_read(0xffff, 2) or sleep 5 and next; + + foreach my $board (sort {$a <=> $b} keys %$rh_all) { + my $val = $rh_all->{$board}; + for (my $b=0; $b < 20; $b++) { + if ($val & (1<<$b) ) { + $store2->{$b}->{$board}=1; + if($b == 7) { + $trginperrlist = "Wrong trigger polarity: " if $trginperrlist eq ""; + $trginperrlist .= sprintf("%04x, ",$board); + $trginperr++; + } + } + } + } + + + #Print errors from CSR0 + for (my $b = 0; $b <20; $b++) { + my $count = scalar keys %{$store->{$b}}; + if ($count) { + # $errfnd = 1; + my $msg = sprintf("\t%3d ",$count); + my $t = 0; + $msg .= "boards complain: " if $count > 1; + $msg .= "board complains: " if $count == 1; + $msg .= "$bitnames[$b]:"; + foreach my $s (sort keys %{$store->{$b}}) { + if (($b != 8) && ($b != 7 || $s > 0x2400)) { #no bit 8 + $msg .= sprintf(" %04x",$s); + $t = 1; + } + } + system("logger -p local1.info -t DAQ StatWatch \\<".$severity[$b]."\\> $msg") if $t; + } + } + + #Print errors from CSR2 + foreach my $b (5,6,7,13) { + my $count = scalar keys %{$store2->{$b}}; + if ($count) { + # $errfnd = 1; + my $msg = sprintf("\t%3d ",$count); + $msg .= "boards complain: " if $count > 1; + $msg .= "board complains: " if $count == 1; + $msg .= "$lvl1bits[$b]:"; + if ($lvl1list[$b]) { + foreach my $s (sort keys %{$store2->{$b}}) { + $msg .= sprintf(" %04x",$s); + } + } + system("logger -p local1.info -t DAQ StatWatch \\<".$lvl1severity[$b]."\\> $msg"); + } + } + + my $qastate = QA::GetQAState('below',$feeerrcnt,@QA::FeeErrLimits); + $feeerrcnt = "" if $feeerrcnt == 0; + $qastate = QA::ERROR if ($feeerrinmdc >= 4 || $feeerrinrich); + Hmon::Speak("feeerr","Rich front-end error") if $feeerrinrich; + Hmon::Speak("feeerr","MDC front-end error") if $feeerrinmdc >= 4; + QA::WriteQALog($fqa, "feeerr", "feeerr" , 30, $qastate, "FEE Error", "$feeerrcnt", + "Boards with an Front-end Error: $feeerrlist"); + + chop $trginperrlist; chop $trginperrlist; + $trginperrlist = "No trigger input errors found." if($trginperrlist eq ""); + my $value = ""; + $value = "$trginperr errors" if $trginperr; + + QA::WriteQALog($fqa, "feeerr", "trginp", 60, $trginperr?QA::ERROR:QA::OK, "Trg. Inputs",$value ,$trginperrlist); + + #Clean up and sleep (also needed at start-up) + trb_register_write(0xffff,0x20,0x10); + + $feeerrinmdc--; + $feeerrinmdc = 0 unless ($feeerrcnt); + sleep(15); + + } diff --git a/hmon/hmon_logmissingmbo.pl b/hmon/hmon_logmissingmbo.pl new file mode 100755 index 0000000..b9b3f2d --- /dev/null +++ b/hmon/hmon_logmissingmbo.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; + +use POSIX qw(floor); +use FileHandle; +use Hmon; +use QA; +use Getopt::Long; +use Data::Dumper; + +use HADES::TrbNet; + +my $store = {}; +my $tmpstore = {}; +my $flag = {}; +my $msg = ""; +my $boardstring = ""; +my $numboards = -1; +my $log = ""; + +my $flog = Hmon::OpenLogfile(); +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die "could not reach trbnet-daemon.", trb_strerror(); + + +#Watch Reserve line from MBO +my $rh_mbo; +while (1) { + $rh_mbo = trb_register_read(0xfffd, 0xe403) or sleep 5 and next; + + foreach my $board (keys %$rh_mbo) { + my $val = ($rh_mbo->{$board} >> 31) & 0x1; + + if ($val) { + $store->{$board}++; + } else { + $store->{$board} = $store->{$board}?-400:0; + $flag->{$board} = 0; + } + } + + $boardstring = " "; + foreach my $a (sort keys %$store) { + if ($store->{$a} >= 30) { + $boardstring .= sprintf("%04x ", $a); + $store->{$a} = -1010; + $flag->{$a} = 1; + } + } + if ($boardstring ne " ") { +# $msg = sprintf(" MDC \\ MBO %s might be locked up", $boardstring); + $msg = " MDC \\ MBO " . $boardstring . " might be locked up"; + + $log = $boardstring; + system("logger -p local1.info -t DAQ '".$msg."'"); +# Hmon::WriteLog($flog, "MBO-blocked", "MBO that might be locked: %s", $boardstring); + } + + if (++$numboards == 0) { + foreach my $f (%{$flag}) { + $numboards++ if (defined $flag->{$f} && $flag->{$f} != 0); + } + my $qastate = QA::GetQAState('below', $numboards, @QA::MdcLockLimits); +# QA::WriteQALog($fqa, "mdc", "blocked", 15, $qastate, "MBO Locked", "$numboards", +# "MBO that are locked: $numboards - " . $log); + $numboards = -10; + } + + sleep 1; +} + diff --git a/hmon/hmon_mdc_busy.pl b/hmon/hmon_mdc_busy.pl new file mode 100755 index 0000000..5e4023d --- /dev/null +++ b/hmon/hmon_mdc_busy.pl @@ -0,0 +1,80 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; +use HADES::TrbNet; + + +my @str; + +my %laststore; +my $values = {}; +my $color = {}; +my $raw = {}; +my $val; +my $max; +my $min; +my $avg; +my $mean; + +my $flog = Hmon::OpenLogfile(); +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_mdc_busy = trb_register_read(0xfffd, 0x9113) or sleep 5 and next; + + my $numboards = 0; + my %store; + foreach my $board (sort {$a <=> $b} keys %$rh_mdc_busy) { + my $id_0 = ($board >> 8) & 0xf; + my $id_1 = ($board >> 4) & 0xf; + my $id_2 = ($board >> 0) & 0xf; + $store{$id_0}->{$id_1}->{$id_2} = $rh_mdc_busy->{$board}; + $numboards++ if ($id_0 != 0xf); + } + + $values = Hmon::MakeDifferences(\%store, \%laststore, 2**31*2); + $max = 1.1E6; + $min = 0; + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Busy times (normalized to 100%)"); + for (my $l = 0; $l < 4; $l++) { + $str[0][$l] = + Hmon::MakeTitle(9, 3, "MDC $l Busy times (normalized to 100%)"); + $str[1][$l] = ""; + for (my $s = 0; $s < 6; $s++) { + for (my $b = 0; $b < 16; $b++) { + $color->{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($values->{$l}->{$s}->{$b}, + $min, $max, 0)); + $raw->{$b} = sprintf("%.2f%%", $values->{$l}->{$s}->{$b} / 10000); + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, $color, $raw); + } + $str[2][$l] = Hmon::DrawScale(0, 100, 40); + $str[2][$l] .= Hmon::MakeFooter(); + } + Hmon::WriteFile("MDCBusy", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); + + ($min, $max, $avg, $mean) = Hmon::MakeMinMax3($values, 4, 6, 16, 1); +# Hmon::WriteLog($flog, "MDC BusyTime", +# "Busy Times: min. %.2f%% - max. %.2f%% - Ø %.2f%%", +# $min / 10000, $max / 10000, $avg / 10000); + +# my $qastate = QA::GetQAState('above', $numboards, @QA::MdcOepLimits); +# QA::WriteQALog($fqa, "mdc", "oeps", 20, $qastate, +# "OEP present", "$numboards / " . $QA::MdcOepLimits[0], ""); + + %laststore = %store; + sleep 1; +} + diff --git a/hmon/hmon_mdc_invaliddatamode.pl b/hmon/hmon_mdc_invaliddatamode.pl new file mode 100755 index 0000000..0f23f19 --- /dev/null +++ b/hmon/hmon_mdc_invaliddatamode.pl @@ -0,0 +1,42 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use HADES::TrbNet; +use Hmon; +use QA; + + +trb_init_ports() or die trb_strerror(); +my $fqa = QA::OpenQAFile(); + + +my $cnt = 0; + +while (1) { + my $rh_status = trb_register_read(0xfffd, 0x22) or sleep 5 and next; + my $cnt = 0; + my $boardlist = ""; + foreach my $o (sort keys $rh_status) { + if ($rh_status->{$o} & (1 << 30)) { + $boardlist .= sprintf("%04x, ",$o); + $cnt++; + } + } + + my $qastate = QA::OK; + my $status = ""; + my $longmsg = "No OEP is out-of-order and sending the invalid data flag due to low HV"; + + + chop $boardlist; chop $boardlist; + $qastate = QA::WARN_2 if $cnt; + $status = "$cnt" if $cnt; + $longmsg = "Boards sending the out-of-order flag: $boardlist" if $cnt; + + QA::WriteQALog($fqa, "other", "mdcinvalid", 20, $qastate,"MDC HV", $status,$longmsg); + sleep(5); + } \ No newline at end of file diff --git a/hmon/hmon_mdc_linkerr.pl b/hmon/hmon_mdc_linkerr.pl new file mode 100755 index 0000000..41ef6ed --- /dev/null +++ b/hmon/hmon_mdc_linkerr.pl @@ -0,0 +1,53 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; + +my %laststore; +my $totalsum = 0; +use HADES::TrbNet; +use Hmon; +use QA; + +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_mdc_link = trb_register_read(0xfffd, 0x4) or sleep 5 and next; + + my %store; + foreach my $board (sort {$a <=> $b} keys %$rh_mdc_link) { + $store{$board} = ((($rh_mdc_link->{$board} >> 24) & 0xff) + + (($rh_mdc_link->{$board} >> 16) & 0xff)); + } + + my $sum = 0; + if (%laststore) { + foreach my $c (keys %store) { + if (!defined $laststore{$c}) { + # new endpoint appeared + next; + } + if ($store{$c} - $laststore{$c} < 0) { + $sum += $store{$c} - $laststore{$c} + 256; + } else { + $sum += $store{$c} - $laststore{$c}; + } + } + $totalsum += $sum; + my $value = ""; + $value = $sum . " Errors" if $sum; + my $qastate = QA::GetQAState('below', $sum, @QA::LinkErrLimits); + QA::WriteQALog($fqa, "mdc", "linkqual", 20, $qastate, + "Link Errors", $value, + $sum . " errors in last second. $totalsum in total."); + } + + %laststore = %store; + sleep 1; +} diff --git a/hmon/hmon_mdc_plotmissingboards.pl b/hmon/hmon_mdc_plotmissingboards.pl new file mode 100755 index 0000000..99a2731 --- /dev/null +++ b/hmon/hmon_mdc_plotmissingboards.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use List::Util 'max'; +use QA; +use Hmon; + + +my @str; + +my $color = {}; +my $raw = {}; +my ($max,$min); +my $lasttime = 0; +my $store = {}; + + my @out = qx(ssh lxhadesdaq cat /home/hadeslog/messages | grep 'Endp 0x\\w\\w\\w\\w missing' | grep -v 2006 | grep -v 2022 | grep -v 2358); + + + foreach my $s ( @out) { + my ($h,$m,$s,$id_0,$id_1,$id_2) = $s =~ m/(\d\d):(\d\d):(\d\d) .* Endp 0x2(\w)(\w)(\w) missing/; + my $time = ($h||0)*3600+($m||0)*60+($s||0); + if(defined $id_0 && defined $id_1 && defined $id_2 && $time>$lasttime+70) { + $id_2 = hex($id_2); + $store->{$id_0}->{$id_1}->{$id_2}++; + } + $lasttime = $time; + } + + ($min,$max) = Hmon::MakeMinMax3($store, 4, 6, 16); + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Failures"); + for (my $l = 0; $l < 4;$l++) { + $str[0][$l] = Hmon::MakeTitle(9, 3, "MDC $l Failures"); + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color->{$b} = sprintf("style=\"background:%4s;\"",Hmon::findcolor($store->{$l}->{$s}->{$b},$min,$max,0)); + $raw->{$b} = sprintf("%.1f",$store->{$l}->{$s}->{$b}); + } + $str[1][$l] .= Hmon::DrawMDC($l,$s,$color,$raw); + } + $str[2][$l] = Hmon::DrawScale($min,$max,42); + $str[2][$l] .= Hmon::MakeFooter(); + # Hmon::WriteFile("MDC".$l."Temperature",$str[0][$l].$str[1][$l].$str[2][$l]); + } + Hmon::WriteFile("MDCFailure",$str[0][4]."

".$str[1][0].$str[1][1]."

".$str[1][2]."

".$str[1][3].$str[2][0]); + + + diff --git a/hmon/hmon_mdc_rate.pl b/hmon/hmon_mdc_rate.pl new file mode 100755 index 0000000..2735e02 --- /dev/null +++ b/hmon/hmon_mdc_rate.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use HADES::TrbNet; + +my %laststore; +my $color = {}; +my $raw = {}; +my $val; +my $max; +my $min; +my $avg; +my $lastevents=0; +use Hmon; +my $flog = Hmon::OpenLogfile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_mdc_rates = trb_register_read(0xfffd, 0x910b) or sleep 5 and next; + my $events = trb_register_read(0x0002,1) or sleep 1 and next; + + my %store; + foreach my $board (sort {$a <=> $b} keys %$rh_mdc_rates) { + my $id_0 = ($board >> 8) & 0xf; + my $id_1 = ($board >> 4) & 0xf; + my $id_2 = ($board >> 0) & 0xf; + $store{$id_0}->{$id_1}->{$id_2} = $rh_mdc_rates->{$board}; + } + $events = ($events->{2}&0xffff); + my $rate = ($events || 0) - ($lastevents ||0); + if ($rate < 0) {$rate += 2**16;} + if ($rate == 0) {$rate = 1;} + $lastevents = $events; + + my @str; + my $values = {}; + $values = Hmon::MakeDifferences(\%store, \%laststore, 2**31*2); + ($min,$max,$avg) = Hmon::MakeMinMax3($values, 4, 6, 16, 0); + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Rates (log-scale, all MBO)"); + for (my $l = 0; $l < 4;$l++) { + $str[0][$l] = Hmon::MakeTitle(9, 3, "MDC $l Rates (log-scale, all MBO)"); + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color->{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($values->{$l}->{$s}->{$b}, + 0, $max, 1)); + $raw->{$b} = sprintf("%.2g / %.1f per event", $values->{$l}->{$s}->{$b},$values->{$l}->{$s}->{$b}/$rate); + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, $color, $raw); + } + $str[2][$l] = Hmon::DrawScale($min, $max, 40); + $str[2][$l] .= Hmon::MakeFooter(); + } + + Hmon::WriteFile("MDCRates", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); +# Hmon::WriteLog($flog, "MDC Rates", "Data Rates (words/s): min. %i - max. %i - Ø %i", $min, $max, $avg); + + %laststore = %store; + sleep 1; +} + diff --git a/hmon/hmon_mdc_ratecheck.pl b/hmon/hmon_mdc_ratecheck.pl new file mode 100755 index 0000000..409b80f --- /dev/null +++ b/hmon/hmon_mdc_ratecheck.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use HADES::TrbNet; +use Hmon; +use QA; + +my $laststore; +my $values; +my ($sum,$num,$avg); +my $flog = Hmon::OpenLogfile(); +my $evtnum = 0; +my $rate = 0; +my $iteration = 0; + +trb_init_ports() or die trb_strerror(); +my $fqa = QA::OpenQAFile(); + +while (1) { + $sum = 0; + $num = 0; + my $error = 0; + my $boardlist = ""; + $values = (); + + my $rh_mdc_rates = trb_register_read(0xfffd, 0x910b) or sleep 5 and next; + my $rh_evts = trb_register_read(0x0002, 0x0001) or sleep 5 and next; + + foreach my $v (sort keys $rh_mdc_rates) { + $values->{$v} = ($rh_mdc_rates->{$v} || 0) - ($laststore->{$v} || $rh_mdc_rates->{$v} || 0); + $laststore->{$v} = $rh_mdc_rates->{$v}; + $sum += $values->{$v}; + $num++; + } + $rate = (($rh_evts->{2} || 0) & 0xffff) - $evtnum; + while ($rate < 0) {$rate += 2**16;} + $evtnum = (($rh_evts->{2} || 0) & 0xffff); + + + +# print $iteration."\n"; + if($iteration) { + $avg = $sum / ($num || $sum); +# print $rate." ".$num." ".$sum." ".$avg."\n"; + + + if($rate > 1000 && $avg > 1000) { + foreach my $v (sort keys $values) { +# print($v." ".$values->{$v}."\n"); + if($values->{$v} == 0) { + $error++; + $boardlist .= sprintf("%04x, ",$v); + } + } + } + chop $boardlist; chop $boardlist; + my $qastate = QA::OK; + my $status = ""; + $qastate = QA::ERROR if($error); + $status = $error." errors" if $error; + my $longmsg = sprintf("All MDC motherboard deliver data - Avg. number of words per second: %i - Avg number of words per event: %i",$avg,$avg/($rate || 1)); + $longmsg = "MDC motherboards not delivering data: $boardlist" if $error; + QA::WriteQALog($fqa, "mdc", "blocked", 20, $qastate,"MBO w/o data", $status,$longmsg); + } + else { + $iteration = 1; + } + sleep 10; + } \ No newline at end of file diff --git a/hmon/hmon_mdc_retr.pl b/hmon/hmon_mdc_retr.pl new file mode 100755 index 0000000..a1a723b --- /dev/null +++ b/hmon/hmon_mdc_retr.pl @@ -0,0 +1,110 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Data::Dumper; +use HADES::TrbNet; +use Hmon; + +my %laststore_lo; +my %laststore_hi; + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_mdc_retr = trb_register_read(0xfffd, 0x04) or sleep 5 and next; + + my %store_lo; + my %store_hi; + foreach my $board (keys %$rh_mdc_retr) { + my $l = ($board >> 8) & 0xf; + my $s = ($board >> 4) & 0xf; + my $b = ($board >> 0) & 0xf; + $store_lo{$l}->{$s}->{$b} = ($rh_mdc_retr->{$board} >> 16) & 0xff; + $store_hi{$l}->{$s}->{$b} = ($rh_mdc_retr->{$board} >> 24) & 0xff; + } + + my $ref_lo = Hmon::MakeDifferences(\%store_lo, \%laststore_lo, 2**8); + my $ref_hi = Hmon::MakeDifferences(\%store_hi, \%laststore_hi, 2**8); + + %laststore_lo = %store_lo; + %laststore_hi = %store_hi; + + my %store; + my %store2; + + for (my $l = 0; $l < 4; $l++) { + for (my $s = 0; $s < 6; $s++) { + for (my $b = 0; $b < 16; $b++) { + $store2{$l}->{$s}->{$b} = ($store_lo{$l}->{$s}->{$b}||0) + ($store_hi{$l}->{$s}->{$b}||0); + if (defined $ref_lo->{$l}->{$s}->{$b}) { + $store{$l}->{$s}->{$b} = $ref_lo->{$l}->{$s}->{$b} + $ref_hi->{$l}->{$s}->{$b}; + } + else { + $store{$l}->{$s}->{$b} = 0; + } + } + } + } + + my @str; + my %color; + my %raw; + my $max; + my $min; + ($min, $max) = Hmon::MakeMinMax3(\%store, 4, 6, 16, 0); + if ($min == 0 && $max == 0) { + $max = 1; + } + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Retransmission Rate "); + for (my $l = 0; $l < 4; $l++) { + $str[0][$l] = Hmon::MakeTitle(9, 3, "MDC $l Retransmission Rate "); + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($store{$l}->{$s}->{$b}, + $min, $max,0)); + $raw{$b} = sprintf("%.2g", $store{$l}->{$s}->{$b}); + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, \%color, \%raw); + } + $str[2][$l] = Hmon::DrawScale($min, $max, 40); + $str[2][$l] .= "\n"; + } + + Hmon::WriteFile("MDCRetransmissionRate", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); + + + ($min, $max) = Hmon::MakeMinMax3(\%store, 4, 6, 16, 0); + if ($min == 0 && $max == 0) { + $max = 1; + } + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Retransmission Total "); + for (my $l = 0; $l < 4; $l++) { + $str[0][$l] = Hmon::MakeTitle(9, 3, "MDC $l Retransmission Total "); + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($store2{$l}->{$s}->{$b}, + $min, $max,0)); + $raw{$b} = sprintf("%.2g", $store2{$l}->{$s}->{$b}); + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, \%color, \%raw); + } + $str[2][$l] = Hmon::DrawScale($min, $max, 40); + $str[2][$l] .= "\n"; + } + + Hmon::WriteFile("MDCRetransmission", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); + + + sleep 1; +} + + diff --git a/hmon/hmon_mdc_temp.pl b/hmon/hmon_mdc_temp.pl new file mode 100755 index 0000000..87e9f1a --- /dev/null +++ b/hmon/hmon_mdc_temp.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use List::Util 'max'; +use QA; + +use Hmon; +my $flog = Hmon::OpenLogfile(); +my $fqa = QA::OpenQAFile(); + +use HADES::TrbNet; + +my @str; + +my $store = {}; +my $laststore = {}; +my $values = {}; +my $color = {}; +my $raw = {}; +my $val; +my ($max,$min,$avg,$mean); + +trb_init_ports() or die trb_strerror(); + + +while (1) { + my $rh_mdc_temp; + $rh_mdc_temp = trb_register_read(0xfffd, 0x0) or sleep 5 and next; + + foreach my $board (sort {$a <=> $b} keys %$rh_mdc_temp) { + my $id_0 = ($board >> 8) & 0x0f; + my $id_1 = ($board >> 4) & 0x0f; + my $id_2 = ($board >> 0) & 0x0f; + $store->{$id_0}->{$id_1}->{$id_2} = + (($rh_mdc_temp->{$board} >> 20) & 0xfff) / 16; + # printf "temp: %x %x %x\n", $id_0, $id_1, $id_2; + # printf "temp: %x\n", $store->{$id_0}->{$id_1}->{$id_2}; + } + + ($min,$max) = Hmon::MakeMinMax3($store, 4, 6, 16); + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Temperatures"); + for (my $l = 0; $l < 4;$l++) { + $str[0][$l] = Hmon::MakeTitle(9, 3, "MDC $l Temperatures"); + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color->{$b} = sprintf("style=\"background:%4s;\"",Hmon::findcolor($store->{$l}->{$s}->{$b},$min,$max,0)); + $raw->{$b} = sprintf("%.1f",$store->{$l}->{$s}->{$b}); + } + $str[1][$l] .= Hmon::DrawMDC($l,$s,$color,$raw); + } + $str[2][$l] = Hmon::DrawScale($min,$max,42); + $str[2][$l] .= Hmon::MakeFooter(); + # Hmon::WriteFile("MDC".$l."Temperature",$str[0][$l].$str[1][$l].$str[2][$l]); + } + Hmon::WriteFile("MDCTemperature",$str[0][4]."

".$str[1][0].$str[1][1]."

".$str[1][2]."

".$str[1][3].$str[2][0]); + + my @mint; my @maxt; + for (my $i = 0; $i<4; $i++) { + ($mint[$i],$maxt[$i],$avg,$mean) = Hmon::MakeMinMax2(\%{$store->{$i}},6,16,1); + Hmon::WriteLog($flog, "MDC $i Temp","Temperatures, Sector %i: min. %.1f°C - max. %.1f°C - Ø %.1f°C",$i,$min,$max,$avg); + } + + my $qastate = QA::GetQAState('below', max(@maxt), @QA::MdcTempLimits); + my $str = sprintf("%i/%i/%i/%i", $maxt[0], $maxt[1], $maxt[2], $maxt[3]); + QA::WriteQALog($fqa,"mdc","temp", 40, $qastate, "Temperature", $str, + "Max. temperature in each plane of MDC are " . $str); + $store = {}; + + sleep 20; +} diff --git a/hmon/hmon_mdc_tokenmiss.pl b/hmon/hmon_mdc_tokenmiss.pl new file mode 100755 index 0000000..ddda5a0 --- /dev/null +++ b/hmon/hmon_mdc_tokenmiss.pl @@ -0,0 +1,77 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use HADES::TrbNet; + + +my %laststore; +my $color = {}; +my $raw = {}; +my $val; +my $max; +my $min; +my $avg; + +use Hmon; +use QA; +my $flog = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_mdc_tokenmiss = trb_register_read(0xfffd, 0x9101) or sleep 5 and next; + my $totalsum = 0; + my %store; + foreach my $board (sort {$a <=> $b} keys %$rh_mdc_tokenmiss) { + my $id_0 = ($board >> 8) & 0xf; + my $id_1 = ($board >> 4) & 0xf; + my $id_2 = ($board >> 0) & 0xf; + $store{$id_0}->{$id_1}->{$id_2} = $rh_mdc_tokenmiss->{$board}; + $totalsum += $rh_mdc_tokenmiss->{$board}; + } + + my @str; + my $values = {}; + my $sum = 0; + my $totalsum = 0; + my $r_store = \%store; + $values = Hmon::MakeDifferences($r_store, \%laststore, 2**31*2); + ($min,$max,$avg) = Hmon::MakeMinMax3($r_store, 4, 6, 16, 0); + $str[0][4] = Hmon::MakeTitle(9, 10, "MDC Missing Tokens"); + for (my $l = 0; $l < 4;$l++) { + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color->{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($r_store->{$l}->{$s}->{$b}, + 0, $max, 1)); + $raw->{$b} = sprintf("%i", $r_store->{$l}->{$s}->{$b}); + $totalsum += $r_store->{$l}->{$s}->{$b}; + $sum += $values->{$l}->{$s}->{$b}; + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, $color, $raw); + } + $str[2][$l] = Hmon::DrawScale($min, $max, 40); + $str[2][$l] .= Hmon::MakeFooter(); + } + + + + Hmon::WriteFile("MDCTokenMiss", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); + + my $qastate = QA::GetQAState('below', $sum, @QA::MdcTokenMissLimits); +# QA::WriteQALog($fqa, "mdc", "oeps", 20, $qastate, +# "OEP present", "$numboards / " . $QA::MdcOepLimits[0], ""); + + QA::WriteQALog($flog,"mdc","token",20,$qastate,"MBO Reinit",($sum || 0)."","Missing Tokens / MBO Reinitializations during last second: $sum - Total number of reinits: $totalsum"); + + %laststore = %store; + sleep 1; +} + diff --git a/hmon/hmon_mdc_voltage.pl b/hmon/hmon_mdc_voltage.pl new file mode 100755 index 0000000..93c4787 --- /dev/null +++ b/hmon/hmon_mdc_voltage.pl @@ -0,0 +1,68 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use POSIX qw(strftime); +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; +use HADES::TrbNet; + +my $store = {}; +my $msg = ""; +my $low = 0; +my $high = 0; +my $status = ""; + +my @names = qw(5.8V 5V 3.8V 3.3V 1.8V 1.2V 3V -3V); +my @minimum = (5.5, 4.75, 3.5, 3.15, 1.4, 1.15, 2.90, -3.05); +my @maximum = (6.1, 5.1, 4.0, 3.4, 2.0, 1.25, 3.10, -2.95); + + +my $fqa = QA::OpenQAFile(); +my $qastate; + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_volt = trb_register_read_mem(0xfffd, 0x8010, 0, 8) or sleep 5 and next; + + foreach my $board (sort {$a <=> $b} keys %$rh_volt) { + my $reg_address = 0; + foreach my $val (@{$rh_volt->{$board}}) { + if ($reg_address < 2) { + $store->{$reg_address}->{$board} = $val * 2; + } elsif ($reg_address == 7) { + $store->{$reg_address}->{$board} = -$val; + } else { + $store->{$reg_address}->{$board} = $val; + } + if ($store->{$reg_address}->{$board} > $maximum[$reg_address] * 1000) { + my $boardstr = sprintf("%04x",$board); + $msg .= " $boardstr $names[$reg_address] high (".sprintf("%.2fV),",$store->{$reg_address}->{$board}/1000.); + $high++; + } + if ($store->{$reg_address}->{$board} < $minimum[$reg_address] * 1000) { + my $boardstr = sprintf("%04x",$board); + $msg .= " $boardstr $names[$reg_address] low (".sprintf("%.2fV),",$store->{$reg_address}->{$board}/1000.); + $low++; + } + $reg_address++; + } + } + + $status = $high + $low . " warnings"; + my $qastate = QA::GetQAState('below', $high + $low, @QA::MdcVoltageLimits); + QA::WriteQALog($fqa, "mdc", "voltage", 30, $qastate,"Voltages", $status,$msg); + + $qastate = QA::OK; + $msg = ""; + $low = 0; + $high = 0; + $status = ""; + + sleep 15; +} diff --git a/hmon/hmon_mdchv_plottemplate.pl b/hmon/hmon_mdchv_plottemplate.pl new file mode 100755 index 0000000..c580a24 --- /dev/null +++ b/hmon/hmon_mdchv_plottemplate.pl @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use POSIX qw(strftime); +use Hmon; + + + +my $title = qq$ + + + + + + Hmon MDC HV Trends + + +

+

Hmon MDC HV Trends

+
+
+ $; + +my $foot = qq$ + + + $; + +my $out = $title; + +foreach my $i (0..3) { + $out .= "

Plane ".($i+1)."

"; + $out .= qq%Sector 1

%; + $out .= qq%Sector 2

%; + $out .= qq%Sector 3

%; + $out .= qq%Sector 4

%; + $out .= qq%Sector 5

%; + $out .= qq%Sector 6

%; + } + +my $fh; +open ($fh,"> ".Hmon::HMONDIR."/files/MDCHVtrends.htm") or die; +print $fh $out; diff --git a/hmon/hmon_muxhist.pl b/hmon/hmon_muxhist.pl new file mode 100755 index 0000000..13631bb --- /dev/null +++ b/hmon/hmon_muxhist.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die("could not connect to trbnetd"); + + +my $str; + +my $plots = fork(); + + +if($plots) { + while(1) { + $str = Hmon::MakeTitle(10,12,"Mux Histogram",0); + my $binning = trb_register_read(3,0xa0c8) or sleep 5 and next; + my $offset = trb_register_read(3,0xa0c6) or sleep 5 and next; + my $source = trb_register_read(3,0xa0c2) or sleep 5 and next; + + $binning = QA::SciNotation($binning->{3}*100E-9); + $offset = QA::SciNotation($offset->{3}*100E-9); + + my @src; + $src[0] = $source->{3} & 0xFF; + $src[1] = ($source->{3} & 0xFF00) >> 8; + + foreach my $i (0..1) { + if ($src[$i] <= 7) {$src[$i] = "Start ".($src[$i]+1)." after edge detect";} + elsif($src[$i] <= 15) {$src[$i] = "Veto ".($src[$i]-7)." after edge detect";} + elsif($src[$i] <= 21) {$src[$i] = "TOF ".($src[$i]-15)." after edge detect";} + elsif($src[$i] <= 27) {$src[$i] = "RPC ".($src[$i]-21)." after edge detect";} + elsif($src[$i] <= 35) {$src[$i] = "PT ".($src[$i]-27)." after edge detect";} + + elsif($src[$i] <= 43) {$src[$i] = "Start ".($src[$i]-35)." after delay";} + elsif($src[$i] <= 51) {$src[$i] = "Veto ".($src[$i]-43)." after delay";} + elsif($src[$i] <= 57) {$src[$i] = "TOF ".($src[$i]-51)." after delay";} + elsif($src[$i] <= 63) {$src[$i] = "RPC ".($src[$i]-57)." after delay";} + elsif($src[$i] <= 71) {$src[$i] = "PT ".($src[$i]-63)." after delay";} + + elsif($src[$i] <= 77) {$src[$i] = "Sectorwise Mult. ".($src[$i]-71);} + elsif($src[$i] <= 78) {$src[$i] = "Sectorwise Mult. 2 no neighbor";} + elsif($src[$i] <= 79) {$src[$i] = "Sectorwise Mult. 3 no neighbor";} + elsif($src[$i] <= 80) {$src[$i] = "Sectorwise Mult. 2 opposite";} + + elsif($src[$i] <= 87) {$src[$i] = "Wrong setting";} + elsif($src[$i] <= 93) {$src[$i] = "TOF ".($src[$i]-87)." after width";} + elsif($src[$i] <= 99) {$src[$i] = "RPC ".($src[$i]-93)." after width";} + elsif($src[$i] <= 107){$src[$i] = "PT ".($src[$i]-99)." after width";} + elsif($src[$i] <= 126){$src[$i] = "Wrong setting";} + + elsif($src[$i] <= 127){$src[$i] = "Start for coincidence";} + elsif($src[$i] <= 128){$src[$i] = "Veto for anti-coincidence";} + elsif($src[$i] <= 129){$src[$i] = "Anti-coincidence";} + else {$src[$i] = "Wrong setting";} + + } + + + $str .= qq@Source A: @.$src[0].qq@, Source B: @.$src[1].qq@
Offset: $offset@.qq@s - Binning: $binning@.qq@s@; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("Muxhist",$str); + sleep(5); + } + } + +else { + qx(./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 41216 -m 500 -p 0 -w 32 -t "A" \\ + -a 0x0003 -r 41716 -m 500 -p 0 -w 32 -t "B" \\ + -output "PNG.files/muxhist.760.530" -curvestyle steps -key genreg 2>/dev/null & + + ); + } + diff --git a/hmon/hmon_muxhist_ratio.pl b/hmon/hmon_muxhist_ratio.pl new file mode 100755 index 0000000..e7a1e0c --- /dev/null +++ b/hmon/hmon_muxhist_ratio.pl @@ -0,0 +1,105 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use Time::HiRes qw( gettimeofday usleep time ); +use POSIX qw(strftime); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; +use Perl2Epics; +use HADES::TrbNet; +use HPlot; + + +my @names = qw( reflowPressureAthm reflowPressureCompr reflowInO2 reflowRatioCO2 opensysFreshARGON opensysFreshCO2 reflowFreshArgon reflowFreshIsob pipePressureIsoB ); +my @names2 = qw(waage_1_net waage_2_net); +my @names3 = qw(targetVakPressure); +trb_init_ports() or die("could not connect to trbnetd"); + +my $plot = (); +$plot->{name} = "MuxRatio"; +$plot->{file} = "files/CtsMuxRatio"; +$plot->{entries} = 440; +$plot->{type} = HPlot::TYPE_HISTORY; +$plot->{output} = HPlot::OUT_PNG; +$plot->{titles}->[0] = ""; +$plot->{titles}->[1] = ""; +$plot->{xlabel} = "Bins"; +$plot->{ylabel} = "Ratio Source B / Source A"; +$plot->{sizex} = 630; +$plot->{sizey} = 330; +$plot->{curves} = 1; +$plot->{countup} = 1; +$plot->{nokey} = 1; + +HPlot::PlotInit($plot); + + + +while(1) { + +my $str = Hmon::MakeTitle(8,8,"CTS Mux Histogram Ration",0); + my $binning = trb_register_read(3,0xa0c8) or sleep 5 and next; + my $offset = trb_register_read(3,0xa0c6) or sleep 5 and next; + my $source = trb_register_read(3,0xa0c2) or sleep 5 and next; + + $binning = QA::SciNotation($binning->{3}*100E-9); + $offset = QA::SciNotation($offset->{3}*100E-9); + + my @src; + $src[0] = $source->{3} & 0xFF; + $src[1] = ($source->{3} & 0xFF00) >> 8; + + foreach my $i (0..1) { + if ($src[$i] <= 7) {$src[$i] = "Start ".($src[$i]+1)." after edge detect";} + elsif($src[$i] <= 15) {$src[$i] = "Veto ".($src[$i]-7)." after edge detect";} + elsif($src[$i] <= 21) {$src[$i] = "TOF ".($src[$i]-15)." after edge detect";} + elsif($src[$i] <= 27) {$src[$i] = "RPC ".($src[$i]-21)." after edge detect";} + elsif($src[$i] <= 35) {$src[$i] = "PT ".($src[$i]-27)." after edge detect";} + + elsif($src[$i] <= 43) {$src[$i] = "Start ".($src[$i]-35)." after delay";} + elsif($src[$i] <= 51) {$src[$i] = "Veto ".($src[$i]-43)." after delay";} + elsif($src[$i] <= 57) {$src[$i] = "TOF ".($src[$i]-51)." after delay";} + elsif($src[$i] <= 63) {$src[$i] = "RPC ".($src[$i]-57)." after delay";} + elsif($src[$i] <= 71) {$src[$i] = "PT ".($src[$i]-63)." after delay";} + + elsif($src[$i] <= 77) {$src[$i] = "Sectorwise Mult. ".($src[$i]-71);} + elsif($src[$i] <= 78) {$src[$i] = "Sectorwise Mult. 2 no neighbor";} + elsif($src[$i] <= 79) {$src[$i] = "Sectorwise Mult. 3 no neighbor";} + elsif($src[$i] <= 80) {$src[$i] = "Sectorwise Mult. 2 opposite";} + + elsif($src[$i] <= 87) {$src[$i] = "Wrong setting";} + elsif($src[$i] <= 93) {$src[$i] = "TOF ".($src[$i]-87)." after width";} + elsif($src[$i] <= 99) {$src[$i] = "RPC ".($src[$i]-93)." after width";} + elsif($src[$i] <= 107){$src[$i] = "PT ".($src[$i]-99)." after width";} + elsif($src[$i] <= 126){$src[$i] = "Wrong setting";} + + elsif($src[$i] <= 127){$src[$i] = "Start for coincidence";} + elsif($src[$i] <= 128){$src[$i] = "Veto for anti-coincidence";} + elsif($src[$i] <= 129){$src[$i] = "Anti-coincidence";} + else {$src[$i] = "Wrong setting";} + + } + + + $str .= qq@Source A: @.$src[0].qq@, Source B: @.$src[1].qq@
Offset: $offset@.qq@s - Binning: $binning@."s (20 bins skipped at beginning of spill)"; + +$str .= qq@@; +$str .= Hmon::MakeFooter(); +Hmon::WriteFile("CtsMuxRatio",$str); + + + + my $mux1 = trb_register_read_mem(3,41236,0,460) or sleep 5 and next; + my $mux2 = trb_register_read_mem(3,41736,0,460) or sleep 5 and next; + + for(my $i=0;$i<440;$i++){ + my $e = $mux2->{3}->[$i]/($mux1->{3}->[$i] || 1); + HPlot::PlotAdd("MuxRatio",$e); + } + + HPlot::PlotDraw("MuxRatio"); + sleep(3); + } diff --git a/hmon/hmon_onlineqa.pl b/hmon/hmon_onlineqa.pl new file mode 100755 index 0000000..ab93187 --- /dev/null +++ b/hmon/hmon_onlineqa.pl @@ -0,0 +1,50 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; + + +my $fqa = QA::OpenQAFile(); +my $timecnt = 0; +my $qastate = QA::OK; + + +while (1) { + my $title = "Online QA"; + my $longmsg = "The QA server process is running."; + my $msg = ""; + + + my $cmd = "ssh lxhadeb06 'pgrep -fl \"hadesonlineserver.exe .* 9876\"' 0 && $out[0] =~ /hadesonlineserver.exe .* 9876/) { + $qastate = QA::ERROR; + $msg = "Not found"; + $longmsg = "The online QA server process could not be found."; + } + + QA::WriteQALog($fqa, "main", "onlineqa", 40, $qastate, $title, $msg, $longmsg); + + + if ($qastate > 60 && !($timecnt++ % 20)) { +# system("logger -p local1.info -t DAQ 'Hmon Online QA Server not found'"); + Hmon::Speak("qa","QA server crashed."); + $qastate = QA::WARN_2; + $timecnt = -4; + } + + + sleep 9; +} diff --git a/hmon/hmon_permanent_tail b/hmon/hmon_permanent_tail new file mode 100755 index 0000000..a561bcd Binary files /dev/null and b/hmon/hmon_permanent_tail differ diff --git a/hmon/hmon_rate2.pl b/hmon/hmon_rate2.pl new file mode 100755 index 0000000..fb07e15 --- /dev/null +++ b/hmon/hmon_rate2.pl @@ -0,0 +1,107 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Hmon; +use HADES::TrbNet; + +trb_init_ports() or die trb_strerror(); + +my $flog = Hmon::OpenLogfile(); + +while (1) { + my $rh_rate; + $rh_rate = trb_register_read_mem(0x0003, 0xa001, 0, 0xff) or sleep 5 and next; + + my %store; + foreach my $board (sort {$a <=> $b} keys %$rh_rate) { + my $ctr = 0xa001; + foreach my $val (@{$rh_rate->{$board}}) { + $store{$ctr} = $val; + $ctr++; + } + } + + my $ena = $store{0xa0c3} + $store{0xa0c4} * 2**32; + my $eno = $store{0xa0c7}; + my $str = ""; + + $str = Hmon::MakeTitle(12, 5, "CTS Rates", 1, ""); + $str .= "\n"; + $str .= "
12345678\n"; + $str .= "
Start in"; + + my $i; + foreach $i (0, 1, 2, 3, 4, 5, 6, 7) { + $str .= sprintf("%d", ($ena & ( 1<< $i)) ? "on" : "off", + $store{0xa008+$i}); + } + $str .= "
Veto in"; + foreach $i (8, 9, 10, 11, 12, 13, 14, 15) { + $str .= sprintf("%d", ($ena & (1 << $i)) ? "on" : "off", + $store{0xa008+$i}); + } + + $str .= "
TOF in"; + foreach $i (16, 17, 18, 19, 20, 21) { + $str .= sprintf("%d", ($ena & (1 << $i)) ? "on" : "off", + $store{0xa008+$i}); + } + $str .= "----"; + $str .= "
RPC in"; + foreach $i (22, 23, 24, 25, 26, 27) { + $str .= sprintf("%d", ($ena & (1 << $i)) ? "on" : "off", + $store{0xa008+$i}); + } + $str .= "----"; + $str .= "
Mult out"; + foreach $i (2, 3, 4, 5, 6, 7) { + $str .= sprintf("%d", ($eno & (1<<($i))) ? "on" : "off", + $store{0xa03f+$i}); + } + $str .= "----"; + + $str .= "
PT in"; + foreach $i (28, 29, 30, 31, 32, 33, 34, 35) { + $str .= sprintf("%d", ($ena & (1 << $i)) ? "on" : "off", + $store{0xa008+$i}); + } + $str .= "
PT dsc"; + foreach $i (11, 12, 13, 14, 15, 16, 17, 18) { + $str .= sprintf("%d","on",$store{0xa02c+$i}); + } + $str .= "
PT coin"; + foreach $i (9,10,11, 12, 13, 14, 15, 16) { + $str .= sprintf("%d","on",$store{0xa052+$i}); + } + $str .= "
PT out"; + foreach $i (11, 12, 13, 14, 15, 16, 17, 18) { + $str .= sprintf("%d", ($eno & (1 << $i)) ? "on" : "off", + $store{0xa03f+$i}); + } + $str .= "
Pulser"; + $str .= sprintf("%d", ($store{0xa0e3}) ? "on" : "off", + ($store{0xa0e3}) ? 1/$store{0xa0e3} * 2E8 : 0); + $str .= "--"; + $str .= sprintf("MDC Calib.", + ($store{0xa0c0} &0x20) ? "on" : "off"); + $str .= sprintf("SHW Calib.", + ($store{0xa0c0} &0x100) ? "on" : "off"); + $str .= sprintf("SHW Ped.", + ($store{0xa0c0} & 0x80) ? "off" : "on"); + $str .= sprintf("Status", + ($store{0xa0c0}& 0x200)?"on":"off"); + $str .= "----"; + $str .= "
Out"; + $str .= sprintf("%d", + ($store{0xa001}) ? "on" : "off", $store{0xa001}); + $str .= "
\n"; + $str .= Hmon::MakeFooter(); + + Hmon::WriteFile("CTSRates", $str); + + + sleep 1; +} + + diff --git a/hmon/hmon_readoutstuck.pl b/hmon/hmon_readoutstuck.pl new file mode 100755 index 0000000..01bf99d --- /dev/null +++ b/hmon/hmon_readoutstuck.pl @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use HADES::TrbNet; +use Hmon; +use QA; + +my $evtnum = 0; +my $rate = 0; + +trb_init_ports() or die trb_strerror(); +my $fqa = QA::OpenQAFile(); +Hmon::TraceDBLoad(); + +sub isFeeHub { + my $h = shift; + my $hubs = "3200 3210 3220 3230 3240 3250 8301 8311 8321 8401 8411 8601 8701 8801"; + my $hs = sprintf("%04x",$h); +# print $h."\n"; + if (index($hubs,$hs) != -1) { + return 1; + } + if ($h > 0x1000 && $h < 0x1200 && $h%16) { + return 1; + } + return 0; +} + + +while (1) { + my $boardlist = ""; + my $rh_status = trb_register_read(0x0003, 0xa0f8) or sleep 5 and next; + my $rh_evts = trb_register_read(0x0002, 0x0001) or sleep 5 and next; + + $rate = (($rh_evts->{2} || 0) & 0xffff) - $evtnum; + while ($rate < 0) {$rate += 2**16;} + $evtnum = ($rh_evts->{2} || 0) & 0xffff; + + my $qastate = QA::OK; + my $status = ""; + my $longmsg = "Read-out has no error"; + + if($rate == 0 && ($rh_status->{3} & (1 << 31)) && ($rh_status->{3} & 0x3ff00000)) { + my $rh_hubs = trb_register_read(0xfffe,0x81) or sleep 5 and next; + foreach my $h (sort keys $rh_hubs) { + if($rh_hubs->{$h} != 0) { +# $boardlist .= sprintf("%04x, ",$h); + if (isFeeHub($h)) { + for (my $i=0; $i<12; $i++) { + if ($rh_hubs->{$h} & (1<<$i)) { + $boardlist .= sprintf("%04x (%04x-%i), ",Hmon::TraceDBGet($h,$i-1),$h,($i-1));# + } + } + } + } + } + } + + chop $boardlist; chop $boardlist; + $qastate = QA::ERROR if $boardlist ne ""; + $status = "Waiting" if $boardlist ne ""; + $longmsg = "Read-out seems to be stuck. Hubs waiting for read-out: $boardlist" if $boardlist ne ""; + + QA::WriteQALog($fqa, "daq", "readout", 30, $qastate,"Read-out", $status,$longmsg); +# print $qastate." ".$status." ".$longmsg."\n"; + sleep(5); + } \ No newline at end of file diff --git a/hmon/hmon_rich_apvs.pl b/hmon/hmon_rich_apvs.pl new file mode 100755 index 0000000..ed26d6b --- /dev/null +++ b/hmon/hmon_rich_apvs.pl @@ -0,0 +1,128 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use QA; +use Data::Dumper; +use HADES::TrbNet; + +my $SLEEP_TIME = 10; +my $flog = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + + # Default Output Values + my $title = "Rich APVs"; + my $shorttext = ""; + my $longtext = " - all APV Sync-Bits are set," . + " - all Trigger- and IPU-Counters are in Sync"; + my $status = QA::OK; + + # Check APV Sync-Bits and config + my $rh_apv = trb_register_read_mem(0xfffb, 0xb000, 0, 15) + or sleep $SLEEP_TIME and next; + + # Check APV Sync-Bits + my $num_sync_error = 0; + my $sync_error_msg; + + foreach my $board (sort {$a <=> $b} keys %$rh_apv) { + my $apv_list_sync; + my $apv_ctr = 0; + + foreach my $val (@{$rh_apv->{$board}}) { + # Sync Status, error if not in sync (Bit31==1) and activated (Bit29==0) + if (!(((($val >> 29) & 0x7) == 0x4) || + ((($val >> 29) & 0x7) == 0x1))) { + $num_sync_error++; + if (!defined $apv_list_sync) { + $apv_list_sync = $apv_ctr; + } else { + $apv_list_sync = $apv_list_sync . ", " . $apv_ctr; + } + } + $apv_ctr++; + } + if (defined $apv_list_sync) { + $sync_error_msg = $sync_error_msg . + sprintf " - 0x%04x: %s", $board, $apv_list_sync; + } + } + + # CheckTrigger and IPU Counters + $rh_apv = trb_register_read(0xfffb, 0x80) + or sleep $SLEEP_TIME and next; + + my $trigger_error_msg; + my $ipu_error_msg; + my $num_trigger_error = 0; + my $num_ipu_error = 0; + + my $trigger_counter; + my $ipu_counter; + foreach my $board (sort {$a <=> $b} keys %$rh_apv) { + my $trigger_ctr = $rh_apv->{$board} & 0xffff; + my $ipu_ctr = ($rh_apv->{$board} >> 16) & 0xffff; + + if (!defined $trigger_counter) { + $trigger_counter = $trigger_ctr; + } + if (!defined $ipu_counter) { + $ipu_counter = $ipu_ctr; + } + + # Trigger Counter + if ($trigger_ctr != $trigger_counter) { + $num_trigger_error++; + if (!defined $trigger_error_msg) { + $trigger_error_msg = $trigger_error_msg . sprintf " 0x%04x", $board; + } else { + $trigger_error_msg = $trigger_error_msg . sprintf ", 0x%04x", $board; + } + } + + # IPU Counter + if ($trigger_ctr != $trigger_counter) { + $num_ipu_error++; + if (!defined $ipu_error_msg) { + $ipu_error_msg = $ipu_error_msg . sprintf " 0x%04x", $board; + } else { + $ipu_error_msg = $ipu_error_msg . sprintf ", 0x%04x", $board; + } + } + } + + # Create Output Messages + if (($num_sync_error > 0) || + ($num_ipu_error > 0) || + ($num_trigger_error > 0)) { + $shorttext = "Errors: '"; + $shorttext = $shorttext . ($num_sync_error > 0 ? "S" : "_"); + $shorttext = $shorttext . ($num_trigger_error > 0 ? "T" : "_"); + $shorttext = $shorttext . ($num_ipu_error > 0 ? "I" : "_"); + $shorttext = $shorttext . "'"; + + $longtext = "Errors on: - "; + $longtext = $longtext . + ($num_sync_error > 0 ? + $num_sync_error . " APV_SYNC: " . $sync_error_msg . " - " + : ""); + $longtext = $longtext . + ($num_ipu_error > 0 ? + $num_ipu_error . " ADCM_IPU: " . $ipu_error_msg . " - " + : ""); + $longtext = $longtext . + ($num_trigger_error > 0 ? + $num_trigger_error . " ADCM_Trig: " .$trigger_error_msg . " - " + : ""); + + $status = QA::FATAL; + } + + QA::WriteQALog($flog, "feeerr", "rich", $SLEEP_TIME * 2, + $status, $title, $shorttext, $longtext); + + sleep $SLEEP_TIME; +} diff --git a/hmon/hmon_rsync b/hmon/hmon_rsync new file mode 100755 index 0000000..fa2f609 Binary files /dev/null and b/hmon/hmon_rsync differ diff --git a/hmon/hmon_shower.pl b/hmon/hmon_shower.pl new file mode 100755 index 0000000..a88af02 --- /dev/null +++ b/hmon/hmon_shower.pl @@ -0,0 +1,129 @@ +#!/usr/bin/perl -w + +#use warnings; +#use strict; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; + +my %laststore; +my $totalsum = 0; +use HADES::TrbNet; +use Hmon; +use QA; +use Perl2Epics; + +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +my %values; +my $sum = 0; + +my $alertCtr = 0; + + +for (my $s = 1; $s < 7; $s++) { + for (my $c = 0; $c < 3; $c++) { + Perl2Epics::Connect($s.$c, "HAD:SHWR:HV:S".$s.":C".$c.":imon"); + } +} + +while (1) { + + # get data from epics + my $data = Perl2Epics::GetAll(); + + my $setAlert = 0; + + # analyze data from TrbNet + my $bytes_sent = trb_register_read(0xff7f, 0x83f3) or sleep 5 and next; + my $configuration = trb_register_read(0xfff7, 0xc0) or sleep 5 and next; + + foreach my $board (sort {$a <=> $b} keys %$bytes_sent) { + my $hexval = sprintf("%x", $board); + my @a = split("", $hexval); + if($a[0] == "3" && $a[1] == "2") { + $values{$board}->{"bytes"} = %$bytes_sent->{$board} - $values{$board}->{"prev_bytes"} if defined %$bytes_sent->{$board}; + $values{$board}->{"prev_bytes"} = %$bytes_sent->{$board}; + + $sum += $values{$board}->{"bytes"}; + } + } + + foreach my $board (sort {$a <=> $b} keys %values) { + next if !defined $values{$board}->{"bytes"}; + + if ((($values{$board}->{"bytes"} > (($sum / 6) + (($sum / 6) * 0.4))) || ($values{$board}->{"bytes"} < (($sum / 6) - (($sum / 6) * 0.4)))) && $values{$board}->{"bytes"} != 0 && $sum > 25000) { + $setAlert = 1; + + } + } + + my $pattern = 0; + my $threshold = 0; + my $patternSum = 0; + my $thresholdSum = 0; + foreach my $board (keys %$configuration) { + $pattern = sprintf("%x", ((%$configuration->{$board} & 0xf0) >> 4)); + $threshold = sprintf("%x", (%$configuration->{$board} & 0xf)); + $patternSum += $pattern; + $thresholdSum += $threshold; + } + if ($patternSum / 12 != $pattern || $thresholdSum / 12 != $threshold) { + $setAlert = 2; + } + + + $sum = 0; + + #analyze data from EPICS + my $iSum = 0; + foreach my $n (%$data) { + if (defined %$data->{$n}->{"val"}) { + $iSum += %$data->{$n}->{"val"}; + } + } + + foreach my $n (%$data) { + if (defined %$data->{$n}->{"val"}) { + if (%$data->{$n}->{"val"} > ($iSum / 18) + 0.5) { + $setAlert = 3; + } + } + } + + #display results + + + my $message = ""; + foreach my $board (sort {$a <=> $b} keys %values) { + next if !defined $values{$board}->{"bytes"}; + $message .= "0x".sprintf("%x", $board); + $message .= ": ".(int ($values{$board}->{"bytes"} / 1000))."kB - "; + } + + $message .= " Sampling pattern set to: ".$pattern." - "; + $message .= " Global threshold set to: ".$threshold." - "; + + if ($setAlert != 0) { $alertCtr++; } + + if ($setAlert == 0) { + #print Dumper $message; + QA::WriteQALog($fqa, "other", "shower", 20, QA::OK, "Shower", "OK", "Proper operation - Data rates: - ".$message); + + $alertCtr = 0; + } + elsif ($setAlert == 1 && $alertCtr > 9) { + QA::WriteQALog($fqa, "other", "shower", 20, QA::WARN, "Shower", "Data rates", "Excessive amount of data generated by one or more of the sectors - ".$message); + } + elsif ($setAlert == 2 && $alertCtr > 9) { + QA::WriteQALog($fqa, "other", "shower", 20, QA::ERROR, "shower", "Configuration error", "There is a missmatch in the sampling pattern or thresholds configuration between Addon boards - ".$message); + } + elsif ($setAlert == 3 && $alertCtr > 2) { + QA::WriteQALog($fqa, "other", "shower", 20, QA::WARN, "shower", "Current problem", "There is a problem with currents one module."); + } + + sleep 1; +} diff --git a/hmon/hmon_spill.pl b/hmon/hmon_spill.pl new file mode 100755 index 0000000..1e4823f --- /dev/null +++ b/hmon/hmon_spill.pl @@ -0,0 +1,130 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; +use HPlot; + +my $lastspill = 1; +my $evtrate = 0; +my $events = 0; +my $spilllength = 0; +my $lastres = 0; +my $outofspill = 0; +my @spills; +my $spillavgshort = 0; +my $spillavglong = 0; +my $errtime = 0; + + +my $plot = (); +$plot->{name} = "EvtsPerSpill"; +$plot->{file} = "files/EvtsPerSpill"; +$plot->{entries} = 40; +$plot->{type} = HPlot::TYPE_HISTORY; +$plot->{output} = HPlot::OUT_PNG; +$plot->{titles}->[0] = ""; +$plot->{xlabel} = "Spill Number"; +$plot->{ylabel} = "Recorded Events / Spill (1000)"; +$plot->{sizex} = 630; +$plot->{sizey} = 220; +$plot->{nokey} = 1; +HPlot::PlotInit($plot); +my $str = Hmon::MakeTitle(8,5,"Recorded Events per Spill (1000)",0); + $str .= qq@@; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("EvtsPerSpill",$str); + +my $fqa = QA::OpenQAFile() or die "No connection to QA Logfile"; + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $trbneterr = 0; + my $rh_result = trb_register_read(QA::CTSAddress, 0xa002) or $trbneterr = 1; #sleep 5 and next; + my $stopped = trb_register_read(0x3,0xa0c0) or sleep 5 and next; + $stopped = ($stopped->{3} || 0) & 0x400; + + $lastspill = $outofspill; + $outofspill = ($rh_result->{QA::CTSAddress} || 0) & 0x10; + $spilllength++ ; #if($outofspill); + $rh_result = trb_register_read(0x3000, 0x01) or $trbneterr = 1; #sleep 5 and next; + # 0x3000 => a reliable guy to ask about rates + + if($trbneterr == 0) { + my $res = $rh_result->{0x3000} & 0xffff; + $evtrate = $res >= $lastres ? $res - $lastres : ($res + 2**16) - $lastres; + $events += $evtrate; + + # When end of spill is detected... + my $qastate; + my $qashort; + my $qalong; + + + + if ($outofspill && !$lastspill) { + push(@spills, $events); + shift(@spills) if scalar @spills > 50; + + $spillavglong = 0; + $spillavglong += $_ for @spills; + $spillavglong /= scalar @spills; + + $spillavgshort = 0; + for ( my $i=-1; $i>=-10; $i--) { + $spillavgshort += $spills[$i] || 0; + } + $spillavgshort /= (scalar @spills < 10)?(scalar @spills):10; + + $qashort = QA::SciNotation($events)." (".$spilllength."s)"; + $qastate = QA::GetQAState('above', "$events", @QA::LimitTriggerPerSpill); + $qalong = sprintf("current spill: %s - 10-spill avg. %s - 50-spill avg. %s - Spill length %is", + QA::SciNotation($events), + QA::SciNotation($spillavgshort), + QA::SciNotation($spillavglong), + $spilllength); + QA::WriteQALog($fqa,"trg", "spill", 30, $qastate, "Spill Sum", + $qashort, $qalong); + HPlot::PlotAdd("EvtsPerSpill",$events/1E3); + HPlot::PlotDraw("EvtsPerSpill"); + $events = 0; + $spilllength = 0; + } elsif ($spilllength > 20) { + QA::WriteQALog($fqa, "trg", "spill", 30, QA::NOTE, "Spill Sum", + "No Spills", "No Spills detected at the moment"); + } + + $qashort = sprintf(" %i ", $evtrate); + $qastate = QA::OK; + + ################Remove after comics or adjust! + if (($evtrate <= 200 || $evtrate >= 50000) && $errtime<20){ + $errtime++; + } + elsif ($errtime > 1) { + $errtime--; + } + $qastate = QA::WARN if $errtime > 10; + ##################### + + $qastate = QA::ERROR if $evtrate <= 1 && $stopped == 0; + $qastate = QA::WARN_2 if $stopped; + + $qalong = sprintf("current: %i Events/second", $evtrate); + QA::WriteQALog($fqa, "main", "rate", 5, $qastate, "Current Rate", + $qashort, $qalong); + + $lastres = $res; + sleep(1); + } else { + QA::WriteQALog($fqa, "main", "rate", 30, QA::ERROR, "Current Rate", "N/A", "N/A"); + QA::WriteQALog($fqa,"trg", "spill", 30, QA::ERROR, "Spill Sum","N/A", "N/A"); + $events = 0; + $spilllength = 0; + sleep(10); + } +} diff --git a/hmon/hmon_ssh b/hmon/hmon_ssh new file mode 100755 index 0000000..56a097b Binary files /dev/null and b/hmon/hmon_ssh differ diff --git a/hmon/hmon_starthist.pl b/hmon/hmon_starthist.pl new file mode 100755 index 0000000..2c4fea7 --- /dev/null +++ b/hmon/hmon_starthist.pl @@ -0,0 +1,107 @@ +#!/usr/bin/perl -w + +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die("could not connect to trbnetd"); + + +my $str; + +my $plots = fork(); + + +if($plots) { + my $i = 0; + while(1) { + my $binning = trb_register_read(3,0xa0c8) or sleep 5 and next; + my $offset = trb_register_read(3,0xa0c6) or sleep 5 and next; + my $select = trb_register_read(3,0xa0da) or sleep 5 and next; + +# print $binning->{3}."\n"; + $binning = $binning->{3}*100E-9; +# print $binning."\n"; + $binning = QA::SciNotation($binning); +# print $binning."\n"; + $offset = QA::SciNotation($offset->{3}*100E-9); + my $selx = "err"; + my $sely = "err"; + $selx = "X 0-7" if ($select->{3} & 0x3) == 0; + $selx = "X 4-11" if ($select->{3} & 0x3) == 1; + $selx = "X 8-15" if ($select->{3} & 0x3) == 2; + $sely = "Y 0-7" if ($select->{3} & 0xC) == 0; + $sely = "Y 4-11" if ($select->{3} & 0xC) == 4; + $sely = "Y 8-15" if ($select->{3} & 0xC) == 8; + + + + $str = Hmon::MakeTitle(10,16,"Start Histogram",0); + $str .= qq@ + Offset: @.$offset.qq@s - Binning: @.$binning.qq@s - Inputs: $selx, $sely +
+ + @; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("Starthist",$str); + + $str = Hmon::MakeTitle(10,16,"Start Histogram",0); + $str .= qq@ + Offset: @.$offset.qq@s - Binning: @.$binning.qq@s - Inputs: $selx, $sely +
+ + @; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("StarthistStacked",$str); + + sleep(5); + } + } +else { + qx(./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 42216 -m 500 -p 0 -w 32 -t "X 1" \\ + -a 0x0003 -r 42716 -m 500 -p 0 -w 32 -t "X 2" \\ + -a 0x0003 -r 43216 -m 500 -p 0 -w 32 -t "X 3" \\ + -a 0x0003 -r 43716 -m 500 -p 0 -w 32 -t "X 4" \\ + -a 0x0003 -r 44216 -m 500 -p 0 -w 32 -t "X 5" \\ + -a 0x0003 -r 44716 -m 500 -p 0 -w 32 -t "X 6" \\ + -a 0x0003 -r 45216 -m 500 -p 0 -w 32 -t "X 7" \\ + -a 0x0003 -r 45716 -m 500 -p 0 -w 32 -t "X 8" \\ + -output "PNG.files/starthistx0.760.365" -curvestyle steps -key genreg 2>/dev/null & + +./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 46216 -m 500 -p 0 -w 32 -t "Y 1" \\ + -a 0x0003 -r 46716 -m 500 -p 0 -w 32 -t "Y 2" \\ + -a 0x0003 -r 47216 -m 500 -p 0 -w 32 -t "Y 3" \\ + -a 0x0003 -r 47716 -m 500 -p 0 -w 32 -t "Y 4" \\ + -a 0x0003 -r 48216 -m 500 -p 0 -w 32 -t "Y 5" \\ + -a 0x0003 -r 48716 -m 500 -p 0 -w 32 -t "Y 6" \\ + -a 0x0003 -r 49216 -m 500 -p 0 -w 32 -t "Y 7" \\ + -a 0x0003 -r 49716 -m 500 -p 0 -w 32 -t "Y 8" \\ +-output "PNG.files/starthisty0.760.365" -curvestyle steps -key genreg 2>/dev/null & + +./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 42216 -m 500 -p 0 -w 32 -t "X 1" \\ + -a 0x0003 -r 42716 -m 500 -p 0 -w 32 -t "X 2" \\ + -a 0x0003 -r 43216 -m 500 -p 0 -w 32 -t "X 3" \\ + -a 0x0003 -r 43716 -m 500 -p 0 -w 32 -t "X 4" \\ + -a 0x0003 -r 44216 -m 500 -p 0 -w 32 -t "X 5" \\ + -a 0x0003 -r 44716 -m 500 -p 0 -w 32 -t "X 6" \\ + -a 0x0003 -r 45216 -m 500 -p 0 -w 32 -t "X 7" \\ + -a 0x0003 -r 45716 -m 500 -p 0 -w 32 -t "X 8" \\ + -output "PNG.files/starthiststackedx0.760.365" -curvestyle histostacked -key genreg 2>/dev/null & + +./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 46216 -m 500 -p 0 -w 32 -t "Y 1" \\ + -a 0x0003 -r 46716 -m 500 -p 0 -w 32 -t "Y 2" \\ + -a 0x0003 -r 47216 -m 500 -p 0 -w 32 -t "Y 3" \\ + -a 0x0003 -r 47716 -m 500 -p 0 -w 32 -t "Y 4" \\ + -a 0x0003 -r 48216 -m 500 -p 0 -w 32 -t "Y 5" \\ + -a 0x0003 -r 48716 -m 500 -p 0 -w 32 -t "Y 6" \\ + -a 0x0003 -r 49216 -m 500 -p 0 -w 32 -t "Y 7" \\ + -a 0x0003 -r 49716 -m 500 -p 0 -w 32 -t "Y 8" \\ +-output "PNG.files/starthiststackedy0.760.365" -curvestyle histostacked -key genreg 2>/dev/null & + + ); + } + diff --git a/hmon/hmon_startmon.pl b/hmon/hmon_startmon.pl new file mode 100755 index 0000000..23d9318 --- /dev/null +++ b/hmon/hmon_startmon.pl @@ -0,0 +1,496 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Hmon; +use HADES::TrbNet; +use Getopt::Long; +use Data::Dumper; + + +#- the command line option flags +my $opt_help = 0; +my $opt_etrax = "etraxp058"; +my $opt_addr = 3; #CTS +my $opt_verb = 0; +my $opt_type = "dec"; +my $opt_fpga = 0; + +GetOptions ('h|help' => \$opt_help, + 'e|etrax=s' => \$opt_etrax, + 'v|verb' => \$opt_verb, + 't|type=s' => \$opt_type, + 'a|addr=s' => \$opt_addr, + 'f|fpga' => \$opt_fpga); + +if( $opt_help ) { + &help(); + exit(0); +} + + +trb_init_ports() or die trb_strerror(); + +#- List of registers to read +my %reg_list = ( + 'start_x_h_ch01' => { 'text' => 'Start x Ch1', 'memaddr' => 0*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_g_ch02' => { 'text' => 'Start x Ch2', 'memaddr' => 1*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_f_ch03' => { 'text' => 'Start x Ch3', 'memaddr' => 2*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_e_ch04' => { 'text' => 'Start x Ch4', 'memaddr' => 3*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_d_ch05' => { 'text' => 'Start x Ch5', 'memaddr' => 4*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_c_ch06' => { 'text' => 'Start x Ch6', 'memaddr' => 5*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_b_ch07' => { 'text' => 'Start x Ch7', 'memaddr' => 6*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_a_ch08' => { 'text' => 'Start x Ch8', 'memaddr' => 7*500, 'range' => 500, 'hstart' => 1, 'print' => -6 }, + 'start_x_total' => { 'text' => 'Start x Sum', 'memaddr' => 0*500, 'range' => 8*500, 'print' => -5 }, + 'start_y_h_ch01' => { 'text' => 'Start y Ch1', 'memaddr' => 8*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_g_ch02' => { 'text' => 'Start y Ch2', 'memaddr' => 9*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_f_ch03' => { 'text' => 'Start y Ch3', 'memaddr' => 10*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_e_ch04' => { 'text' => 'Start y Ch4', 'memaddr' => 11*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_d_ch05' => { 'text' => 'Start y Ch5', 'memaddr' => 12*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_c_ch06' => { 'text' => 'Start y Ch6', 'memaddr' => 13*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_b_ch07' => { 'text' => 'Start y Ch7', 'memaddr' => 14*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_a_ch08' => { 'text' => 'Start y Ch8', 'memaddr' => 15*500, 'range' => 500, 'hstart' => 1, 'print' => -4 }, + 'start_y_total' => { 'text' => 'Start y Sum', 'memaddr' => 8*500, 'range' => 8*500, 'print' => -3 }, + 'veto_ch1' => { 'text' => 'Veto Ch1', 'memaddr' => 16*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch2' => { 'text' => 'Veto Ch2', 'memaddr' => 17*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch3' => { 'text' => 'Veto Ch3', 'memaddr' => 18*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch4' => { 'text' => 'Veto Ch4', 'memaddr' => 19*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch5' => { 'text' => 'Veto Ch5', 'memaddr' => 20*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch6' => { 'text' => 'Veto Ch6', 'memaddr' => 21*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch7' => { 'text' => 'Veto Ch7', 'memaddr' => 22*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_ch8' => { 'text' => 'Veto Ch8', 'memaddr' => 23*500, 'range' => 500, , 'hveto' => 1, 'print' => -2 }, + 'veto_total' => { 'text' => 'Veto Sum', 'memaddr' => 16*500, 'range' => 8*500, 'print' => -1 }, + # Scaler Delay (PT1, PT2, PT3) + 'SD_PT1' => { 'addr' => 0xa024, 'print' => 3 }, + 'SD_PT2' => { 'addr' => 0xa025, 'print' => 3 }, + 'SD_PT3' => { 'addr' => 0xa026, 'print' => 3 }, + # Scaler C (PT1, PT2, PT3) + 'SC_PT1' => { 'addr' => 0xa05b, 'print' => 4 }, + 'SC_PT2' => { 'addr' => 0xa05c, 'print' => 4 }, + 'SC_PT3' => { 'addr' => 0xa05d, 'print' => 4 }, + # Scaler Out (PT1, PT2, PT3) + 'SO_PT1' => { 'addr' => 0xa04a, 'print' => 5 }, + 'SO_PT2' => { 'addr' => 0xa04b, 'print' => 5 }, + 'SO_PT3' => { 'addr' => 0xa04c, 'print' => 5 }, + # Scalers + 'Start_1' => { 'addr' => 0xa008, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_2' => { 'addr' => 0xa009, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_3' => { 'addr' => 0xa00a, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_4' => { 'addr' => 0xa00b, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_5' => { 'addr' => 0xa00c, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_6' => { 'addr' => 0xa00d, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_7' => { 'addr' => 0xa00e, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Start_8' => { 'addr' => 0xa00f, 'start' => 1, 'total' => 1, 'print' => 6 }, + 'Veto_1' => { 'addr' => 0xa010, 'veto' => 1, 'total' => 1 }, + 'Veto_2' => { 'addr' => 0xa011, 'veto' => 1, 'total' => 1 }, + 'Veto_3' => { 'addr' => 0xa012, 'veto' => 1, 'total' => 1 }, + 'Veto_4' => { 'addr' => 0xa013, 'veto' => 1, 'total' => 1 }, + 'Veto_5' => { 'addr' => 0xa014, 'veto' => 1, 'total' => 1 }, + 'Veto_6' => { 'addr' => 0xa015, 'veto' => 1, 'total' => 1 }, + 'Veto_7' => { 'addr' => 0xa016, 'veto' => 1, 'total' => 1 }, + 'Veto_8' => { 'addr' => 0xa017, 'veto' => 1, 'total' => 1 }, + + # placeholders + 'Total' => { 'value' => 0, 'print' => 8 }, + 'Total_Start' => { 'value' => 0, 'print' => 8 }, + 'Total_Veto' => { 'value' => 0, 'print' => 8 }, + 'PT1/Total_Start' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT1', 'ratio2' => 'Total_Start'}, + 'PT1/Total_Veto' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT1', 'ratio2' => 'Total_Veto'}, + 'PT2/Total_Start' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT2', 'ratio2' => 'Total_Start'}, + 'PT2/Total_Veto' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT2', 'ratio2' => 'Total_Veto'}, + 'PT3/Total_Start' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT3', 'ratio2' => 'Total_Start'}, + 'PT3/Total_Veto' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'SD_PT3', 'ratio2' => 'Total_Veto'}, + 'Total_Start/Total_Veto' => { 'value' => 0, 'print' => 9 , 'ratio1' => 'Total_Start', 'ratio2' => 'Total_Veto'} + ); + + +#thershold in +- percentage +my $yellow_threshold = 0.20; +my $red_threshold = 0.40; + + +my $reg_href = \%reg_list; +my $nrOfchannels = scalar keys %reg_list; +my @histograms; + +#$reg_href->{'ch1'}->{'value'} = 1; + +my $flog = Hmon::OpenLogfile(); +my $last_spill_on = 0; + +while (1) { + my @result; + + foreach my $rh_address (keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'addr'}) { + +# print "going to read register " . $reg_href->{$rh_address}->{'addr'} . " at " . $opt_addr . "\n"; + @result = trb_register_read_c($opt_addr, $reg_href->{$rh_address}->{'addr'} ) or sleep 5 and next; +# print $result[1] . "\n"; + $reg_href->{$rh_address}->{'value'} = $result[1]; + } + } + + foreach my $rh_address (keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'value'}) { + if (!defined $reg_href->{$rh_address}->{'memaddr'} && + !defined $reg_href->{$rh_address}->{'ratio1'}) { + $reg_href->{$rh_address}->{'spill_value'} += $reg_href->{$rh_address}->{'value'}; + } else { + $reg_href->{$rh_address}->{'spill_value'} = $reg_href->{$rh_address}->{'value'}; + } + } + } + + @result = trb_register_read_c($opt_addr, 0xa002 ); + my $spill_on = 0; + if (defined $result[1]) { + $spill_on = !(($result[1] & 0x10) >> 4); + } + my $end_spill = 0; + if ($last_spill_on == 1 && $spill_on == 0) { + #end of spill, simple edge logic + $end_spill = 1; + foreach my $rh_address (keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'last_spill_value'}) { + $reg_href->{$rh_address}->{'lastlast_spill_value'} = $reg_href->{$rh_address}->{'last_spill_value'}; + } + if (defined $reg_href->{$rh_address}->{'spill_value'}) { + $reg_href->{$rh_address}->{'last_spill_value'} = $reg_href->{$rh_address}->{'spill_value'}; + $reg_href->{$rh_address}->{'spill_value'} = 0; + } + } + } + + + $last_spill_on = $spill_on; + + #read histograms + undef @histograms; + @histograms = trb_register_read_mem_c($opt_addr, 0xa100 + 2*500, 0, 24*500); + #print Dumper @histograms; + &convertHistograms(); + + my $str = ""; + $reg_href->{'Total'}->{'value'} = getSumTotal(); + $reg_href->{'Total_Start'}->{'value'} = getSumTotalStart(); + $reg_href->{'Total_Veto'}->{'value'} = getSumTotalVeto(); + + $str = Hmon::MakeTitle(14, 14, "Start Monitor", 1, ""); + $str .= "\n"; #outer frame + $str .= "\n"; + + #Jureks Veto "GUI" -> no dynamic content possible + $str .= "\n"; + + if ($spill_on == 0) { + $str .= ""; + } + + $str .= "
Summary from histogramsScalersVeto
"; + $str .= "\n"; + $str .= "\n"; + + + foreach my $m (-6..-1) { + my $maximum = 0; + + foreach my $rh_address (sort keys %$reg_href) { + if ((defined $reg_href->{$rh_address}->{'print'}) && ($reg_href->{$rh_address}->{'print'} == $m) ) { + ####$reg_href->{$rh_address}->{'last_spill_value'} = 1; + if (defined $reg_href->{$rh_address}->{'last_spill_value'} && $reg_href->{$rh_address}->{'last_spill_value'}>$maximum) { + $maximum = $reg_href->{$rh_address}->{'last_spill_value'}; + } + } + } + + if (!defined $maximum) {$maximum=0.00001;} + + foreach my $rh_address (sort keys %$reg_href) { + if ((defined $reg_href->{$rh_address}->{'print'}) && ($reg_href->{$rh_address}->{'print'} == $m) ) { + if (defined $reg_href->{$rh_address}->{'text'}) { + $str .= "\n"; + } + } + $str .= "\n"; + } + $str .= "
Last spillL.b.o. spill
" . $reg_href->{$rh_address}->{'text'} . " "; + } else { + $str .= "
" . $rh_address . " "; + } + + + if (defined $reg_href->{$rh_address}->{'last_spill_value'}) { + $str .= convertNumber($reg_href->{$rh_address}->{'last_spill_value'}); + if ($maximum > 0) { + $str .= "
"; + } else { + $str .= "
"; + } + } else {$str .= "---";} + if (defined $reg_href->{$rh_address}->{'lastlast_spill_value'} && defined $reg_href->{$rh_address}->{'last_spill_value'}) { + if ($reg_href->{$rh_address}->{'last_spill_value'} > 0) { + if (($reg_href->{$rh_address}->{'lastlast_spill_value'} / $reg_href->{$rh_address}->{'last_spill_value'}) > (1.0 + $red_threshold) || + ($reg_href->{$rh_address}->{'lastlast_spill_value'} / $reg_href->{$rh_address}->{'last_spill_value'}) < (1.0 - $red_threshold)) { + $str .= "
"; + } elsif (($reg_href->{$rh_address}->{'lastlast_spill_value'} / $reg_href->{$rh_address}->{'last_spill_value'}) > (1.0 + $yellow_threshold) || + ($reg_href->{$rh_address}->{'lastlast_spill_value'} / $reg_href->{$rh_address}->{'last_spill_value'}) < (1.0 - $yellow_threshold)) { + $str .= " "; + } else {$str .= " ";} + $str .= convertNumber($reg_href->{$rh_address}->{'lastlast_spill_value'}); + } else {$str .= " 0";} + } else {$str .= " ---";} + + +# if (defined $reg_href->{$rh_address}->{'value'}) { +# $str .= $reg_href->{$rh_address}->{'value'}; +# } +# if (defined $reg_href->{$rh_address}->{'last_spill_value'} && defined $reg_href->{$rh_address}->{'value'} && $reg_href->{$rh_address}->{'value'} > 0) { +# if (($reg_href->{$rh_address}->{'last_spill_value'} / $reg_href->{$rh_address}->{'value'}) > (1.0 + $red_threshold) || +# ($reg_href->{$rh_address}->{'last_spill_value'} / $reg_href->{$rh_address}->{'value'}) < (1.0 - $red_threshold)) { +# $str .= " "; +# } elsif (($reg_href->{$rh_address}->{'last_spill_value'} / $reg_href->{$rh_address}->{'value'}) > (1.0 + $yellow_threshold) || +# ($reg_href->{$rh_address}->{'last_spill_value'} / $reg_href->{$rh_address}->{'value'}) < (1.0 - $yellow_threshold)) { +# $str .= " "; +# } else {$str .= " ";} +# $str .= $reg_href->{$rh_address}->{'last_spill_value'}; +# } else {$str .= " ";} + + $str .= "
\n"; + $str .= "
\n"; + + ###recalc ratios + foreach my $rh_address (sort keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'ratio1'}) { + if ((defined $reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'value'}) + && ($reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'value'}>0)) { + $reg_href->{$rh_address}->{'value'} = sprintf ("%.4f", + $reg_href->{$reg_href->{$rh_address}->{'ratio1'}}->{'value'} / + $reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'value'}); + } else { + $reg_href->{$rh_address}->{'value'} = "---"; + } + if ((defined $reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'spill_value'}) + && ($reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'spill_value'}>0)) { + $reg_href->{$rh_address}->{'spill_value'} = sprintf ("%.4f", + $reg_href->{$reg_href->{$rh_address}->{'ratio1'}}->{'spill_value'} / + $reg_href->{$reg_href->{$rh_address}->{'ratio2'}}->{'spill_value'}); + } else { + $reg_href->{$rh_address}->{'spill_value'} = "---"; + } + + } + } + + foreach my $m (1..9) { + foreach my $rh_address (sort keys %$reg_href) { + if ((defined $reg_href->{$rh_address}->{'print'}) && ($reg_href->{$rh_address}->{'print'} == $m) ) { + + + $str .= "\n"; + } + } + $str .= "\n"; + } + + $str .= "
Current valueCurrent spillLast spill
" . $rh_address . " "; + if (defined $reg_href->{$rh_address}->{'value'}) { + $str .= convertNumber($reg_href->{$rh_address}->{'value'}); + } + $str .= " "; + if (defined $reg_href->{$rh_address}->{'spill_value'}) { + $str .= convertNumber($reg_href->{$rh_address}->{'spill_value'}); + } + $str .= " "; + if (defined $reg_href->{$rh_address}->{'last_spill_value'}) { + $str .= convertNumber($reg_href->{$rh_address}->{'last_spill_value'}); + } + $str .= "
"; + $str .= "\n"; + $str .= ""; + ########## + $str .= "\n"; + $str .= ""; + ########## + $str .= "\n"; + ######################## + $str .= "\n"; + $str .= ""; + ######################## + $str .= "\n"; + $str .= ""; + ######################## + + + $str .= "
"; + if (defined $reg_href->{'Veto_5'}->{'value'}) { + $str .= $reg_href->{'Veto_5'}->{'value'} . "
ch5
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_5'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + } + $str .= "
\n"; + $str .= " \n"; + if (defined $reg_href->{'Veto_6'}->{'value'}) { + $str .= $reg_href->{'Veto_6'}->{'value'} . "
ch6
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_6'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + } + $str .= "
"; + $str .= " \n"; + if (defined $reg_href->{'Veto_1'}->{'value'}) { + $str .= $reg_href->{'Veto_1'}->{'value'} . "
ch1
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_1'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + } + $str .= "
\n"; + $str .= "
\n"; + if (defined $reg_href->{'Veto_4'}->{'value'}) { + $str .= $reg_href->{'Veto_4'}->{'value'} . "
ch4
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_4'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + + } + $str .= "
\n"; + if (defined $reg_href->{'Veto_2'}->{'value'}) { + $str .= $reg_href->{'Veto_2'}->{'value'} . "
ch2
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_2'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + + } + $str .= "
"; + $str .= " \n"; + if (defined $reg_href->{'Veto_3'}->{'value'}) { + $str .= $reg_href->{'Veto_3'}->{'value'} . "
ch3
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_3'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + + } + $str .= "
\n"; + $str .= "
"; + if (defined $reg_href->{'Veto_8'}->{'value'}) { + $str .= $reg_href->{'Veto_8'}->{'value'} . "
ch8
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_8'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + + } + $str .= "
\n"; + $str .= " \n"; + if (defined $reg_href->{'Veto_7'}->{'value'}) { + $str .= $reg_href->{'Veto_7'}->{'value'} . "
ch7
"; + if (defined $reg_href->{'Total_Veto'}->{'value'} && $reg_href->{'Total_Veto'}->{'value'}>0) { + $str .= sprintf("%.0f",100*$reg_href->{'Veto_7'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'}) . "%"; + $str .= "
{'value'}/$reg_href->{'Total_Veto'}->{'value'} . + "px;height:8px;background-color:red;'>
"; + } else {$str .= "---";} + + } + $str .= "
"; + + #end GUI + + $str .= "
Spill Off
\n"; + + $str .= Hmon::MakeFooter(); + + Hmon::WriteFile("StartMon", $str); + + + sleep 1; +} + +sub help() +{ + print "\n"; + print << 'EOF'; +command_display.pl + +Usage: + + Command line: command_client.pl + [-h|--help] : Show this help. + [-e|--etrax ] : Etrax board name. + [-t|--type ] : Print values of registers in dec(%) or absolute (default: dec). + [-f|--fpga] : Program FPGA before reading registers. + [-a|--addr
] : Address of the board (default: 0x0099). + [-v|--verb] : More verbouse. + +EOF +} + +sub convertHistograms + { + foreach my $rh_memaddr (sort keys %$reg_href) { + if (defined $reg_href->{$rh_memaddr}->{'memaddr'}) { + $reg_href->{$rh_memaddr}->{'value'} = 0; + for (my $i=$reg_href->{$rh_memaddr}->{'memaddr'}+1; $i<=( $reg_href->{$rh_memaddr}->{'range'} + + $reg_href->{$rh_memaddr}->{'memaddr'}); $i++) { + #print $i . " " . $histograms[$i] . "\n"; + if (defined $histograms[$i]) { + $reg_href->{$rh_memaddr}->{'value'} += $histograms[$i]; + } + } + #if ($rh_memaddr eq "start_y_total") {print $rh_memaddr . ":" . $reg_href->{$rh_memaddr}->{'value'} . "\n";} + } + } + } + +sub convertNumber { + my $text = $_[0]; + $text =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; + return $text; +} + +sub getSumTotal + { + my $sum_total = 0; + foreach my $rh_address (sort keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'total'} && defined $reg_href->{$rh_address}->{'value'}) { + $sum_total += $reg_href->{$rh_address}->{'value'}; + } + } + return $sum_total; + } + +sub getSumTotalStart + { + my $sum_total = 0; + foreach my $rh_address (sort keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'start'} && defined $reg_href->{$rh_address}->{'value'}) { + $sum_total += $reg_href->{$rh_address}->{'value'}; + } + } + return $sum_total; + } + +sub getSumTotalVeto + { + my $sum_total = 0; + foreach my $rh_address (sort keys %$reg_href) { + if (defined $reg_href->{$rh_address}->{'veto'} && defined $reg_href->{$rh_address}->{'value'}) { + $sum_total += $reg_href->{$rh_address}->{'value'}; + } + } + return $sum_total; + } diff --git a/hmon/hmon_tail b/hmon/hmon_tail new file mode 100755 index 0000000..a561bcd Binary files /dev/null and b/hmon/hmon_tail differ diff --git a/hmon/hmon_timeout.pl b/hmon/hmon_timeout.pl new file mode 100755 index 0000000..fc0878d --- /dev/null +++ b/hmon/hmon_timeout.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die trb_strerror(); +Hmon::TraceDBLoad(); + +my $fqa = QA::OpenQAFile(); +my $logcnt = 0; + +while (1) { + my $msg = ""; + my $msg2 = ""; + my $cnt = 0; + my $cnt2 = 0; + my $boardlist1 = ""; + my $boardlist2 = ""; + + my $rh_hubs = trb_register_read(0xfffe, 0x8b) + or sleep 5 and next; + + foreach my $board (sort {$a <=> $b} keys %$rh_hubs) { + if (($rh_hubs->{$board} & 0xffff) != 0x0000) { + $msg .= ", " if $msg ne ""; + $msg .= sprintf("%04x-%04x (",$board,$rh_hubs->{$board} & 0xffff); + foreach my $i (1..8) { + if ($rh_hubs->{$board} & (1<<$i)) { + $msg .= sprintf("0x%04x ",Hmon::TraceDBGet($board,$i)); + $boardlist1 .= sprintf("%04X, ",Hmon::TraceDBGet($board,$i)); + } + } + $msg .= ")"; + $cnt++; + } + if ((($rh_hubs->{$board}>>16) & 0xffff) != 0x0000 && $board > 0x1000 && $board < 0x1200 && $board%16) { + $msg2 .= ", " if $msg2 ne ""; + $msg2 .= sprintf("%04x-%04x (",$board,$rh_hubs->{$board}>>16 & 0xffff); + foreach my $i (1..8) { + if ($rh_hubs->{$board} & (1<<($i+16))) { + $msg2 .= sprintf(" %04x",Hmon::TraceDBGet($board,$i)); + $boardlist2 .= sprintf("%04X, ",Hmon::TraceDBGet($board,$i)); + } + } + $msg2 .= " )"; + $cnt2++; + } + } + + $boardlist1 =~ s/(\w)(\w)/$1 $2 /gi; + $boardlist2 =~ s/(\w)(\w)/$1 $2 /gi; + + + $msg =~ s/\s+\)/\)/; $msg =~ s/\(\s+/\(/; + $msg2 =~ s/\s+\)/\)/; $msg2 =~ s/\(\s+/\(/; + my $status = "on ".($cnt+$cnt2)." boards"; + my $qastate = QA::GetQAState('below', $cnt+$cnt2, @QA::TimeoutLimits); + if($boardlist1 ne "") { + Hmon::Speak($boardlist1,"$cnt Frontend had a timeout: $boardlist1 "); + } + if($boardlist2 ne "" && $boardlist1 eq "" ) { + Hmon::Speak("timeout","$cnt2 Frontend disabled after a timeout: $boardlist2"); + } + + QA::WriteQALog($fqa, "daq", "timeouts", 20, $qastate, "Timeouts", + $status, "Timeouts " . $status ." - Timeouts: $cnt. $msg - Ports off due to earlier timeouts: $cnt2. $msg2"); + system("logger -p local1.info -t DAQ 'Hmon Timeouts found: $msg'") + if $msg ne "" && $logcnt++ < 50; + + sleep 3; +} diff --git a/hmon/hmon_trbtdc.pl b/hmon/hmon_trbtdc.pl new file mode 100755 index 0000000..ece8425 --- /dev/null +++ b/hmon/hmon_trbtdc.pl @@ -0,0 +1,68 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die trb_strerror(); + +my $fqa = QA::OpenQAFile(); +my $logcnt = 0; +my $timecnt = 0; + +while (1) { + my $rpc = trb_register_read(0xffdf,0xa001) or sleep 5 and next; + my $tof = trb_register_read(0xffef,0xa001) or sleep 5 and next; + my $errcnt = 0; + my $errcnt2 = 0; + my $title = "TRB TDC"; + my $longmsg = ""; + my $longmsg2 = ""; + my $msg = ""; + my $qastate = QA::OK; + + + foreach my $b (sort keys %$rpc) { + my $t = ($rpc->{$b} >> 8) & 0xF; + if($t) { + $errcnt++; + $longmsg .= sprintf("%04x, ",$b); + } + $t = ($rpc->{$b} >> 4) & 0xF; + if($t) { + $errcnt2++; + $longmsg2 .= sprintf("%04x, ",$b); + } + } + + foreach my $b (sort keys %$tof) { + my $t = ($tof->{$b} >> 8) & 0xF; + if($t) { + $errcnt++; + $longmsg .= sprintf("%04x, ",$b); + } + } + + my $errors = $errcnt + $errcnt2; + + $longmsg = "none" unless $errcnt; + $longmsg2 = "none " unless $errcnt2; + $longmsg = "TDC out of sync on TRBs: ".$longmsg." - Reference time missing on TRBs: ".$longmsg2; + chop $longmsg;chop $longmsg; + + + $msg = "$errors errors" if $errors; + $qastate = QA::ERROR if $errors; + QA::WriteQALog($fqa, "feeerr", "trb", 10, $qastate, $title, $msg, $longmsg); + + + if ($qastate > 60 && $timecnt++%40==0) { + system("logger -p local1.info -t DAQ 'Hmon TRB TDC $longmsg'"); + } + + + + sleep 3; +} diff --git a/hmon/hmon_trgerr.pl b/hmon/hmon_trgerr.pl new file mode 100755 index 0000000..0b65f39 --- /dev/null +++ b/hmon/hmon_trgerr.pl @@ -0,0 +1,119 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; + +my %laststore2; +my $allboards; +my $fqa = QA::OpenQAFile(); + +trb_init_ports() or die trb_strerror(); + +while (1) { + my $rh_trigErr = trb_register_read(0xffff, 0x06) or sleep 5 and next; + my $rh_trigErr2 = trb_register_read(0xffff, 0x07) or sleep 5 and next; + + my %store; + my %store2; + my $boards = {}; + my $boardstring = ""; + foreach my $board (sort {$a <=> $b} keys %$rh_trigErr) { + my $id = ($board >> 8) & 0xff; + my $id_0 = ($board >> 12) & 0x0f; + my $id_1 = ($board >> 8) & 0x0f; + my $id_2 = ($board >> 4) & 0x0f; + my $id_3 = ($board >> 0) & 0x0f; + my $val = ((($rh_trigErr->{$board} >> 16) & 0xffff) + + ($rh_trigErr->{$board} & 0xffff)); + if ($id_0 == 0x2) { + $store{$id_1}->{$id_2}->{$id_3} += $val; + } + $boards->{$board} = $val; + $allboards->{$board} = $val; + $store2{$id} += $val; + } + + foreach my $board (sort {$a <=> $b} keys %$rh_trigErr2) { + my $id = ($board >> 8) & 0xff; + my $id_0 = ($board >> 12) & 0x0f; + my $id_1 = ($board >> 8) & 0x0f; + my $id_2 = ($board >> 4) & 0x0f; + my $id_3 = ($board >> 0) & 0x0f; + my $val = ((($rh_trigErr2->{$board} >> 16) & 0xffff) + + ($rh_trigErr2->{$board} & 0xffff)); + if ($id_0 == 0x2) { + $store{$id_1}->{$id_2}->{$id_3} += $val; + } +# $boards->{$board} += $val if $val && defined $laststore2{$id}; + $boards->{$board} += $val; + $allboards->{$board} += $val; + $store2{$id} += $val; + } + + #Clean-up by compare to former values + foreach my $b (keys %$boards) { + if(! defined $allboards->{$b} || ($boards->{$b} - $allboards->{$b}) == 0) { + $boards->{$b} = 0; + } + } + + my @str; + my %color; + my %raw; + my $max; + my $min; + + ($min, $max) = Hmon::MakeMinMax3(\%store, 4, 6, 16); + $str[0][4] = Hmon::MakeTitle(9,10,"MDC Trigger Errors "); + for (my $l = 0; $l < 4; $l++) { + $str[1][$l] = ""; + for (my $s = 0; $s < 6;$s++) { + for (my $b = 0; $b < 16; $b++) { + $color{$b} = sprintf("style=\"background:%4s;\"", + Hmon::findcolor($store{$l}->{$s}->{$b}, + $min, $max, 0)); + $raw{$b} = sprintf("%i", $store{$l}->{$s}->{$b}); + } + $str[1][$l] .= Hmon::DrawMDC($l, $s, \%color, \%raw); + } + $str[2][$l] = Hmon::DrawScale($min, $max, 40); + $str[2][$l] .= "\n"; + } + + my $sum = 0; + my $totalsum = 0; + if (%laststore2) { + foreach my $c (keys %store2) { + my $diff = $store2{$c} - ($laststore2{$c} || $store2{$c}); + while ($diff < 0) { + $diff += 2**16; + } + $sum += $diff; + $totalsum += $store2{$c}; + } + foreach my $c (sort keys %$boards) { + $boardstring .= sprintf("0x%04x, ",$c) if ($boards->{$c}); + } + chop $boardstring; chop $boardstring; + my $qastate = QA::GetQAState('below', $sum, @QA::TrgErrLimits); + my $qash = ""; + $qash = sprintf("%u Errors", $sum) if $sum; + my $qalg = sprintf("%u errors in last second - %u errors in total", + $sum, $totalsum); + QA::WriteQALog($fqa, "feeerr", "trgqual", 20, $qastate, + "Trigger", $qash, $qalg." - Boards: ".$boardstring); + } + + Hmon::WriteFile("MDCTriggerError", + $str[0][4]."

".$str[1][0].$str[1][1]."

". + $str[1][2]."

".$str[1][3].$str[2][0]); + + %laststore2 = %store2; + sleep 1; +} + + diff --git a/hmon/hmon_trgsource.pl b/hmon/hmon_trgsource.pl new file mode 100755 index 0000000..5cc8ccc --- /dev/null +++ b/hmon/hmon_trgsource.pl @@ -0,0 +1,264 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HADES::TrbNet; +use HPlot; + +trb_init_ports() or die trb_strerror(); + +my $fqa = QA::OpenQAFile(); +my $logcnt = 0; + +#0 a0c5 gating disable (9 + 8) +#2 a0c7 output enable (2 + 9 + 8) +#4,5,6 a0c9 - a0cb downscaling (2 + 9 + 8, 4bit each) +#30 a0e3 pulser + +#0 temp array for downscaling + +my @names= qw(S1 S2 S3 S4 S5 S6 S2N S3N S2O); +my @lnames= qw(SectorwiseMult1 SectorwiseMult2 SectorwiseMult3 +SectorwiseMult4 SectorwiseMult5 SectorwiseMult6 SectorwiseMult2NoNeighbour +SectorwiseMult3NoNeighbour SectorwiseMult2Opposite); + +my @ptnames= qw(M2 M5 M20 PT4 PT5 FW PT7 PT8); +my @ptlnames= qw(PT1/M2 PT2/M5 PT3/M20 PT4 PT5 PT6/ForwardWall PT7 PT8); + +my $lastlongmsg = ""; +my $spillsum = 0; +my $lastspillsum = 0; +my $outofspill = 0; +my $lastoutofspill = 1; +my $lastaccpt3; +my $pt3sum =0; +my $accpt3sum; +my $totalpt3; +my $totalstart; +my $totalpt3overstart; + +my $plot = (); +$plot->{name} = "StartCountSpills"; +$plot->{file} = "files/StartCountSpills"; +$plot->{entries} = 40; +$plot->{type} = HPlot::TYPE_HISTORY; +$plot->{output} = HPlot::OUT_PNG; +$plot->{titles}->[0] = ""; +$plot->{xlabel} = "Spill Number"; +$plot->{ylabel} = "Start Counts / Mcnt"; +$plot->{sizex} = 630; +$plot->{sizey} = 220; +$plot->{nokey} = 1; +HPlot::PlotInit($plot); +my $str = Hmon::MakeTitle(8,5,"Start Counts per Spill (millions)",0); + $str .= qq@@; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("StartCountSpill",$str); + + + +my $plot2 = (); +$plot2->{name} = "Pt3AcceptRatio"; +$plot2->{file} = "files/Pt3AcceptRatio"; +$plot2->{entries} = 40; +$plot2->{type} = HPlot::TYPE_HISTORY; +$plot2->{output} = HPlot::OUT_PNG; +$plot2->{titles}->[0] = ""; +$plot2->{xlabel} = "Spill Number"; +$plot2->{ylabel} = "accepted PT3 Ratio"; +$plot2->{sizex} = 630; +$plot2->{sizey} = 220; +$plot2->{nokey} = 1; +HPlot::PlotInit($plot2); + $str = Hmon::MakeTitle(8,5,"PT3 accepted over total PT3 per spill (%)",0); + $str .= qq@@; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("Pt3AcceptRatio",$str); + + +while (1) { + my $qastate = QA::OK; + my $rg = {}; + my $rh = trb_register_read_mem(0x3,0xa0c5, 0, 31) or sleep 5 and next; + my $rStat = trb_register_read_mem(0x3,0xa000, 0, 0x66) or sleep 5 and next; + my $stopped = trb_register_read(0x3,0xa0c0) or sleep 5 and next; + my $polarity = trb_register_read_mem(0x3,0xa002,0,2) or sleep 5 and next; + + $lastoutofspill = $outofspill; + $outofspill = ($rStat->{0x3}->[2] || 0) & 0x10; + + $rh->{3}->[0] <<= 2; #shift to align with outputs + $rh->{3}->[30] = 200000000/($rh->{3}->[30] || 1) if $rh->{3}->[30]; + +#Decode downscaling + for (my $i = 0; $i<8; $i++) { + $rg->{0}->[$i] = 2**((($rh->{3}->[4]||0) >> $i*4) & 0xF); + $rg->{0}->[$i+8] = 2**((($rh->{3}->[5]||0) >> $i*4) & 0xF); + $rg->{0}->[$i+16] = 2**((($rh->{3}->[6]||0) >> $i*4) & 0xF); + } + +#Pulser? + my $longmsg = "Active Trigger sources: "; + my $msg = ""; + my $accmsg = ""; + my $acclmsg = ""; + my $trgprov = 0; + my $trgacc = 0; + + if($rh->{3}->[30]) { + $qastate = QA::NOTE; + $msg .= sprintf("%sHz ",QA::SciNotation($rh->{3}->[30])); + $longmsg .= sprintf("Pulser %sHz - ",QA::SciNotation($rh->{3}->[30])); + } + +#scan multiplicity outputs + for(my $i=0;$i<9;$i++) { + if($rh->{3}->[2] & (1<<($i+2))) { + if($rg->{0}->[$i+2] != 1) { + $msg .= sprintf("%s/%i ",$names[$i],$rg->{0}->[$i+2] || 1); + $longmsg .= sprintf("%s (%s) / dsc %i - ",$names[$i],$lnames[$i],$rg->{0}->[$i+2] || 1); + } + else { + $msg .= sprintf("%s ",$names[$i]); + $longmsg .= sprintf("%s (%s) - ",$names[$i],$lnames[$i]); + } + $trgprov += $rStat->{3}->[$i+0+0x52]; + $trgacc += $rStat->{3}->[$i+2+19+0x2c]; + $acclmsg .= sprintf("%s %i/%i %.1f%% - ", + $lnames[$i], + $rStat->{3}->[$i+2+19+0x2c], + $rStat->{3}->[$i+0+0x52], + $rStat->{3}->[$i+2+19+0x2c]/($rStat->{3}->[$i+0+0x52]||1)*100); + } + } + +#scan PT outputs + for(my $i=0;$i<8;$i++) { + if($rh->{3}->[2] & (1<<($i+11))) { + if($rg->{0}->[$i+11] != 1) { + $msg .= sprintf("%s/%i%s ",$ptnames[$i],$rg->{0}->[$i+11] || 1,($rh->{3}->[0] & (1<<($i+11))?'':'C')); + $longmsg .= sprintf("%s / dsc %i %s - ",$ptlnames[$i],$rg->{0}->[$i+11] || 1,($rh->{3}->[0] & (1<<($i+11))?'':'with coincidence')); + } + else { + $msg .= sprintf("%s%s ",$ptnames[$i],($rh->{3}->[0] & (1<<($i+11))?'':'C')); + $longmsg .= sprintf("%s%s - ",$ptlnames[$i],($rh->{3}->[0] & (1<<($i+11))?'':'with coincidence')); + } + $trgprov += $rStat->{3}->[$i+9+0x52]; + $trgacc += $rStat->{3}->[$i+11+19+0x2c]; + $acclmsg .= sprintf("%s %i / %i %.1f%% - ", + $ptlnames[$i], + $rStat->{3}->[$i+11+19+0x2c], + $rStat->{3}->[$i+9+0x52], + $rStat->{3}->[$i+11+19+0x2c]/($rStat->{3}->[$i+9+0x52]||1)*100); + } + } + chop $longmsg foreach (0..2); + chop $msg; + chop $acclmsg foreach (0..2); + +my $longmsgcheck = $longmsg; + +#Input polarity wrong? + if($QA::TrgCheckPolarity && (($polarity->{3}->[1] & 0x7fffffff) || $polarity->{3}->[0] & 0x1e0)) { + $qastate = QA::WARN; + $longmsg .= " - Signal polarity wrong on inputs "; + foreach my $i(0..30) { + if($polarity->{3}->[1] & (1<<$i)) { + $longmsg .= "Start ".($i+1) if $i<8; + $longmsg .= "Veto ".($i-7) if $i<16 && $i>=8; + $longmsg .= "TOF ".($i-15) if $i<22 && $i>=16; + $longmsg .= "RPC ".($i-21) if $i<28 && $i>=22; + $longmsg .= "PT ".($i-27) if $i<32 && $i>=28; + $longmsg .= ", "; + } + } + foreach my $i(5..8) { + if($polarity->{3}->[0] & (1<<$i)) { + $longmsg .= "PT ".$i; + $longmsg .= ", "; + } + } + chop $longmsg foreach(0..1); + } + +#Trigger stopped by register? + if($stopped->{3} & 0x400) { + $msg = "Stopped"; + $qastate = QA::WARN_2; + $longmsg = "TriggerStat have been stopped - ". $longmsg; + } + + + if($outofspill && !$lastoutofspill ) { + $lastaccpt3 = $pt3sum / ($accpt3sum||1)*100; + HPlot::PlotAdd("Pt3AcceptRatio",$lastaccpt3); + HPlot::PlotDraw("Pt3AcceptRatio"); + $pt3sum = 0; + $accpt3sum = 0; + } + else { + $pt3sum += $rStat->{3}->[0x4c] || 0; + $accpt3sum += $rStat->{3}->[0x39] || 0; #was 0x5D + } + $accmsg = sprintf("%i%% / %i%%", $rStat->{3}->[0x4c]/($rStat->{3}->[0x39]||1)*100, $lastaccpt3 || 0); + my $qastateacc = QA::OK; + + QA::WriteQALog($fqa, "trg", "source", 10, $qastate, "Trigger Source", $msg, $longmsg); + QA::WriteQALog($fqa, "trg", "accepted", 10, $qastateacc, "Accept. PT3", $accmsg, $acclmsg); + + my $qastatept = QA::OK; + my $ptoverStattart = $rStat->{3}->[0x26]/($rStat->{3}->[0x2c] || 1)*100; + if ($ptoverStattart > 100) {$ptoverStattart = 100;} +###################################### +## QA check for PT3/Start rate + if ($ptoverStattart > 100 || $ptoverStattart < 0) { + $qastatept = QA::WARN; + } +###################################### + my $ptmsg = ""; + $ptmsg = sprintf("%s/s / %1.2f%%",QA::SciNotation($rStat->{3}->[0x26]),$ptoverStattart) if $ptoverStattart<=10; + $ptmsg = sprintf("%i/s / %1.1f%%",$rStat->{3}->[0x26],$ptoverStattart) if $ptoverStattart> 10; + my $ptlongmsg = sprintf("PT3 counts per second: %i - PT3 / Start: %1.2f%%", $rStat->{3}->[0x26], $ptoverStattart); + QA::WriteQALog($fqa, "trg", "ptrate", 10, $qastatept, "PT3 / Start", $ptmsg, $ptlongmsg); + + + my $startsum = 0; + my $qastatstart = QA::OK; + my $startmsg = ""; + my $startlongmsg = ""; + + foreach my $i (0..7) { + $startsum += $rStat->{3}->[$i+0x8] ; + } + $spillsum += $startsum; +###################################### +## QA check for spill sum on Start + if ($lastspillsum < 0 || $lastspillsum > 50000000) { + $qastatstart = QA::WARN; + } +###################################### + if($outofspill && !$lastoutofspill ) { + $lastspillsum = $spillsum; + HPlot::PlotAdd("StartCountSpills",$spillsum/1E6); + HPlot::PlotDraw("StartCountSpills"); + $spillsum = 0; + } + $startmsg = sprintf("%s / %s",QA::SciNotation($startsum),QA::SciNotation($lastspillsum)); + $startlongmsg = sprintf("Start counts per second %s/s - Start counts per spill %s",QA::SciNotation($startsum),QA::SciNotation($lastspillsum)); + QA::WriteQALog($fqa, "trg", "start", 10, $qastatstart, "Start Count", $startmsg, $startlongmsg); + + + + + if ($lastlongmsg ne $longmsgcheck && $longmsg ne "") { + system("logger -p local1.info -t DAQ 'Hmon $longmsg'"); + } + + + $lastlongmsg = $longmsgcheck; + + + sleep 1; +} diff --git a/hmon/hmon_vetohist.pl b/hmon/hmon_vetohist.pl new file mode 100755 index 0000000..d034c31 --- /dev/null +++ b/hmon/hmon_vetohist.pl @@ -0,0 +1,45 @@ +#!/usr/bin/perl -w + +use Hmon; +use QA; +use HADES::TrbNet; + +trb_init_ports() or die("could not connect to trbnetd"); + + +my $str; + +my $plots = fork(); + + +if($plots) { + while(1) { + $str = Hmon::MakeTitle(10,11,"Veto Histogram",0); + my $binning = trb_register_read(3,0xa0c8) or sleep 5 and next; + my $offset = trb_register_read(3,0xa0c6) or sleep 5 and next; + $binning = QA::SciNotation($binning->{3}*100E-9); + $offset = QA::SciNotation($offset->{3}*100E-9); + + + $str .= qq@Offset: @.$offset.qq@s - Binning: @.$binning.qq@s@; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("Vetohist",$str); + sleep(5); + } + } + +else { + qx(./hmon_hadplot.sh -d 3000 \\ + -a 0x0003 -r 50216 -m 500 -p 0 -w 32 -t "1" \\ + -a 0x0003 -r 50716 -m 500 -p 0 -w 32 -t "2" \\ + -a 0x0003 -r 51216 -m 500 -p 0 -w 32 -t "3" \\ + -a 0x0003 -r 51716 -m 500 -p 0 -w 32 -t "4" \\ + -a 0x0003 -r 52216 -m 500 -p 0 -w 32 -t "5" \\ + -a 0x0003 -r 52716 -m 500 -p 0 -w 32 -t "6" \\ + -a 0x0003 -r 53216 -m 500 -p 0 -w 32 -t "7" \\ + -a 0x0003 -r 53716 -m 500 -p 0 -w 32 -t "8" \\ + -output "PNG.files/vetohist.760.490" -curvestyle steps -key genreg 2>/dev/null & + + ); + } + diff --git a/hmon/hplottest.pl b/hmon/hplottest.pl new file mode 100755 index 0000000..ca9bd85 --- /dev/null +++ b/hmon/hplottest.pl @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w +use warnings; +use strict; +use Data::Dumper; +use Hmon; +use QA; +use HPlot; + + +my $plot = (); +$plot->{name} = "Testplot"; +$plot->{file} = "Testplot"; +$plot->{entries} = 50; +$plot->{type} = HPlot::TYPE_HISTORY; +$plot->{output} = HPlot::OUT_PNG; +$plot->{titles}->[0] = "Curve 1"; + + +HPlot::PlotInit($plot); +HPlot::PlotAdd("Testplot",50); +HPlot::PlotAdd("Testplot",30); +HPlot::PlotAdd("Testplot",40); +HPlot::PlotAdd("Testplot",20); +HPlot::PlotAdd("Testplot",45); + +HPlot::PlotDraw("Testplot"); +sleep 1; +HPlot::PlotDraw("Testplot"); +# print Dumper $HPlot::p; \ No newline at end of file diff --git a/hmon/icingadaemon.pl b/hmon/icingadaemon.pl new file mode 100755 index 0000000..551b4f2 --- /dev/null +++ b/hmon/icingadaemon.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; +use IO::Socket::INET; + + +my ($socket,$client_socket); +my ($peeraddress,$peerport); + +$socket = new IO::Socket::INET ( + #LocalHost => '127.0.0.1', + LocalPort => '12345', + Proto => 'tcp', + Listen => 5, + Reuse => 1 + ) or die "ERROR in Socket Creation $!\n"; + +my $date = localtime; +print "SERVER started at $ date and is waiting for client\n"; + +while(1) +{ + + while ($client_socket = $socket->accept()) { + + my $pid = fork(); + if ($pid == 0) { + # Child process + + + $peeraddress = $client_socket->peerhost(); + $peerport = $client_socket->peerport(); + $date = localtime; + + print "Accepted New Client Connection From : $peeraddress, $peerport, child created at $date\n"; + + + while (<$client_socket>) { + if ($_ gt "secreticinga") { + + my $command = "/bin/ls -rtl --time-style=+\'\%c \' /var/lib/icinga/status.dat"; + #print $command . "\n"; + my $result = qx($command); + + if (defined $result) { + print $client_socket $result; + } else { + print $client_socket "\n"; + } + } else { + print "got nonsense: $_ \n"; + } + } + $date = localtime; + print "End of child at $date\n"; + } #end if ($pid == 0) + } +} + +$socket->close(); diff --git a/hmon/icingadaemon.sh b/hmon/icingadaemon.sh new file mode 100755 index 0000000..5671bc4 --- /dev/null +++ b/hmon/icingadaemon.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +while true; do /home/hadaq/trbsoft/daq/tools/hmon/icingadaemon.pl; sleep 10; done diff --git a/hmon/index.cgi b/hmon/index.cgi new file mode 100755 index 0000000..ec6c16f --- /dev/null +++ b/hmon/index.cgi @@ -0,0 +1,129 @@ +#!/usr/bin/perl -w +use CGI::Carp qw(fatalsToBrowser); + + +print "Content-type: text/html\r\n\r\n"; + + +print qq$ + + +Monitoring Main Control Interface + + + + + +

+

HADES DAQ Monitoring

+
+
+ + + + + + + + + + + + + + + + + + + + + +$; + + +print "

All available options

    \n"; +my @o = qx(ls -1 files/*.htt); +foreach my $a (@o) { + if ($a =~ m%files/(\w+).htt%) { + print "
  • $1
  • \n"; + } + } +print "

\n"; + + +print qq$ +

Help

+To select the information you want to have, specify any number of the options listed below, separated with '-' after the \"monitor.cgi?\".

+

  • The first option for monitor.cgi may be a number specifying the update rate in seconds.
  • +
  • The first or second option may be \"window\" to open the information in a pop-up with no toolbars and proper sizes. Note that only the first information box is used to determine the size - i.e. if there are two boxes to be shown, you have to resize the window by hand. One remark: to work properly, you have to set all dom.disable_window_open* options in about:config to false.
  • +
  • Everything is tested in the latest version (5 and above, not 2 or 3!) of the Firefox browser - there will be no support for any other kind of html-viewer.
  • +
+
Hints
+
  • Window background will turn red if no update is possible.
  • +
  • If you see a message "Server Error", press F5.
  • +
  • If you want to stop updating, press Esc.
  • +
  • To restart updating, press F5.
  • +
  • Zoom in and out with Ctrl++ and Ctrl+-, normal zoom with Ctrl+0.
  • +
+ +
Examples
+ + + + +$; diff --git a/hmon/indexstyles.css b/hmon/indexstyles.css new file mode 100644 index 0000000..32e5f02 --- /dev/null +++ b/hmon/indexstyles.css @@ -0,0 +1,178 @@ + + +body.index { + overflow:auto; + font-size:13px; + font-family:sans-serif; + background: right bottom url('background.png') no-repeat fixed #def; + line-height:150%; + + } + +body.index h1 { + color:white; + font-size:25px; + background:#346; + margin:-8px; + width:470px; + box-shadow:0px 0px 4px 4px #346;/*, inset 3px 3px 3px 3px #eee, inset -3px -3px 3px 3px #eee;*/ + padding:20px 10px 15px 10px; + } + +body.index h2 { + color:white; + font-size:20px; + background:#346; + margin:8px -8px 10px -8px; + padding:0 10px 10px 10px; + box-shadow:0px 0px 4px 4px #346;/*, inset 3px 3px 3px 3px #eee, inset -3px -3px 3px 3px #eee;*/ + width:470px; + +} + +body.index h3 { + font-weight:bold; + font-size:18px; + display:block; + margin:30px 0 20px 0; + } + +body.index h4 { + clear:both; + font-weight:bold; + font-size:16px; + margin:30px 0 20px 0; + } + + + +body.index div h4 { +/* text-align:center; */ + clear:both; + font-weight:bold; + font-size:15px; + margin:0px 0 0 0; + } + +body.index div ul{ + margin:0 20px 0 20px; + width:300px; + margin-bottom:0px; + padding-left:13px; + } + +body.index ul{ + margin:0 20px 0 20px; + margin-bottom:0px; + padding-left:13px; + } + + +body.index li { + list-style-type: square; + } + + +body>div, .logos { + float:left; + margin: 0px 8px 12px 8px; + padding: 0 0 0 0 ; + + text-align:center; + box-shadow:0px 0px 4px 4px #eef8ff;/*, inset 3px 3px 3px 3px #eee, inset -3px -3px 3px 3px #eee;*/ + border-radius: 5px 5px 5px 5px; + background:#eef8ff; + overflow-y:auto; +} + +div.linkbox { + text-align:left; + width:350px; + margin:10px; + } + +div.linkbox h4{ + text-align:left; +} + +div.linkbox li { + list-style: none; +} + +li a{ + text-decoration: none; + color:#346; + font-weight:bold; +} + +li a:hover{ + text-decoration: none; + color:#fa0; + font-weight:bold; +} + + +ul.optionlist li { + width:300px; + float:left; + list-style:none; + } + + + +div.button { + position:absolute; + background:#def; + box-shadow:0px 0px 4px 4px #def;/*, inset 3px 3px 3px 3px #eee, inset -3px -3px 3px 3px #eee;*/ + top:0px; + height:16px; + cursor:pointer; + font-size:12px; + border-width:0 1px 1px 1px; + border-radius:0 0 0 5px; + color:black; +} + +div#status { +/* float:right; */ + margin:-20px 15px 10px 15px; + padding:10px; + width:600px; + box-shadow:0px 0px 4px 4px #346; + font-family: monospace; + color:white; + background:#346; + border-radius:0 0 5px 5px; +} + +#status table { + vertical-align:top; + text-align:left; + width:550px; +} + +#status td, #status th { + vertical-align:top; +} + +#info { + text-align:left; + float:left; + margin:0; + width:480px; + background:transparent; +} + +dt { + font-weight:bold; +} + + + +.bgn {background:#0d0;color:#000;} +.bye {background:#ff2;color:#000;} +.bor {background:#fa0;color:#000;} +.brd, .brdb {background:#f00;} +.bgr {background:#000;color:#aaa !important;color:#fff;} +.bwh {background:#eee;color:#000;} +.bmg {background:#f0a ;color:#000;} \ No newline at end of file diff --git a/hmon/mdc.png b/hmon/mdc.png new file mode 100644 index 0000000..fefb00c Binary files /dev/null and b/hmon/mdc.png differ diff --git a/hmon/monitor.cgi b/hmon/monitor.cgi new file mode 100755 index 0000000..296fbb9 --- /dev/null +++ b/hmon/monitor.cgi @@ -0,0 +1,170 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use CGI::Carp qw(fatalsToBrowser); +print "Content-type: text/html\r\n\r\n"; + +my $out; + +my $delay = 10; +my @args = split('-',$ENV{'QUERY_STRING'}); + + if ($args[0] =~ m/^(\d+\.?\d?)$/) { + $delay = $1; + } + + if( $ENV{'QUERY_STRING'} =~ m/window-/ ) { + my $newurl = "monitor.cgi?"; + $newurl .= $ENV{'QUERY_STRING'}; + $newurl =~ s/window-//; + $newurl =~ /(-|^|\?)(\w+)$/; + open(my $MYF,"; + close($MYF); + $str =~ /width(\d+)\sheight(\d+)/; + my $width = 80*$1-8; + my $height = 50*$2-8; + $out = qq$ + + +Hmon + + + + + +#; + + } else { + + $out = qq$ + + + + + +Hmon $.$ENV{'QUERY_STRING'}.qq$ + + +
 close 
+
stop
+
 bigger 
+ +
+$; + + + +$out .= qq$$; + } +$out .= qq$ + + +$; + +print $out; + diff --git a/hmon/monitor2.cgi b/hmon/monitor2.cgi new file mode 100755 index 0000000..9d2fdaf --- /dev/null +++ b/hmon/monitor2.cgi @@ -0,0 +1,166 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +print "Content-type: text/html\r\n\r\n"; + +my @o; +my $out; + +sub addfile { + my ($file,$strip) = @_; + my $MYF; + $strip = 0 unless defined $strip; + my $str = ""; + open ($MYF, "<$file") or return $str; + while (<$MYF>){ + if ($_ =~ m%ADDFILE\s([/\w]*).svg%) { + $str .= addfile("$1.svg",1); + } + else { + $_ =~ s/\t*/ /; + if($_ =~ m/^$/) {next;} + if($strip) { + $_ =~ s/; + close($MYF); + $str =~ /width(\d+)\sheight(\d+)/; + my $width = 80*$1-8; + my $height = 50*$2-8; + $out = qq$ + + +Hmon + + + + + +Opening Window.$; + + } else { + + $out = qq$ + + + + + +Hmon $.$ENV{'QUERY_STRING'}.qq$ + + +
 close 
+
 stop 
+
+$; + + + +$out .= qq$$; + } +$out .= qq$ + + +$; + +print $out; + diff --git a/hmon/monitorold.cgi b/hmon/monitorold.cgi new file mode 100755 index 0000000..167a94e --- /dev/null +++ b/hmon/monitorold.cgi @@ -0,0 +1,131 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +print "Content-type: text/html\r\n\r\n"; + +my @o; +my $out; + +sub addfile { + my ($file,$strip) = @_; + my $MYF; + $strip = 0 unless defined $strip; + my $str = ""; + open ($MYF, "<$file") or return $str; + while (<$MYF>){ + if ($_ =~ m%ADDFILE\s([/\w]*).svg%) { + $str .= addfile("$1.svg",1); + } + else { + $_ =~ s/\t*/ /; + if($_ =~ m/^$/) {next;} + if($strip) { + $_ =~ s/; + close($MYF); + $str =~ /width(\d+)\sheight(\d+)/; + my $width = 80*$1-8; + my $height = 50*$2-8; + $out = qq$ + + +Hmon + + + + + +Opening Window.$; + + } else { + + $out = qq$ + + + + + +Hmon $.$ENV{'QUERY_STRING'}.qq$ + + +
 close 
+
 stop 
+
+$; + + $out .= addfile("files/note.htt"); + foreach my $arg (@args) { + if ($arg =~ m/(\w+)/) { + $out .= addfile("files/$1.htt"); + } + } + + $out .= qq$
+\n"; + } +$out .= qq$ + + +$; + +print $out; + diff --git a/hmon/permanent/HPlot.pm b/hmon/permanent/HPlot.pm new file mode 120000 index 0000000..29834ae --- /dev/null +++ b/hmon/permanent/HPlot.pm @@ -0,0 +1 @@ +../HPlot.pm \ No newline at end of file diff --git a/hmon/permanent/Hmon.pm b/hmon/permanent/Hmon.pm new file mode 120000 index 0000000..231efd1 --- /dev/null +++ b/hmon/permanent/Hmon.pm @@ -0,0 +1 @@ +../Hmon.pm \ No newline at end of file diff --git a/hmon/permanent/Perl2Epics.pm b/hmon/permanent/Perl2Epics.pm new file mode 120000 index 0000000..8ef3298 --- /dev/null +++ b/hmon/permanent/Perl2Epics.pm @@ -0,0 +1 @@ +../Perl2Epics.pm \ No newline at end of file diff --git a/hmon/permanent/QA.pm b/hmon/permanent/QA.pm new file mode 120000 index 0000000..03c2367 --- /dev/null +++ b/hmon/permanent/QA.pm @@ -0,0 +1 @@ +../QA.pm \ No newline at end of file diff --git a/hmon/permanent/hmon_archiver.pl b/hmon/permanent/hmon_archiver.pl new file mode 100644 index 0000000..8bbbc51 --- /dev/null +++ b/hmon/permanent/hmon_archiver.pl @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use POSIX qw(strftime); +use Data::Dumper; + +my $header = qq@ + + + + + + + + + + +
 close 
+
stop
+
 bigger 
+ +
+@; + + +my $footer = "
"; + +while(1) { + my $time = strftime("%Y%m%d%H%M",localtime()); +# my $time = "201204111356"; + + system("mkdir /home/hadaq/trbsoft/daq/tools/hmon/archive/$time"); + system("cp /home/hadaq/trbsoft/daq/tools/hmon/files/*.htt /home/hadaq/trbsoft/daq/tools/hmon/files/*.png /home/hadaq/trbsoft/daq/tools/hmon/archive/$time"); + system("mkdir /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/files"); + system("mv /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/*.png /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/files/"); + + my @files = qx(ls /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/*.htt); + foreach my $f (@files) { + my @n = split('/',$f); + my $newf = $n[-1]; + chop $n[-1]; + chop $newf;chop $newf; + $newf .='m'; +# print $newf."\n"; + my $fh; + open($fh,'>',"/home/hadaq/trbsoft/daq/tools/hmon/archive/$time/$newf"); + print $fh $header; + my @g = qx(cat /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/$n[-1]); + foreach my $h (@g) { + if($h =~ m!^(.*)\%ADDPNG\s+(.+)\%(.*)$!) { + print $fh $1.$2.$3; + } + else { + print $fh $h; + } + } + + + + print $fh $footer; + close($fh); + + } + system("mv /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/*.htt /home/hadaq/trbsoft/daq/tools/hmon/archive/$time/files/"); + + sleep(590); + } + \ No newline at end of file diff --git a/hmon/permanent/hmon_archiveveto.pl b/hmon/permanent/hmon_archiveveto.pl new file mode 100644 index 0000000..af07bfd --- /dev/null +++ b/hmon/permanent/hmon_archiveveto.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use POSIX qw(strftime); +use Data::Dumper; + + +while(1) { + my $time = strftime("%Y%m%d%H%M%S",localtime()); +# my $time = "201204111356"; + + system("cp /home/hadaq/trbsoft/daq/tools/hmon/files/vetohist.png /home/hadaq/trbsoft/daq/tools/hmon/archive/veto_$time.png"); + + sleep(30); + } + \ No newline at end of file diff --git a/hmon/permanent/hmon_cpu.pl b/hmon/permanent/hmon_cpu.pl new file mode 100755 index 0000000..919e6d9 --- /dev/null +++ b/hmon/permanent/hmon_cpu.pl @@ -0,0 +1,114 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Clone qw(clone); +use Hmon; +use QA; + +my $store = {}; +my $laststore = {}; +my $values = {}; +my $color = {}; +my $str; +my ($sys,$io,$irq,$busy); + + + +my $fqa = QA::OpenQAFile(); + +# user: normal processes executing in user mode +# nice: niced processes executing in user mode +# system: processes executing in kernel mode +# idle: twiddling thumbs +# iowait: waiting for I/O to complete +# irq: servicing interrupts +# softirq: servicing softirqs + +my @srv = qw(lxhadeb01 lxhadeb02 lxhadeb03 lxhadeb04 lxhadeb05 lxhadeb06 lxhadesdaq hadesdaq01 hadesdaq02 hades30 hades31 hades33); + + +my $template .= "\n\n
"; +for(my $d=1;$d<=16;$d++) { + $template .= "$d"; + } + +while(1) { + $laststore = clone($store); + $store = {}; + for(my $n=0;$n< scalar @srv;$n++) { + my @out = Hmon::qxtimeout("ssh $srv[$n] \"cat /proc/stat \" 7) { + $store->{$n}->{$1}->{"user"} = $s[1]; + $store->{$n}->{$1}->{"nice"} = $s[2]; + $store->{$n}->{$1}->{"sys"} = $s[3]; + $store->{$n}->{$1}->{"idle"} = $s[4]; + $store->{$n}->{$1}->{"io"} = $s[5]; + $store->{$n}->{$1}->{"irq"} = $s[6]; + $store->{$n}->{$1}->{"sirq"} = $s[7]; + $store->{$n}->{$1}->{"tot"} = $s[1]+$s[2]+$s[3]+$s[4]+$s[5]+$s[6]+$s[7]; + } + } + } + } + + my $max = 0; + my $maxstr = ""; + my $busystr = ""; + if (defined $laststore->{0}->{0}->{'idle'}) { + $str = Hmon::MakeTitle(7,7,"Server CPU Usage"); + $str .= $template; + for(my $s = 0; $s < scalar @srv; $s++) { + $str .= "\n
$srv[$s]"; + for(my $c = 0; $c < 32; $c++) { + if (defined $laststore->{$s}->{$c}->{'idle'} && defined $store->{$s}->{$c}->{'idle'}) { + my $this = $store->{$s}->{$c}; + my $last = $laststore->{$s}->{$c}; + if ($this->{'tot'} != $last->{'tot'}) { + $busy = 100-100*($this->{'idle'}-$last->{'idle'})/($this->{'tot'}-$last->{'tot'}); + $sys = 100*($this->{'sys'}-$last->{'sys'})/($this->{'tot'}-$last->{'tot'}); + $io = 100*($this->{'io'}-$last->{'io'})/($this->{'tot'}-$last->{'tot'}); + $irq = 100*($this->{'irq'}-$last->{'irq'}+$this->{'sirq'}-$last->{'sirq'})/($this->{'tot'}-$last->{'tot'}); + } + else { + $busy = 0; + } + $str .= "%2i",Hmon::findcolor($busy||.001,0,100,0),$busy); + if($s>0 && $s<5 && $max < $busy && $c>=2 && $c<=11) { + $max = $busy; + $maxstr = sprintf("%d%%",$max); + $busystr = sprintf("Max. Load: %.1f%% on %s CPU %d (sys %.1f, wait %.1f, irq %.1f)",$max,$srv[$s],$c,$sys,$io,$irq); + } + + if($c%16==15 && defined $store->{$s}->{$c+1}->{'idle'}) { + $str .= "
"; + } + } + else { + #$str .= ""; + next; + } + } + } + $str .= "
\n"; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("EBCPU",$str); + my $qastate = QA::GetQAState('below',$max,@QA::CPULimits); + QA::WriteQALog($fqa,"server","cpu",40,$qastate,"Max. CPU",$maxstr,$busystr); + sleep 10; + } + else { + sleep 1; + } + + } \ No newline at end of file diff --git a/hmon/permanent/hmon_eb_run.pl b/hmon/permanent/hmon_eb_run.pl new file mode 100755 index 0000000..5c55c42 --- /dev/null +++ b/hmon/permanent/hmon_eb_run.pl @@ -0,0 +1,238 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; +use Perl2Epics; +use HADES::TrbNet; + +my $store = {}; +my @time; +my @state; +my @rate; +my @disc; +my $mismatchfound_sa = -10; +my $mismatchfound_sr = -10; +my $events = 0; +my @evtrates = (0,0,0); +my @ebrates = (); +my ($oldsumtype1,$oldsumtype9,$oldsumtypeE) = (0,0,0); +my ($cnterrtype9,$cnterrtypeE) = (50,50); +my $lasttotalbytes = 21; + +sub cntbits32 { + return (unpack('%32b*', pack('i',$_[0]))); + } + +my $connect_status = &trb_init_ports(); +if(!$connect_status) { + die("could not connect to trbnetd"); +} + +my $fqa = QA::OpenQAFile(); + +for(my $i = 0; $i<=15; $i++) { + my $s = sprintf("HAD:eb%02i",$i+1); + Perl2Epics::Connect("ebstat$i",$s.":status"); + Perl2Epics::Connect("ebrate$i",$s.":evtCRate"); + Perl2Epics::Connect("ebdisc$i",$s.":evtDRate"); + Perl2Epics::Connect("ebbyte$i",$s.":byteWRate"); + Perl2Epics::Connect("eb$i"."type1", $s.":trigtype:1"); + Perl2Epics::Connect("eb$i"."type9", $s.":trigtype:9"); + Perl2Epics::Connect("eb$i"."typeE", $s.":trigtype:E"); + } +Perl2Epics::Connect("totalEvts","HAD:eb:totalEvtsComp"); +Perl2Epics::Connect("prefix","HAD:eb01:prefix",'DBR_TIME_STRING'); + +my $spilllength = 0; + +while(1) { + my $totalrate = 0; + my $totalbytes = 0; + my $totaldiscarded = 0; + my $ioc = 0; + my $actmask = 0; + my $recvmask = 0; + my $qastate = QA::OK; + my $qamsg = ""; + my $evtrate = 0; + my $qastatedisc = QA::OK; + my $qamsgdisc = ""; + my $evtavgspill, my $evtavg3; + my $byteavg3, my $byteavgspill; + my $ebavgrate = 0; + my $trbneterr = 0; + my $sumtype1 = 0; + my $sumtype9 = 0; + my $sumtypeE = 0; + my ($ratetype1,$ratetype9,$ratetypeE) = (0,0,0); + + # 0x03 => CTS + my $rh_result = trb_register_read(QA::CTSAddress, 0xa0f0) or $trbneterr = 1; # or sleep 5 and next; + my $sentmask = ($rh_result->{QA::CTSAddress} || 0) & 0xFFFF; + + + # 0x3000 => ?? + $rh_result = trb_register_read(0x3000, 0x1) or $trbneterr = 1; + my $res = ($rh_result->{0x3000} || 0) & 0xFFFF; + + $evtrate = $res - ($events || $res); + $evtrate += 2**16 if $evtrate < 0; + $events = $res; + pop(@evtrates) if scalar @evtrates >= $QA::AcceleratorCycle * 2; + unshift(@evtrates,$evtrate); + $evtavg3 = $evtrates[0] + $evtrates[1] + $evtrates[2]; + $evtavg3 /= 3; + $evtavgspill += $_ for @evtrates; + $evtavgspill /= scalar @evtrates; + + my $data = Perl2Epics::GetAll(); + for(my $i = 0; $i<=15; $i++) { + $totalrate += $data->{"ebrate$i"}->{val} || 0; + $totaldiscarded += $data->{"ebdisc$i"}->{val} || 0; + $totalbytes += $data->{"ebbyte$i"}->{val} || 0; + + $sumtype1 += $data->{"eb$i"."type1"}->{val} || 0; + $sumtype9 += $data->{"eb$i"."type9"}->{val} || 0; + $sumtypeE += $data->{"eb$i"."typeE"}->{val} || 0; + + if(($data->{"ebdisc$i"}->{val} || 0) > 5) { + $qamsgdisc .= " - " unless $qamsgdisc eq ""; + $qamsgdisc .= "EB".($i+1)." ".$data->{"ebdisc$i"}->{val}." events"; + } + + if ($data->{"ebstat$i"}->{val}) { + $actmask |= (1<<$i); + if ($data->{"ebrate$i"}->{val} > 0) { + $recvmask |= (1<<$i); + } + } + } + pop(@ebrates) if scalar @ebrates >= $QA::AcceleratorCycle * 2; + unshift(@ebrates,$totalrate); + $ebavgrate += $_ for @ebrates; + $ebavgrate /= scalar @ebrates; + + my $act = cntbits32($actmask); + my $sent = cntbits32($sentmask); + my $recv = cntbits32($recvmask); + my $mismatch_sr = 0; + my $mismatch_sa = 0; + for(my $i=0;$i<16;$i++) { + $mismatch_sr |= (1<<$i) if ($sentmask & (1<<$i)) && !($recvmask & (1<<$i)); + $mismatch_sa |= (1<<$i) if ($sentmask & (1<<$i)) && !($actmask & (1<<$i)); + } +# printf ("actmask: %08X, recvmask: %04X, sentmask: %04X, mismatch_sr: %04X, mismatch_sa: %04X\n", +# ,$actmask,$recvmask,$sentmask,$mismatch_sr,$mismatch_sa); + +#Mismatch between selected EB in CTS and EB receiving data + if($mismatch_sr != 0) { + if ($evtrate > $act*32) { + my $str = ""; + for(my $i = 0; $i < 16; $i++) { + if ($mismatch_sr & (1<<$i)) { + $str .= ", " if $str ne ""; + $str .= $i+1; + } + } + if ($mismatchfound_sr++ >= 0 && $trbneterr == 0) { + system("logger -p local1.info -t DAQ 'EB Data is sent to EB $str but not received'") unless $mismatchfound_sr % 240; + $qastate = QA::ERROR; + $qamsg .= "Data is sent to EB $str but not received. "; + } + } + } + else { + $mismatchfound_sr = -10; + } + + +#Mismatch between selected EB in CTS and running EB processes + if($mismatch_sa != 0) { + my $str = ""; + for(my $i = 0; $i < 16; $i++) { + if ($mismatch_sa & (1<<$i)) { + $str .= ", " if $str ne ""; + $str .= $i+1; + } + } + if ($mismatchfound_sa++ >= 0 && $trbneterr == 0) { + system("logger -p local1.info -t DAQ 'EB Data is sent to not running EB $str'") unless $mismatchfound_sa % 60; + $qastate = QA::ERROR; + $qamsg .= "Data is sent to not running EB $str. "; + } + } + else { + $mismatchfound_sa = -10; + } + if($trbneterr) { + $qamsg .= "TrbNet Error - no information available."; + $qastate = QA::ERROR; + } + if ($qamsg eq "") {$qamsg = "No error found";} + if ($qastate == QA::OK) { + $qamsg .= sprintf(". Total rate: %i, 2-spill average: %i, total per EB: %i", $totalrate,$ebavgrate,$totalrate/($recv || $totalrate || 1)); + } + + $qamsgdisc = "Discarded events: $totaldiscarded - ".$qamsgdisc; + + + my $qatitle = "#EB running"; + $qatitle = "EB stopped" if ($act == 0) ; + Hmon::Speak('ebrun',$qamsg) if $qastate > 60; + QA::WriteQALog($fqa, "eb", "run", 10, $qastate, $qatitle, + "act: $recv/$sent (".$data->{"prefix"}->{val}.")", $qamsg); +# if ($totalrate) { + $qastatedisc = QA::GetQAState('below',$totaldiscarded/($totalrate || $totaldiscarded || 1),(0.001,0.01,0.1)); +# } +# else { +# $qastatedisc = QA::NA; +# } + + my $totallost = $evtavgspill - $totalrate; + my $s = sprintf("%5d",$totaldiscarded); + QA::WriteQALog($fqa, "eb", "lostevt", 10, $qastatedisc, + "#Evt Discarded", $s, $qamsgdisc); + + $ratetype1 = $sumtype1 - $oldsumtype1 unless ($oldsumtype1 > $sumtype1); + $ratetype9 = $sumtype9 - $oldsumtype9 unless ($oldsumtype9 > $sumtype9); + $ratetypeE = $sumtypeE - $oldsumtypeE unless ($oldsumtypeE > $sumtypeE); + + $cnterrtype9 += -0.8+$ratetype9 if $evtrate > $act*32; + $cnterrtypeE += -0.8+$ratetypeE if $evtrate > $act*32; + if($oldsumtype1 > $sumtype1) { + $cnterrtype9 = 50; + $cnterrtypeE = 50; + } + + + $qastate = QA::OK; +# $qastate = QA::WARN if $ebavgrate <= 0; + my $evtavgshort = sprintf("%i MB - %i kB",$totalbytes/1024,$totalbytes/($totalrate || $totalbytes || 1)); + my $evtavglong = sprintf("%i MB/s - %i kB/evt - %i Evt/EB/s",$totalbytes/1024,$totalbytes/($totalrate || $totalbytes || 1),$totalrate/($recv || $totalrate || 1)); + $evtavglong .= sprintf(" - MDC Calib Evt: %i (%i/s) - Status Evt: %i (%i/s)", + $sumtype9,$ratetype9,$sumtypeE,$ratetypeE); + + if($cnterrtypeE < 30 || $cnterrtype9 < 30) { + $qastate = QA::WARN_2; + $evtavglong .= " - Number of special triggers is not correct (debug $cnterrtype9 $cnterrtypeE)"; + } + if($totalbytes < 20 && $lasttotalbytes <20) { + $qastate = QA::WARN_2; + } + + if($trbneterr == 0) { + QA::WriteQALog($fqa,"eb","bytes",5,$qastate,"Data Rate",$evtavgshort,$evtavglong); + } + else { + QA::WriteQALog($fqa,"eb","bytes",30,QA::NA,"Data Rate","N/A","N/A"); + } + + ($oldsumtype1,$oldsumtype9,$oldsumtypeE) = ($sumtype1,$sumtype9,$sumtypeE); + $lasttotalbytes = $totalbytes; + usleep(990000); + } diff --git a/hmon/permanent/hmon_ebdiskfill.pl b/hmon/permanent/hmon_ebdiskfill.pl new file mode 100755 index 0000000..26a96b5 --- /dev/null +++ b/hmon/permanent/hmon_ebdiskfill.pl @@ -0,0 +1,80 @@ +#!/usr/bin/perl -w +use warnings; +use strict; + +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; + +my $store = {}; +my $laststore = {}; +my $values = {}; +my $color = {}; +my $raw = {}; +my $val; +my $max; +my $maxb; +my $maxqa; +my $fqa = QA::OpenQAFile(); + + + +$max = 0; +my $str; +while (1) { + $maxqa = 0; + $str = Hmon::MakeTitle(8,3,"Eventbuilder Disk Fill Level"); + $str .= "\n
"; + for (my $d=1;$d<=22;$d++) { + $str .= "$d"; + } + for (my $n=1;$n<=5;$n++) { + my @out = Hmon::qxtimeout("ssh lxhadeb0$n \"df -h \"",10); + foreach my $a (@out) { + if ($a =~ /(\d*)\%\s*\/data(\d\d)/) { + $store->{$n}->{$2} = $1; + # print $a." $1 $2\n"; + if ($1 > $max) { + $max = $1; $maxb = "$1% on lxhadeb$n Disk $2"; + } + if ($1 > $maxqa) { + $maxqa = $1; + } + } + } + $str .= "\n
lxhadeb$n"; + for (my $d=1;$d<=22;$d++) { + my $id = $d; + $id = '0'.$d if $d<10; + $store->{$n}->{$id} = 0 unless exists $store->{$n}->{$id}; + $str .= "%2i",Hmon::findcolor($store->{$n}->{$id},0,100,0),$store->{$n}->{$id}); + } + + } + $str .= "
\n"; + $str .= Hmon::MakeFooter(); + Hmon::WriteFile("EBDisks",$str); + if ($max <= 95) { + } elsif ($max<=98) { + system("logger -p local1.info -t DAQ 'EBdisk Eventbuilder ".$maxb." exceeds $max% fill level.'"); + $max = 120; + } elsif ($max<=100) { + system("logger -p local1.info -t DAQ 'EBdisk Eventbuilder ".$maxb." exceeds $max% fill level.'"); + $max = 120; + } elsif ($max > 101) { + $max--; + } #20*300s break between messages + else { + $max = 0; + } + + my $qastate = QA::GetQAState('below',$max,95,98,99); + QA::WriteQALog($fqa,"server","fill",1000,$qastate,"Disk Level","$maxqa%","$maxb"); + + + sleep 30; +} diff --git a/hmon/permanent/hmon_eberrbits.pl b/hmon/permanent/hmon_eberrbits.pl new file mode 100755 index 0000000..3586e46 --- /dev/null +++ b/hmon/permanent/hmon_eberrbits.pl @@ -0,0 +1,147 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; +use Perl2Epics; +use HADES::TrbNet; + +my $timer = 0; +my $flog = QA::OpenQAFile(); + +# my $connect_status = &trb_init_ports(); +# if(!$connect_status) { +# die("could not connect to trbnetd"); +# } + +my $sources = {50000 => "CTS/Start", + 50003 => "RICH 1/2", + 50004 => "RICH 3/4", + 50005 => "RICH 5/6", + 50006 => "RPC 1/2/3", + 50007 => "RPC 4/5/6", + 50008 => "Shower", + 50009 => "TOF", + 50010 => "FWall", + 50011 => "CTS/Start", + 50016 => "MDC 1/2 1000", + 50017 => "MDC 1/2 1010", + 50018 => "MDC 1/2 1020", + 50019 => "MDC 1/2 1030", + 50020 => "MDC 1/2 1040", + 50021 => "MDC 1/2 1050", + 50022 => "MDC 3/4 sec.1", + 50023 => "MDC 3/4 sec.2", + 50024 => "MDC 3/4 sec.3", + 50025 => "MDC 3/4 sec.4", + 50026 => "MDC 3/4 sec.5", + 50027 => "MDC 3/4 sec.6", + 50028 => "MDC Test", + 50032 => "Shower sec.1", + 50033 => "Shower sec.2", + 50034 => "Shower sec.3", + 50035 => "Shower sec.4", + 50036 => "Shower sec.5", + 50037 => "Shower sec.6", + }; + +my @bits = qw(OK Collision WordMissing ChecksumMismatch DontUnderstand BufferMismatch AnswerMissing 7 8 9 10 11 12 13 14 15 + EventNumberMismatch TriggerCodeMismatch WrongLength AnswerMissing NotFound PartiallyMissing SevereProblem BrokenEvent EthernetLinkError SubEventBufferFull EthernetError TimingTriggerError 28 29 30 31); + + +Perl2Epics::Connect("streams","HAD:eb01:nrOfMsgs"); +foreach my $i (0 .. 20) { + Perl2Epics::Connect("stream".($i),"HAD:eb01:portnr1:".($i)); + Perl2Epics::Connect("stream".($i+21),"HAD:eb01:portnr2:".($i+21)); + } +foreach my $i (1 .. 16) { + my $t = sprintf("%02i",$i); + foreach my $s (0 .. 4) { + Perl2Epics::Connect("eb".$i."stat$s","HAD:eb$t:stat:errBitStat$s"); + Perl2Epics::Connect("eb".$i."pat$s","HAD:eb$t:stat:errBitPtrn$s"); + } + } + + + +sleep(2); + +while(1) { + my $data = Perl2Epics::GetAll(); + + my $store = {}; + #$store->{all}->{$bit} + #$store->{$stream}->{$bit} + + my $streams = $data->{"streams"}->{val} || 0; + + foreach my $eb (1 .. 16) { + foreach my $stream (0 .. $streams-1) { + my $currentstream = ($data->{"stream".($stream)}->{val} || 0); +# print $currentstream." ".$stream."\n"; + foreach my $pat (0 .. 4) { + my $currentpattern = $data->{"eb".$eb."pat".$pat}->{val} || 0; + foreach my $bit (0 .. 31) { + if($currentpattern & (1<<$bit)) { + my $currentvalue = $data->{"eb".$eb."stat".$pat}->{val}[$stream] || 0; + if($currentvalue) { + $store->{$currentstream}->{$bit}+= $currentvalue; + } + $store->{all}->{$bit} += $currentvalue; + } + } + } + } + } +# print Dumper $store; + +# my $str = Hmon::MakeTitle(10, 23, "MDC HV", 1, ""); +my $longstring = ""; +my $qastate = QA::OK; +my $value = ""; +my $brokenevents = 0; +my $maxperc = 0; +my $sumperc = 0; +my $errcnt = 0; + + foreach my $k (sort keys %$store) { + if ($k ne "all") { + foreach my $b (sort keys %{$store->{$k}}) { + if(($b != 0)) { + my $perc = $store->{$k}->{$b}/($store->{$k}->{0} || $store->{$k}->{$b} || 1)*100; + $maxperc = $perc if $perc > $maxperc; + $sumperc += $perc; + my $ts = sprintf("%s has %i events (%.2f%%) with %s - ", + $sources->{$k}, + $store->{$k}->{$b}, + $perc, + @bits[$b]); + $longstring .= $ts; + + $brokenevents += $store->{$k}->{$b}; + } + } + } + } + $value = sprintf("%s (%.1f%%)",QA::SciNotation($brokenevents), $sumperc); + + $longstring = "Total Events in file: ".($store->{50010}->{0} || "")." - ". + "Events with errors: ".$value." - ". + $longstring; + chop $longstring;chop $longstring;chop $longstring; + + $qastate = QA::GetQAState('below', $sumperc, @QA::Eventsbroken); + + QA::WriteQALog($flog, "eb", "errbits", 10, + $qastate, "#Evt w/ errors", $value, $longstring); + + system("logger -p local1.info -t DAQ 'EB Events with set error-bits written to file: $longstring'") if ($qastate > 60 && !($timer++%60)); + $timer = 0 if $qastate <= 60; + Hmon::Speak("Eventbuilder receive events with set error bits") if $brokenevents > 1000 && $qastate >= 60; + sleep(1); + } + diff --git a/hmon/permanent/hmon_hldlastfiles.pl b/hmon/permanent/hmon_hldlastfiles.pl new file mode 100755 index 0000000..e71dc17 --- /dev/null +++ b/hmon/permanent/hmon_hldlastfiles.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w +use warnings; +use strict; + +use Time::HiRes qw( gettimeofday usleep time ); +use FileHandle; +use Data::Dumper; +use POSIX qw/floor ceil/; +use Hmon; +use QA; + + +while(1) { + my $out = Hmon::MakeTitle(6,7,"Last *.hld files"); + $out .= "
 ";
+  foreach my $i (5,2,3,4) {
+    my $server = sprintf("lxhadeb%02i",$i);
+    $out .= "$server\n";
+    my $cmd = "ssh $server \"ls -rtlh /data*/data/*.hld | tail -n4\"";
+    my @a = qx($cmd);
+    foreach my $s (@a) {
+      $s =~ s/-rw-r--r-- 1 hadaq hades//;
+      $out .= $s;
+      }
+    }
+    $out .= "
"; + $out .= Hmon::MakeFooter(); + Hmon::WriteFile("hldlast",$out); + + sleep(10); + } \ No newline at end of file diff --git a/hmon/permanent/hmon_hub.pl b/hmon/permanent/hmon_hub.pl new file mode 100755 index 0000000..aedf721 --- /dev/null +++ b/hmon/permanent/hmon_hub.pl @@ -0,0 +1,741 @@ +#!/usr/bin/perl -w +#-d:DProf +use Hmon; +use QA; + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use File::stat; +use FileHandle; +use List::MoreUtils qw(any apply uniq); +use List::Util 'max'; + +use Time::HiRes qw( time alarm sleep ); +use Term::ANSIColor qw(:constants); +use Term::ReadKey; + +# require Term::Cap; +require POSIX; + +use POSIX qw(strftime); +use threads; +use threads::shared; +use IO::Socket; + +#use Term::ANSIColor qw(uncolor); +#print uncolor ('01;31'), "\n"; + +#$Term::ANSIColor::AUTORESET++; # reset color after each print +#$SIG{INT} = sub { print RESET; print "\n"; exit; }; # reset color after Ctrl-C + +#- POSIX signal handlers: see signal(7) or kill(1) for available signals +foreach my $signal ( qw(HUP INT QUIT ILL ABRT FPE SEGV TERM USR1 USR2) ) { + $SIG{$signal} = sub { &finishAndExit( $signal ); }; +} + +my $fqa = QA::OpenQAFile(); +Hmon::TraceDBLoad(); + + +#- Definitions for missing boards +my $boards_check_time = 1; +my $busy_check_time = 1; +my $time_old = 0; +my @daq_boards_list = (); +my @missBoards = (); +my $opt_help = 0; +my $opt_syslog = "on"; +my $opt_miss = "on"; +my $opt_debug = 0; +my $longmsg = 0; +my $maxpercent = 0; + +$SIG{USR1} = \&finishAndExit; + +GetOptions ('h|help' => \$opt_help, + 'o|board=f' => \$boards_check_time, + 'b|busy=f' => \$busy_check_time, + 's|syslog=s' => \$opt_syslog, + 'm|miss=s' => \$opt_miss, + 'd|debug' => \$opt_debug); + +if ( $opt_help ) { + &help(); + exit(0); +} + +#- Vars for TCP client +my $ExitCode : shared = -1; +my $ServStatus : shared = "OK"; +my $Logger : shared = 1; + +$Logger = 0 unless(lc($opt_syslog) eq "on"); + +#-------- Start status server thread +threads->new( \&statusClient ) if(lc($opt_syslog) eq "on"); + +#- Definitions for hubs +my $msg = "OK"; +my %hub_hash; +my $hub_href = \%hub_hash; +my @status_base = qw(f e d c b a 9 8 7 6 5 4 3 2 1 0); + +#- Definitions for logging +my $log_statMsg_done = 0; +my $log_missBrds_done = 0; +my $msgtimer = 1; + +# system("clear"); + +#- Get terminal's output speed +# my $termios = new POSIX::Termios; +# $termios->getattr; +# my $ospeed = $termios->getospeed; + +#- Get a reference to a terminal object +# my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }; +# $terminal->Trequire(qw/ce ku kd/); + +#- When the string reaches the terminal boundary +# it should not go to next line! +# my $word_wrap_off = "\e[?7l"; +# print $word_wrap_off; + +#- Move the cursor to 0:0 +# my $row0 = 0; +# my $col0 = 0; + +while (1) { + + # $terminal->Tgoto('cm', $col0, $row0, *STDOUT); + # $terminal->Tputs('cd',1, *STDOUT); # clear screen to the end + + &display($hub_href); + + $msg = "OK"; + if ($opt_miss eq "on") { + &getMissingBoards(); + } + + %hub_hash = (); + next if(&getDataFromTRBNet($hub_href)); + &calcBusy($hub_href); +} + +&finishAndExit(0); + +exit(0); + +###################### END OF MAIN ####################### + +sub help() + { + print "\n"; + print << 'EOF'; +mon_hub.pl + + This script monitors busy time of Hubs as well as + missing boards. + +Usage: + + Command line: mon_hub.pl + [-h|--help] : Show this help. + [-o|--board