--- /dev/null
+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
--- /dev/null
+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 = "<div class=\"width$width height$height\">\n";
+ if ($time) {
+ $str .= "<div class=\"timestamp\">".strftime("%H:%M:%S", localtime())."</div>\n";
+ }
+ if (defined $error && $error ne "") {
+ $str .= "<div class=\"errorstamp\">$error</div>\n";
+ }
+ $str .= "<h3 id='title'>$title</h3>";
+ return $str;
+}
+
+sub MakeFooter {
+ my $str;
+ $str = "</div>\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, "</home/hadaq/trbsoft/daq/tools/nettrace.db" or die "Can't open dbfile: $!";
+ local $/;
+ eval <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 .= "<table class=\"mdc sector$sector\">\n";
+ if ($plane == 0) {
+ $str .= "<tr><td><td><td $color->{12} title=\"$val->{12}\">C<td><td $color->{13} title=\"$val->{13}\">D<td><td>\n";
+ $str .= "<tr><td><td><td $color->{10} title=\"$val->{10}\">A<td><td $color->{11} title=\"$val->{11}\">B<td><td>\n";
+ $str .= "<tr><td><td $color->{2} title=\"$val->{2}\">2<td colspan=3 rowspan=2 class=\"ctr\">$sector<td $color->{7} title=\"$val->{7}\">7<td>\n";
+ $str .= "<tr><td $color->{4} title=\"$val->{4}\">4<td $color->{1} title=\"$val->{1}\">1<td $color->{6} title=\"$val->{6}\">6<td $color->{9} title=\"$val->{9}\">9\n";
+ $str .= "<tr><td $color->{3} title=\"$val->{3}\">3<td $color->{0} title=\"$val->{0}\">0<td><td><td><td $color->{5} title=\"$val->{5}\">5<td $color->{8} title=\"$val->{8}\">8<tr>\n";
+ } elsif ($plane == 1) {
+ $str .= "<tr><td><td><td $color->{14} title=\"$val->{14}\">E<td><td $color->{15} title=\"$val->{15}\">F<td><td>\n";
+ $str .= "<tr><td><td><td $color->{12} title=\"$val->{12}\">C<td><td $color->{13} title=\"$val->{13}\">D<td><td>\n";
+ $str .= "<tr><td><td $color->{5} title=\"$val->{5}\">5<td colspan=3 rowspan=2 class=\"ctr\">$sector<td $color->{11} title=\"$val->{11}\">B<td>\n";
+ $str .= "<tr><td><td $color->{4} title=\"$val->{4}\">4<td $color->{10} title=\"$val->{10}\">A<td>\n";
+ $str .= "<tr><td><td $color->{3} title=\"$val->{3}\">3<td $color->{1} title=\"$val->{1}\">1<td><td $color->{7} title=\"$val->{7}\">7<td $color->{9} title=\"$val->{9}\">9<td>\n";
+ $str .= "<tr><td><td $color->{2} title=\"$val->{2}\">2<td $color->{0} title=\"$val->{0}\">0<td><td $color->{6} title=\"$val->{6}\">6<td $color->{8} title=\"$val->{8}\">8<td>\n";
+ # $str .= "<tr><td><td><td $color->{1} title=\"$val->{1}\">1<td><td $color->{7} title=\"$val->{7}\">7<td><td>\n";
+ # $str .= "<tr><td><td><td $color->{0} title=\"$val->{0}\">0<td><td $color->{6} title=\"$val->{6}\">6<td><td>\n";
+ } else {
+ $str .= "<tr><td><td $color->{12} title=\"$val->{12}\">C<td $color->{13} title=\"$val->{13}\">D<td><td $color->{14} title=\"$val->{14}\">E<td $color->{15} title=\"$val->{15}\">F<td>\n";
+ $str .= "<tr><td $color->{5} title=\"$val->{5}\">5<td><td><td><td><td><td $color->{11} title=\"$val->{11}\">B\n";
+ $str .= "<tr><td $color->{4} title=\"$val->{4}\">4<td><td colspan=3 rowspan=2 class=\"ctr\">$sector<td><td $color->{10} title=\"$val->{10}\">A\n";
+ $str .= "<tr><td><td $color->{3} title=\"$val->{3}\">3<td $color->{9} title=\"$val->{9}\">9<td>\n";
+ $str .= "<tr><td><td $color->{2} title=\"$val->{2}\">2<td><td><td><td $color->{8} title=\"$val->{8}\">8<td>\n";
+ $str .= "<tr><td><td><td $color->{1} title=\"$val->{1}\">1<td><td $color->{7} title=\"$val->{7}\">7<td><td>\n";
+ $str .= "<tr><td><td><td $color->{0} title=\"$val->{0}\">0<td><td $color->{6} title=\"$val->{6}\">6<td><td>\n";
+ }
+ $str .= "</table>\n";
+ return $str;
+}
+
+###############################################################################
+# Draw Scale
+###############################################################################
+sub DrawScale {
+ my ($min,$max,$steps) = @_;
+ my $str;
+ # print "$min $max $steps\n";
+ return "" if $max == $min;
+ $str .= "<table class=\"scale\"><tr>";
+ $str .= sprintf("<td style=\"background-color:%4s;\">",Hmon::findcolor(0,0,$steps,0));
+ return $str.="</table>" if $max == $min;
+ $str .= sprintf("<td class=\"label\">%#2.3G",$min);
+ for (my $i = 1;$i<$steps;$i++) {
+ # my $j = ($max-$min)/$steps*$i;
+ $str .= sprintf("<td style=\"background-color:%4s;\">",Hmon::findcolor($i,0,$steps,0));
+ }
+ $str .= sprintf("<td class=\"label\">%#2.3G",$max);
+ $str .= "</table>\n";
+ # $str .= "<table class=\"scalelabels\"><tr>";
+ # $str .= sprintf("<td>%2.1G<td>%2.1G<td>%2.1G\n",$min+($max-$min)/4,$min+($max-$min)*2/4,$min+($max-$min)*3/4);
+ # $str .= "</table>\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__
--- /dev/null
+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__
--- /dev/null
+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__
--- /dev/null
+#!/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~<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Tactical Overview Documentation</title>
+<meta http-equiv="content-type" content="text/html;charset=UTF-8"/>
+
+<link href="files/indexstyles.css" rel="stylesheet" type="text/css"/>
+</head>
+
+<body class="index" style="position:relative;background:#d8e8f8;width:650px;margin:auto;padding:120px 0 40px 0">
+<div style="position:fixed;left:0;top:0;width:100%;height:120px;background:transparent;box-shadow:none;overflow:hidden">
+<div style="position:absolute;width:100%;height:85px;top:0px;background:#d8e8f8;"></div>
+<h1 style="position:fixed;top:5px;left:0px;width:100%;display:block;text-align:center;margin:26px 0 0px 0">Tactical Overview Guide</h1>
+<div style="position:relative;width:650px;margin:auto;">
+<div class="logos" style="position:absolute;left:-95px;top:30px;background:#346;padding:10px;margin:-22px 5px 5px 15px;"><img style="background:white;padding:6px 0 6px 0;" src = "doc/background.png" width=84></div>
+<div class="logos" style="position:absolute;right:-80px;top:30px;background:#346;padding:10px;margin:-22px 15px 5px 5px;"><img style="background:white;padding:6px 0 6px 0;" src = "doc/background.png" width=84></div>
+</div>
+</div>
+<div id="status">Status: </div>
+~;
+
+
+unless (defined $class && defined $entry) {
+ $out .= "<h3>This script should not be called directly, but only with correct options.</h3>";
+ goto END;
+ }
+
+
+ my $MYF;
+ my $str = "";
+ open ($MYF, "<doc/$class-$entry.htt") or do {
+ $out .= "<h3>Can not find requested help file \"doc/$class-$entry.htt\"</h3>";
+ goto END;
+ };
+ $out .= $_ while (<$MYF>);
+
+END:
+
+$out .= qq$</body>
+
+<script type="text/javascript">
+
+ function askclose() {
+ if(1 || confirm("Close Window?")==true){window.close();}
+ }
+
+function reload() {
+ xmlhttp=new XMLHttpRequest();
+ xmlhttp.onreadystatechange = function() {
+ if(xmlhttp.readyState == 4) {
+ document.getElementById("status").innerHTML=xmlhttp.responseText;
+
+ reloadevery = setTimeout('reload()',10000);
+ }
+ };
+ xmlhttp.open("GET","getqa.cgi?$.$ENV{'QUERY_STRING'}.qq$",true);
+ xmlhttp.send(null);
+ }
+
+ setTimeout('reload()',8);
+</script>
+
+</html>
+$;
+
+print $out;
--- /dev/null
+#!/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/<tr>/\n<tr>/gi;
+ $l =~ s#</table>#\n</table>#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 "<table>\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#^<tr># ) {
+ $store->{$l}=1;
+ print $fout $l;
+ }
+ }
+ }
+ $cmd = "sort $pathtoarchive/logfile.htm >$pathtoarchive/logfile2.htm";
+ system($cmd);
--- /dev/null
+/dev/shm/hmon
\ No newline at end of file
--- /dev/null
+#!/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/<svg/<svg preserveAspectRatio="XMidYMid" /;
+ if($_ =~ m/<\?/) {next;}
+ if($_ =~ m/<!/) {next;}
+ if($_ =~ m/.dtd/) {next;}
+ }
+# my $r = int(rand(1000));
+# $_ =~ s/(getpic.cgi\?[^"]+)"/$1-$r"/;
+ $str .= $_;
+ }
+ }
+ return $str;
+ }
+
+
+
+my $out;
+ $out .= addfile("files/note.htt");
+ foreach my $arg (@args) {
+ if ($arg =~ m/(\w+)/) {
+# $out .= $arg;
+ $out .= addfile("files/$1.htt");
+ }
+ }
+
+print $out;
+
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Data::Dumper;
+use File::Copy;
+my @args = split('-',$ENV{'QUERY_STRING'});
+
+# unless($args[0] =~ m/\w+/) {exit;}
+
+print "Cache-Control: no-cache, must-revalidate, max-age=1\r\n";
+print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\r\n";
+print "Content-type: image/png\r\n\r\n";
+
+system ("cat /srv/www/htdocs/mon/files/".$args[0].".png");
+
+
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Data::Dumper;
+use CGI::Carp qw(fatalsToBrowser);
+
+print "Content-type: text/html\r\n\r\n";
+# print "<?xml version=\"1.0\" ?>\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, "<files/QA.htt") or print "File not found." and exit;
+while (<$MYF>){
+ if($_ =~ m/$query/i) {
+# print $_."<br>";
+ $out .= "<table><tr><th style='width:80px'>Entry<td><b>$query</b> - ";
+ $_ =~ m/class="(\d+)/;
+ $out .= LevelName($1);
+ $_ =~ m/alt=".+\((\d\d:\d\d:\d\d)\)/;
+ $out .= " @ ".$1;
+
+ $_ =~ m$>(.+)<br/>(.+)</div>$;
+ $out .= "<tr><th>Short<td>$1 - $2";
+
+ $_ =~ m$alt=".+<br />(.+)"\sonmouseover$;
+ my $s = $1;
+ $s =~ s$\s-\s$<br/>$gi;
+ $out .= "<tr><th>Msg<td><div style='max-height:300px;overflow-y:auto'>";
+ $out .= $s;
+ $out .= "</div></table>";
+ }
+ }
+
+#<div id="eb-run" class="10 bgn" alt="EB-#EB running (13:54:18): OK<br /> No error found. Total rate: 0, 2-spill average: 0, total per EB: 0" onmouseover="clk(this);" onclick="openhelp('eb-run')">#EB running<br/>active: 0/1</div>
+
+close $MYF;
+print $out;
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use Hmon;
+
+my $str;
+
+
+ $str = Hmon::MakeTitle(5,6,"Busy Times",0);
+# $str .= "<img src=\"files/busy.svg\" alt=\"Sorry, Image comes back in few seconds...\">\n";
+ $str .= "<img width=\"380\" height=\"265\" src=\"%ADDPNG files/busy.png%\" type=\"image/png\">\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);
+
+
--- /dev/null
+#!/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 .= "<img width=\"620\" height=\"265\" src=\"%ADDPNG files/busyhist.png%\" type=\"image/png\">\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);
--- /dev/null
+#!/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 .= "<img width=\"700\" height=\"265\" src=\"%ADDPNG files/datarate.png%\" type=\"image/png\">\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);
+
+
--- /dev/null
+#!/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")
+ }
+}
--- /dev/null
+#!/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 \\<E\\> $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 \\<E\\> $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 \\<E\\> $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 \\<E\\> $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 \\<E\\> $other_longtext") unless (($timecnt->{oth}++)%$loggerperiod);
+ }
+ else {$timecnt->{oth} = 0;}
+
+ sleep(5);
+}
--- /dev/null
+#!/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 .= "<img width=\"700\" height=\"365\" src=\"%ADDPNG files/eventratehist.png%\" type=\"image/png\">\n";
+$str .= Hmon::MakeFooter();
+Hmon::WriteFile("eventrate",$str);
+
+$str = Hmon::MakeTitle(9,7,"Event Rates",0);
+#$str .= "\n#ADDFILE files/eventratehist.svg\n";
+$str .= "<img width=\"700\" height=\"315\" src=\"%ADDPNG files/eventratehistlong.png%\" type=\"image/png\">\n";
+$str .= Hmon::MakeFooter();
+Hmon::WriteFile("eventratelong",$str);
+
+$str = Hmon::MakeTitle(9,8,"Event Rates",0);
+#$str .= "\n#ADDFILE files/eventratehist.svg\n";
+$str .= "<img width=\"700\" height=\"365\" src=\"%ADDPNG files/eventratehistshort.png%\" type=\"image/png\">\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);
+ }
+ }
+
--- /dev/null
+#!/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
--- /dev/null
+#!/usr/bin/perl -w
+
+use Hmon;
+
+my $str;
+
+ $str = Hmon::MakeTitle(6,6,"GbE Data Rates",0);
+# $str .= "<embed width=\"460\" height=\"265\" src=\"files/gberate.svg\" type=\"image/svg+xml\" alt=\"Sorry, Image comes back in few seconds...\">\n";
+# $str .= "\n#ADDFILE files/gberate.svg\n";
+ $str .= "<img width=\"460\" height=\"265\" src=\"%ADDPNG files/gberate.png%\" type=\"image/png\">\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 &');
+
+
+#
--- /dev/null
+#!/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<scalar @PlotBufArr;$i++) {
+ if($single) {
+ print $fh $PlotBufArr[$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 <<EHELP;
+ hadplot plots values...
+ --------------------------------------------
+ Usage: hadplot [-d int] [-n int] [-o int]
+ \t\t [-a int -r int -w int -p int [-m int] [-t str]]*
+ \t\t [-output str] [-windowname str] [-(no)key] [-g geometry] [-z style]
+ \t\t [-curvestyle str] [-curveoption str] [-plotoption str]
+ \t\t [-xscale int] [-xmax int] [-xtitle str] [-(no)xticks] [-(no)xgrid] [-xoverflow float]
+ \t\t [-yscale int] [-ymax int] [-ytitle str] [-(no)yticks] [-(no)ygrid] [-yoverflow float]
+ \t\t command
+
+Options:
+ command One of the commands listed below
+ -d delay Time to sleep between readings in milliseconds
+ -n samples Number of samples to store / display in histogram
+ -d downscaling Replot histogram only every nth iteration
+ -g geometry Size of the plot window in pixels
+ -a address Board address when using generic option
+ -p register Register address when using generic option
+ -w regwidth Width in bits of the value to plot
+ -r regoffset Offset of the value to plot in the register
+ -z style Selects one of the possible styles (deprecated)
+ -output expects a string "(PNG|SVG).\$filename.\$xsize.\$ysize" to write to a file
+ -windowname Name of window (shown in titlebar after "Hadplot - "
+ -timeref In a differential plot, the endpoint with this addressis used for timestamping
+ -(x|y)scale Scaling factor, the x/y values are divided by
+ -(x|y)max Maximal value for x/y axis
+ -(x|y)title Label for axes
+ -xistime Marks x axis as containing time stamps (used for formatting)
+ -(no)(x|y)ticks Switches tick marks on axes on or off (e.g. OEP addresses / values)
+ -(no)(x|y)grid Switches grid lines on or off
+ -(x|y)overflow The value at which the register content has an overflow
+ -ydiff Plot differences of register contents on y-axis
+ -(no)key Show key for all plots
+ -curvestyle Plot type: points, histo, histostacked, steps
+ -curveoption Additional options given to the plot command (per curve)
+ -plotoption Additional commands given to gnuplot
+
+EHELP
+
+
+ print "\nAvailable commands:\n";
+ print "\thelp\t\tPrints this message\n";
+ print "\trpcdatarate\tNumber of sent and received data words (RPC only)\n";
+ print "\toeptemp\t\tDisplays temperatures (OEP only)\n";
+ print "\toep5V\t\tShows the input and output voltages of 5V (OEP only)\n";
+ print "\toep3.3V\t\tShows the input and output voltages of 3.3V (OEP only)\n";
+ print "\toep1.2V\t\tShows the input and output voltages of 1.2V (OEP only)\n";
+ print "\toep3V\t\tShows the input voltages of +-3V (OEP only)\n";
+ print "\tdatarate\tshows a histogram of data rates\n";
+ print "\teventrate\tHistogram of the trigger rate\n";
+ print "\tbusytime\tHistogram of busy times\n";
+ print "\tbusy\t\tBargraph of busy times\n";
+ print "\tfilllevel\tFill level of data buffers in all endpoints\n";
+ print "\toepfill\t\tFill level of OEP buffers\n";
+ print "\tshowerfill\tFill level of Shower buffers\n";
+ print "\toepspikehist\tSpike histogram of OEP CMS input\n";
+ print "\toepworktime\tStatistics about states of the OEP trigger handler\n";
+ print "\toeptrgerr\tNumbers of errors on CMS for indivual OEP\n";
+ print "\toeptrgerrhist\tHistory of errors on CMS of OEP\n";
+ print "\toepretr\t\tRetransmission statistics for individual OEP\n";
+ print "\toepretrhist\tHistory of retransmissions on OEP\n";
+ print "\toeptokenmiss\tNumber of missing tokens on OEP\n";
+ print "\toepwords\t\tNumber of data words sent by OEP\n";
+ print "\tmdcchannel\tData counters per TDC channel for MDC\n";
+ print "\tmdcchanneldiff\tdata counters per TDC channel for MDC, changes only\n";
+ print "\tgberate\t\tAmount of data sent by GbE links\n";
+ print "\ttimecmslvl1\tTime between CMS and LVL1 trigger on OEP\n";
+# print "\t\t\n";
+
+ print "\n";
+ print "\treg\t\tPrint any specified register from addressed boards\n";
+ print "\tregdiff\t\tPrint the changes of any specified register from addressed boards\n";
+ print "\thist\t\tShows a histogram of the specified value \n";
+ print "\thistdiff\tShows a histogram of the changes of the specified value\n";
+ print "\n\n";
+ }
+
+
+
+#################################################
+# Generic Register
+#################################################
+sub bitmap {
+ my ($delay,$address,$register,$regamount,$regoff,$regwidth,$title,$style,$name) = @_;
+ $style = 0 unless defined $style;
+ for(my $i = 0; $i<scalar(@{$address});$i++) {
+# if(!(defined($title->[$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<scalar(@{$address});$i++) {
+# plot_write("'-' using 1:2 with points pt 5 title \"$title->[$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<scalar(@{$address});$i++) {
+ plot_write("'-' with points pt 5 ps 1 title \"$title->[$i]\" ",1); #using 2:xticlabels(1)
+ plot_write(", ",1) unless $i == scalar(@{$address})-1;
+ }
+ plot_write("");
+# }
+ while(1) {
+ for(my $i = 0; $i<scalar(@{$address});$i++) {
+ my $c;
+ if ($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;
+ 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<scalar(@{$address});$i++) {
+ plot_write("'-' ",NONEWLINE);
+ if($xticks) {
+ plot_write("using 2:xticlabels(1) ",NONEWLINE);
+ }
+ if(($curvestyle =~ /histo/)) {
+ plot_write("with histograms lt rgb \"$color[$i]\" title \"$title->[$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<scalar(@{$address});$i++) {
+ my $c;
+ my $cnt;
+ if (!(defined $regamount->[$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<scalar(@{$address});$i++) {
+ $storearr{$i} = {};
+ store_init($storearr{$i},$samples,DIFFX,$ydiff,$delay,$downscale,$xoverflow->[$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<scalar(@{$address});$i++) {
+ $val = 0;
+ my $c = "trbcmd rt $address->[$i] $register->[$i] | sort";
+ my @out = qx($c);
+ $time += $delay;
+ foreach my $o (@out) {
+ if (($a,$s,$t) = $o =~ /^0x(\w{4})\s*0x(\w{8})\s*0x(\w{4})/) {
+ $val += ((hex($s)>>($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 = <FTRB>) {
+ 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);
+ }
+
--- /dev/null
+#!/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<scalar @PlotBufArr;$i++) {
+ if($single) {
+ print $fh $PlotBufArr[$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 <<EHELP;
+ hadplot plots values...
+ --------------------------------------------
+ Usage: hadplot [-d int] [-n int] [-o int]
+ \t\t [-a int -r int -w int -p int [-m int] [-t str]]*
+ \t\t [-output str] [-windowname str] [-(no)key] [-g geometry] [-z style]
+ \t\t [-curvestyle str] [-curveoption str] [-plotoption str]
+ \t\t [-xscale int] [-xmax int] [-xtitle str] [-(no)xticks] [-(no)xgrid] [-xoverflow float]
+ \t\t [-yscale int] [-ymax int] [-ytitle str] [-(no)yticks] [-(no)ygrid] [-yoverflow float]
+ \t\t command
+
+Options:
+ command One of the commands listed below
+ -d delay Time to sleep between readings in milliseconds
+ -n samples Number of samples to store / display in histogram
+ -d downscaling Replot histogram only every nth iteration
+ -g geometry Size of the plot window in pixels
+ -a address Board address when using generic option
+ -p register Register address when using generic option
+ -w regwidth Width in bits of the value to plot
+ -r regoffset Offset of the value to plot in the register
+ -z style Selects one of the possible styles (deprecated)
+ -output expects a string "(PNG|SVG).\$filename.\$xsize.\$ysize" to write to a file
+ -windowname Name of window (shown in titlebar after "Hadplot - "
+ -timeref In a differential plot, the endpoint with this addressis used for timestamping
+ -(x|y)scale Scaling factor, the x/y values are divided by
+ -(x|y)max Maximal value for x/y axis
+ -(x|y)title Label for axes
+ -xistime Marks x axis as containing time stamps (used for formatting)
+ -(no)(x|y)ticks Switches tick marks on axes on or off (e.g. OEP addresses / values)
+ -(no)(x|y)grid Switches grid lines on or off
+ -(x|y)overflow The value at which the register content has an overflow
+ -ydiff Plot differences of register contents on y-axis
+ -(no)key Show key for all plots
+ -curvestyle Plot type: points, histo, histostacked, steps
+ -curveoption Additional options given to the plot command (per curve)
+ -plotoption Additional commands given to gnuplot
+
+EHELP
+
+
+ print "\nAvailable commands:\n";
+ print "\thelp\t\tPrints this message\n";
+ print "\trpcdatarate\tNumber of sent and received data words (RPC only)\n";
+ print "\toeptemp\t\tDisplays temperatures (OEP only)\n";
+ print "\toep5V\t\tShows the input and output voltages of 5V (OEP only)\n";
+ print "\toep3.3V\t\tShows the input and output voltages of 3.3V (OEP only)\n";
+ print "\toep1.2V\t\tShows the input and output voltages of 1.2V (OEP only)\n";
+ print "\toep3V\t\tShows the input voltages of +-3V (OEP only)\n";
+ print "\tdatarate\tshows a histogram of data rates\n";
+ print "\teventrate\tHistogram of the trigger rate\n";
+ print "\tbusytime\tHistogram of busy times\n";
+ print "\tbusy\t\tBargraph of busy times\n";
+ print "\tfilllevel\tFill level of data buffers in all endpoints\n";
+ print "\toepfill\t\tFill level of OEP buffers\n";
+ print "\tshowerfill\tFill level of Shower buffers\n";
+ print "\toepspikehist\tSpike histogram of OEP CMS input\n";
+ print "\toepworktime\tStatistics about states of the OEP trigger handler\n";
+ print "\toeptrgerr\tNumbers of errors on CMS for indivual OEP\n";
+ print "\toeptrgerrhist\tHistory of errors on CMS of OEP\n";
+ print "\toepretr\t\tRetransmission statistics for individual OEP\n";
+ print "\toepretrhist\tHistory of retransmissions on OEP\n";
+ print "\toeptokenmiss\tNumber of missing tokens on OEP\n";
+ print "\toepwords\t\tNumber of data words sent by OEP\n";
+ print "\tmdcchannel\tData counters per TDC channel for MDC\n";
+ print "\tmdcchanneldiff\tdata counters per TDC channel for MDC, changes only\n";
+ print "\tgberate\t\tAmount of data sent by GbE links\n";
+ print "\ttimecmslvl1\tTime between CMS and LVL1 trigger on OEP\n";
+ print "\tslowcontrolrate\tData rate on slow control channel\n";
+# print "\t\t\n";
+
+ print "\n";
+ print "\treg\t\tPrint any specified register from addressed boards\n";
+ print "\tregdiff\t\tPrint the changes of any specified register from addressed boards\n";
+ print "\thist\t\tShows a histogram of the specified value \n";
+ print "\thistdiff\tShows a histogram of the changes of the specified value\n";
+ print "\n\n";
+ }
+
+
+
+#################################################
+# Generic Register
+#################################################
+sub bitmap {
+ my ($delay,$address,$register,$regamount,$regoff,$regwidth,$title,$style,$name) = @_;
+ $style = 0 unless defined $style;
+ for(my $i = 0; $i<scalar(@{$address});$i++) {
+# if(!(defined($title->[$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<scalar(@{$address});$i++) {
+# plot_write("'-' using 1:2 with points pt 5 title \"$title->[$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<scalar(@{$address});$i++) {
+ plot_write("'-' with points pt 5 ps 1 title \"$title->[$i]\" ",1); #using 2:xticlabels(1)
+ plot_write(", ",1) unless $i == scalar(@{$address})-1;
+ }
+ plot_write("");
+# }
+ while(1) {
+ for(my $i = 0; $i<scalar(@{$address});$i++) {
+ my $c;
+ if ($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;
+ 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<scalar(@{$address});$i++) {
+ plot_write("'-' ",NONEWLINE);
+ if($xticks) {
+ plot_write("using 2:xticlabels(1) ",NONEWLINE);
+ }
+ if(($curvestyle =~ /histo/)) {
+ plot_write("with histograms lt rgb \"$color[$i]\" title \"$title->[$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<scalar(@{$address});$i++) {
+ my $c;
+ if (!(defined $regamount->[$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<scalar(@{$address});$i++) {
+ $storearr{$i} = {};
+ store_init($storearr{$i},$samples,DIFFX,$ydiff,$delay,$downscale,$xoverflow->[$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<scalar(@{$address});$i++) {
+ $val = 0;
+ my $c = trb_registertime_read($address->[$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 = <FTRB>) {
+ 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);
+ }
+
--- /dev/null
+#!/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);
+
+ }
--- /dev/null
+#!/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 \\<W\\> MBO %s might be locked up", $boardstring);
+ $msg = " MDC \\<W\\> 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;
+}
+
--- /dev/null
+#!/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]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$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;
+}
+
--- /dev/null
+#!/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
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/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]."<p>".$str[1][0].$str[1][1]."<p>".$str[1][2]."<p>".$str[1][3].$str[2][0]);
+
+
+
--- /dev/null
+#!/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]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$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;
+}
+
--- /dev/null
+#!/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
--- /dev/null
+#!/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] .= "</div>\n";
+ }
+
+ Hmon::WriteFile("MDCRetransmissionRate",
+ $str[0][4]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$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] .= "</div>\n";
+ }
+
+ Hmon::WriteFile("MDCRetransmission",
+ $str[0][4]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$str[1][3].$str[2][0]);
+
+
+ sleep 1;
+}
+
+
--- /dev/null
+#!/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]."<p>".$str[1][0].$str[1][1]."<p>".$str[1][2]."<p>".$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;
+}
--- /dev/null
+#!/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]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$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;
+}
+
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use POSIX qw(strftime);
+use Hmon;
+
+
+
+my $title = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+ <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <!--<meta http-equiv="refresh" content="60"/>-->
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+ <link href="../files/indexstyles.css" rel="stylesheet" type="text/css"/>
+ <title>Hmon MDC HV Trends</title>
+ </head>
+ <body class="index" style="position:relative;background:#d8e8f8;width:850px;margin:auto;padding:120px 0 40px 0">
+ <div style="position:fixed;left:0;top:0;width:100%;height:40px;background:#d8e8f8;box-shadow:none;"></div>
+ <h1 style="position:fixed;top:5px;left:0px;width:100%;display:block;text-align:center;margin:26px 0 0px 0">Hmon MDC HV Trends</h1>
+ <div style="position:fixed;left:10px;top:30px;background:#346;padding:10px;margin:-22px 5px 5px 15px;"><img style="background:white;padding:6px 0 6px 0;" src = "../doc/background.png" width=84></div>
+ <div style="position:fixed;right:10px;top:30px;float:right;background:#346;padding:10px;margin:-22px 15px 5px 5px;"><img src = "../doc/link.png" width=84 height=84></div>
+ $;
+
+my $foot = qq$
+ </div>
+ </body>
+ </html>$;
+
+my $out = $title;
+
+foreach my $i (0..3) {
+ $out .= "<h4>Plane ".($i+1)."</h4>";
+ $out .= qq%Sector 1<br><img src="MDCHVP%.$i.qq%S0V.png"> <img src="MDCHVP%.$i.qq%S0I.png"><br>%;
+ $out .= qq%Sector 2<br><img src="MDCHVP%.$i.qq%S1V.png"> <img src="MDCHVP%.$i.qq%S1I.png"><br>%;
+ $out .= qq%Sector 3<br><img src="MDCHVP%.$i.qq%S2V.png"> <img src="MDCHVP%.$i.qq%S2I.png"><br>%;
+ $out .= qq%Sector 4<br><img src="MDCHVP%.$i.qq%S3V.png"> <img src="MDCHVP%.$i.qq%S3I.png"><br>%;
+ $out .= qq%Sector 5<br><img src="MDCHVP%.$i.qq%S4V.png"> <img src="MDCHVP%.$i.qq%S4I.png"><br>%;
+ $out .= qq%Sector 6<br><img src="MDCHVP%.$i.qq%S5V.png"> <img src="MDCHVP%.$i.qq%S5I.png"><br>%;
+ }
+
+my $fh;
+open ($fh,"> ".Hmon::HMONDIR."/files/MDCHVtrends.htm") or die;
+print $fh $out;
--- /dev/null
+#!/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@<br>Offset: $offset@.qq@s - Binning: $binning@.qq@s<img src="%ADDPNG files/muxhist.png%" type="image/png">@;
+ $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 &
+
+ );
+ }
+
--- /dev/null
+#!/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@<br>Offset: $offset@.qq@s - Binning: $binning@."s (20 bins skipped at beginning of spill)";
+
+$str .= qq@<img src="%ADDPNG files/CtsMuxRatio.png%" type="image/png">@;
+$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);
+ }
--- /dev/null
+#!/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\"' </dev/null";
+ my @out = qx($cmd);
+
+
+ if($timecnt == 0) {
+ $qastate = QA::OK;
+ }
+ $timecnt++ if $timecnt < 0;
+ $timecnt = 0 if $qastate <= 30;
+
+ $longmsg = "QA server was restarted recently - check if client is still connected." if $qastate == QA::WARN_2;
+
+ unless(scalar @out > 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 <E> Online QA Server not found'");
+ Hmon::Speak("qa","QA server crashed.");
+ $qastate = QA::WARN_2;
+ $timecnt = -4;
+ }
+
+
+ sleep 9;
+}
--- /dev/null
+#!/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 .= "<table class=\"rates\">\n";
+ $str .= "<tr><th style=\"width:80px\"><th>1<th>2<th>3<th>4<th>5<th>6<th>7<th>8\n";
+ $str .= "<tr><th>Start in";
+
+ my $i;
+ foreach $i (0, 1, 2, 3, 4, 5, 6, 7) {
+ $str .= sprintf("<td class=\"%s\">%d", ($ena & ( 1<< $i)) ? "on" : "off",
+ $store{0xa008+$i});
+ }
+ $str .= "<tr class=\"linebelow\"><th>Veto in";
+ foreach $i (8, 9, 10, 11, 12, 13, 14, 15) {
+ $str .= sprintf("<td class=\"%s\">%d", ($ena & (1 << $i)) ? "on" : "off",
+ $store{0xa008+$i});
+ }
+
+ $str .= "<tr><th>TOF in";
+ foreach $i (16, 17, 18, 19, 20, 21) {
+ $str .= sprintf("<td class=\"%s\">%d", ($ena & (1 << $i)) ? "on" : "off",
+ $store{0xa008+$i});
+ }
+ $str .= "<td>--<td>--";
+ $str .= "<tr><th>RPC in";
+ foreach $i (22, 23, 24, 25, 26, 27) {
+ $str .= sprintf("<td class=\"%s\">%d", ($ena & (1 << $i)) ? "on" : "off",
+ $store{0xa008+$i});
+ }
+ $str .= "<td>--<td>--";
+ $str .= "<tr class=\"linebelow\"><th>Mult out";
+ foreach $i (2, 3, 4, 5, 6, 7) {
+ $str .= sprintf("<td class=\"%s\">%d", ($eno & (1<<($i))) ? "on" : "off",
+ $store{0xa03f+$i});
+ }
+ $str .= "<td>--<td>--";
+
+ $str .= "<tr><th>PT in";
+ foreach $i (28, 29, 30, 31, 32, 33, 34, 35) {
+ $str .= sprintf("<td class=\"%s\">%d", ($ena & (1 << $i)) ? "on" : "off",
+ $store{0xa008+$i});
+ }
+ $str .= "<tr><th>PT dsc";
+ foreach $i (11, 12, 13, 14, 15, 16, 17, 18) {
+ $str .= sprintf("<td class=\"%s\">%d","on",$store{0xa02c+$i});
+ }
+ $str .= "<tr><th>PT coin";
+ foreach $i (9,10,11, 12, 13, 14, 15, 16) {
+ $str .= sprintf("<td class=\"%s\">%d","on",$store{0xa052+$i});
+ }
+ $str .= "<tr class=\"linebelow\"><th>PT out";
+ foreach $i (11, 12, 13, 14, 15, 16, 17, 18) {
+ $str .= sprintf("<td class=\"%s\">%d", ($eno & (1 << $i)) ? "on" : "off",
+ $store{0xa03f+$i});
+ }
+ $str .= "<tr><th>Pulser";
+ $str .= sprintf("<td class=\"%s\">%d", ($store{0xa0e3}) ? "on" : "off",
+ ($store{0xa0e3}) ? 1/$store{0xa0e3} * 2E8 : 0);
+ $str .= "<td>--";
+ $str .= sprintf("<td class=\"%s\">MDC Calib.",
+ ($store{0xa0c0} &0x20) ? "on" : "off");
+ $str .= sprintf("<td class=\"%s\">SHW Calib.",
+ ($store{0xa0c0} &0x100) ? "on" : "off");
+ $str .= sprintf("<td class=\"%s\">SHW Ped.",
+ ($store{0xa0c0} & 0x80) ? "off" : "on");
+ $str .= sprintf("<td class=\"%s\">Status",
+ ($store{0xa0c0}& 0x200)?"on":"off");
+ $str .= "<td>--<td>--";
+ $str .= "<tr><th>Out<td><td><td><td><td><td><td>";
+ $str .= sprintf("<td class=\"%s\"><b>%d</b>",
+ ($store{0xa001}) ? "on" : "off", $store{0xa001});
+ $str .= "</table>\n";
+ $str .= Hmon::MakeFooter();
+
+ Hmon::WriteFile("CTSRates", $str);
+
+
+ sleep 1;
+}
+
+
--- /dev/null
+#!/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
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/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@<img src="%ADDPNG files/EvtsPerSpill.png%" type="image/png">@;
+ $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);
+ }
+}
--- /dev/null
+#!/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
+ <br><img src="%ADDPNG files/starthistx0.png%" type="image/png">
+ <img src="%ADDPNG files/starthisty0.png%" type="image/png">
+ @;
+ $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
+ <br><img src="%ADDPNG files/starthiststackedx0.png%" type="image/png">
+ <img src="%ADDPNG files/starthiststackedy0.png%" type="image/png">
+ @;
+ $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 &
+
+ );
+ }
+
--- /dev/null
+#!/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 .= "<table>\n"; #outer frame
+ $str .= "<tr><td>Summary from histograms</td><td>Scalers</td><td>Veto</td></tr>\n<tr><td>";
+ $str .= "<table class=\"rates\">\n";
+ $str .= "<tr><td></td><td>Last spill</td><td>L.b.o. spill</td></tr>\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 .= "<tr><td>" . $reg_href->{$rh_address}->{'text'} . "</td><td> ";
+ } else {
+ $str .= "<tr><td>" . $rh_address . "</td><td> ";
+ }
+
+
+ if (defined $reg_href->{$rh_address}->{'last_spill_value'}) {
+ $str .= convertNumber($reg_href->{$rh_address}->{'last_spill_value'});
+ if ($maximum > 0) {
+ $str .= "<br><div style='width:" . 80*$reg_href->{$rh_address}->{'last_spill_value'} / $maximum
+ . "px;height:15px;background-color:#FFC1CC;margin-top:-15px'></div>";
+ } else {
+ $str .= "<br><div style='width:0px;height:15px;background-color:#FFC1CC;margin-top:-15px'></div>";
+ }
+ } 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 .= " </td><td style='background:red;'> ";
+ } 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 .= " </td><td style='background:yellow;'> ";
+ } else {$str .= " </td><td>";}
+ $str .= convertNumber($reg_href->{$rh_address}->{'lastlast_spill_value'});
+ } else {$str .= " </td><td>0";}
+ } else {$str .= " </td><td>---";}
+
+
+# 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 .= " </td><td style='background:red;'> ";
+# } 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 .= " </td><td style='background:yellow;'> ";
+# } else {$str .= " </td><td>";}
+# $str .= $reg_href->{$rh_address}->{'last_spill_value'};
+# } else {$str .= " </td><td>";}
+
+ $str .= " </td></tr>\n";
+ }
+ }
+ $str .= "<tr class=\"linebelow\"></tr>\n";
+ }
+ $str .= "</table>\n";
+ $str .= "</td><td><table class=\"rates\"><tr><td></td><td>Current value</td><td>Current spill</td><td>Last spill</td></tr>\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 .= "<tr><td>" . $rh_address . "</td><td> ";
+ if (defined $reg_href->{$rh_address}->{'value'}) {
+ $str .= convertNumber($reg_href->{$rh_address}->{'value'});
+ }
+ $str .= " </td><td> ";
+ if (defined $reg_href->{$rh_address}->{'spill_value'}) {
+ $str .= convertNumber($reg_href->{$rh_address}->{'spill_value'});
+ }
+ $str .= " </td><td> ";
+ if (defined $reg_href->{$rh_address}->{'last_spill_value'}) {
+ $str .= convertNumber($reg_href->{$rh_address}->{'last_spill_value'});
+ }
+ $str .= " </td></tr>\n";
+ }
+ }
+ $str .= "<tr class=\"linebelow\"></tr>\n";
+ }
+
+ $str .= "</table></td>";
+
+ #Jureks Veto "GUI" -> no dynamic content possible
+ $str .= "<td><table>";
+ $str .= "<tr><td style='width:60px;height:70px;background:#FFF0F5;'>";
+ if (defined $reg_href->{'Veto_5'}->{'value'}) {
+ $str .= $reg_href->{'Veto_5'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch5</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_5'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+ }
+ $str .= " </td><td style='width:60px;'></td><td style='width:60px;'>\n";
+ $str .= " </td><td style='width:60px;'></td><td style='width:60px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_6'}->{'value'}) {
+ $str .= $reg_href->{'Veto_6'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch6</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_6'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+ }
+ $str .= " </td>\n";
+ $str .= "</tr>";
+ ##########
+ $str .= "<tr><td style='width:60px;height:70px;'>";
+ $str .= " </td><td style='width:60px;'></td><td style='width:60px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_1'}->{'value'}) {
+ $str .= $reg_href->{'Veto_1'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch1</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_1'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+ }
+ $str .= " </td><td style='width:60px;'></td><td style='width:60px;'>\n";
+ $str .= " </td>\n";
+ $str .= "</tr>";
+ ##########
+ $str .= "<td style='width:60px;height:70px;'></td><td style='width:60px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_4'}->{'value'}) {
+ $str .= $reg_href->{'Veto_4'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch4</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_4'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+
+ }
+ $str .= "</td><td></td><td style='width:60px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_2'}->{'value'}) {
+ $str .= $reg_href->{'Veto_2'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch2</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_2'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+
+ }
+ $str .= "</td><td></td></tr>\n";
+ ########################
+ $str .= "<tr><td style='width:60px;height:70px;'>";
+ $str .= " </td><td></td><td style='width:60px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_3'}->{'value'}) {
+ $str .= $reg_href->{'Veto_3'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch3</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_3'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+
+ }
+ $str .= " </td><td></td><td>\n";
+ $str .= " </td>\n";
+ $str .= "</tr>";
+ ########################
+ $str .= "<tr><td style='width:60px;height:70px;background:#FFF0F5;'>";
+ if (defined $reg_href->{'Veto_8'}->{'value'}) {
+ $str .= $reg_href->{'Veto_8'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch8</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_8'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+
+ }
+ $str .= " </td><td></td><td>\n";
+ $str .= " </td><td></td><td style='width:60px;height:70px;background:#FFF0F5;'>\n";
+ if (defined $reg_href->{'Veto_7'}->{'value'}) {
+ $str .= $reg_href->{'Veto_7'}->{'value'} . "<br><div style='background:#FFE4E1;'>ch7</div>";
+ 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 .= "<br><div style='width:" . 60 * $reg_href->{'Veto_7'}->{'value'}/$reg_href->{'Total_Veto'}->{'value'} .
+ "px;height:8px;background-color:red;'></div>";
+ } else {$str .= "---";}
+
+ }
+ $str .= " </td>\n";
+ $str .= "</tr>";
+ ########################
+
+
+ $str .= "</table><td>";
+
+ #end GUI
+
+ $str .= "</tr>\n";
+
+ if ($spill_on == 0) {
+ $str .= "<td colspan=3 style='background-color:red;'> Spill Off</td>";
+ }
+
+ $str .= "</table>\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 <name>] : Etrax board name.
+ [-t|--type <dec|abs>] : Print values of registers in dec(%) or absolute (default: dec).
+ [-f|--fpga] : Program FPGA before reading registers.
+ [-a|--addr <address>] : 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;
+ }
--- /dev/null
+#!/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 <E> Timeouts found: $msg'")
+ if $msg ne "" && $logcnt++ < 50;
+
+ sleep 3;
+}
--- /dev/null
+#!/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 <I> TRB TDC $longmsg'");
+ }
+
+
+
+ sleep 3;
+}
--- /dev/null
+#!/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] .= "</div>\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]."<p>".$str[1][0].$str[1][1]."<p>".
+ $str[1][2]."<p>".$str[1][3].$str[2][0]);
+
+ %laststore2 = %store2;
+ sleep 1;
+}
+
+
--- /dev/null
+#!/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@<img src="%ADDPNG files/StartCountSpills.png%" type="image/png">@;
+ $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@<img src="%ADDPNG files/Pt3AcceptRatio.png%" type="image/png">@;
+ $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 <I> $longmsg'");
+ }
+
+
+ $lastlongmsg = $longmsgcheck;
+
+
+ sleep 1;
+}
--- /dev/null
+#!/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<img src="%ADDPNG files/vetohist.png%" type="image/png">@;
+ $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 &
+
+ );
+ }
+
--- /dev/null
+#!/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
--- /dev/null
+#!/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();
--- /dev/null
+#!/bin/sh
+
+while true; do /home/hadaq/trbsoft/daq/tools/hmon/icingadaemon.pl; sleep 10; done
--- /dev/null
+#!/usr/bin/perl -w
+use CGI::Carp qw(fatalsToBrowser);
+
+
+print "Content-type: text/html\r\n\r\n";
+
+
+print qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Monitoring Main Control Interface</title>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<link href="files/indexstyles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body class="index" style="position:relative;background:#d8e8f8;width:750px;margin:auto;padding:120px 0 40px 0">
+<script type="text/javascript">
+function openwin(url) {
+ win = window.open(url,"window1","width=600,height=400,scrollbars=no,status=no,location=no,menubar=no,resizable=no,titlebar=no");
+ win.focus();
+ }
+</script>
+<div style="position:fixed;left:0;top:0;width:100%;height:40px;background:#d8e8f8;box-shadow:none;"></div>
+<h1 style="position:fixed;top:5px;left:0px;width:100%;display:block;text-align:center;margin:26px 0 0px 0">HADES DAQ Monitoring</h1>
+<div style="position:fixed;left:10px;top:30px;background:#346;padding:10px;margin:-22px 5px 5px 15px;"><img style="background:white;padding:6px 0 6px 0;" src = "doc/background.png" width=84></div>
+<div style="position:fixed;right:10px;top:30px;float:right;background:#346;padding:10px;margin:-22px 15px 5px 5px;"><img src = "doc/link.png" width=84 height=84></div>
+
+
+
+<div class="linkbox" style="width:730px;"><h4>Main</h4><ul>
+<li style="width:600px;"><a href="monitor.cgi?1-window-QA" style="color:#d33">Tactical Overview (the central screen)</a></li>
+<li style="width:600px;"><a href="monitor.cgi?3-window-logfile">Logfile (most important messages)</a></li>
+<li style="width:600px;"><a href="monitor.cgi?10-window-chat">Chat Log</a></li>
+</ul></div>
+
+<div class="linkbox" style="width:730px;"><h4>Other Ressources</h4><ul>
+<li style="width:600px;"><a href="files/qa.htm">QA Plots (updated every 5 minutes)</a></li>
+<li style="width:500px;"><a href="files/vertex.htm">Vertex Plots (updated after each file)</a></li>
+<li style="width:500px;"><a href="http://webdb.gsi.de/pls/hades_webdbs/hades_oper.hlogbook2.form_selection">Beamtime Logbook</a></li>
+<li style="width:500px;"><a href="http://hadesdaq02/icinga">Icinga Server Monitoring</a></li>
+<li style="width:500px;"><a href="archive">Archive of Hmon Windows (updated every 10 minutes)</a></li>
+</ul></div>
+
+<div class="linkbox" style="clear:both"><h4>DAQ Network</h4><ul>
+<li><a href="monitor.cgi?1-window-hubmon">Hub Monitor</a></li>
+<li><a href="monitor.cgi?1-window-busy">Busy times of subsystems</a></li>
+<li><a href="monitor.cgi?2-window-busyhist">Histogram of busy times</a></li>
+<li><a href="monitor.cgi?2-window-GbeRate">Data amount on GbE</a></li>
+<li><a href="monitor.cgi?2-window-datarate">Data rate histogram</a></li>
+</ul></div>
+
+<div class="linkbox" style="float:right"><h4>Trigger</h4><ul>
+<li><a href="monitor.cgi?1-window-CTSRates">Rates on CTS Trigger I/O</a></li>
+<li><a href="monitor.cgi?1-window-eventrateshort">Eventrate histogram (10s)</a></li>
+<li><a href="monitor.cgi?1-window-eventrate">Eventrate histogram (60s)</a></li>
+<li><a href="monitor.cgi?5-window-eventratelong">Eventrate histogram (10m)</a></li>
+<li><a href="monitor.cgi?10-window-StartCountSpill">Start counts per spill</a></li>
+<li><a href="monitor.cgi?10-window-Pt3AcceptRatio">Ratio of accepted PT3 per spill</a></li>
+<li><a href="monitor.cgi?10-window-EvtsPerSpill">Recorded events per spill</a></li>
+<li><a href="monitor.cgi?5-window-Starthist">Start hit count histograms</a></li>
+<li><a href="monitor.cgi?5-window-Vetohist">Veto hit count histograms</a></li>
+<li><a href="monitor.cgi?5-window-Muxhist">CTS mux output histograms</a></li>
+<li><a href="monitor.cgi?5-window-CtsMuxRatio">CTS mux output ratio histo.</a></li>
+</ul></div>
+
+
+<div class="linkbox"><h4>MDC</h4><ul>
+<li><a href="monitor.cgi?10-MDCRates-MDCBusy-MDCTemperature-MDCRetransmission-MDCTriggerError-MDCTokenMiss">MDC Overview</a></li>
+<li><a href="monitor.cgi?2-window-MDCBusy">MDC Busy Times</a></li>
+<li><a href="monitor.cgi?2-window-MDCRates">MDC Data Rates</a></li>
+<li><a href="monitor.cgi?2-window-MDCTokenMiss">MDC Missing Tokens</a></li>
+<li><a href="monitor.cgi?2-window-MDCRetransmission">MDC Retransmission</a></li>
+<li><a href="monitor.cgi?10-window-MDCTemperature">MDC Temperature</a></li>
+<li><a href="monitor.cgi?2-window-MDCTriggerError">MDC Trigger Errors</a></li>
+<li><a href="monitor.cgi?10-MDCPressure">MDC Gas System Pressures</a></li>
+<li><a href="monitor.cgi?2-window-MDCLV">MDC LV switch status</a></li>
+</ul></div>
+
+
+
+
+<div class="linkbox" style="float:right"><h4>Eventbuilder</h4><ul>
+<li><a href="monitor.cgi?30-window-EBDisks">Fill-level of disks</a></li>
+<li><a href="monitor.cgi?10-window-EBCPU">Server CPU load</a></li>
+<li><a href="monitor.cgi?10-window-hldlast">Last hld files written</a></li>
+</ul></div>
+
+<div class="linkbox"><h4>High Voltage</h4><ul>
+<li><a href="monitor.cgi?10-MDCHV">MDC HV settings</a></li>
+<li><a href="files/MDCHVtrends.htm">MDC HV trend plots</a></li>
+<li><a href="monitor.cgi?1-RichHV">RICH HV settings & currents</a></li>
+</ul></div>
+
+$;
+
+
+print "<h3 style=\"clear:both;padding-top:30px;\">All available options</h3><ul class=\"optionlist\">\n";
+my @o = qx(ls -1 files/*.htt);
+foreach my $a (@o) {
+ if ($a =~ m%files/(\w+).htt%) {
+ print "<li><a href=\"monitor.cgi?2-window-$1\">$1</a></li>\n";</li>
+ }
+ }
+print "</ul><br>\n";
+
+
+print qq$
+<h3 style="padding-top:30px;clear:both">Help</h3>
+To select the information you want to have, specify any number of the options listed below, separated with '-' after the \"monitor.cgi?\".<p/>
+<ul><li>The first option for monitor.cgi may be a number specifying the update rate in seconds.</li>
+<li>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.</li>
+<li>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.</li>
+</ul>
+<h5>Hints</h5>
+<ul><li>Window background will turn red if no update is possible. </li>
+<li>If you see a message "Server Error", press F5. </li>
+<li>If you want to stop updating, press Esc. </li>
+<li>To restart updating, press F5.</li>
+<li>Zoom in and out with Ctrl++ and Ctrl+-, normal zoom with Ctrl+0.</li>
+</ul>
+
+<h5>Examples</h5>
+<ul><li><a href="monitor.cgi?logfile-busy">monitor.cgi?logfile-busy</a></li>
+<li><a href="monitor.cgi?2-PTrates-busy">monitor.cgi?PTrates-busy</a></li>
+<li><a href="monitor.cgi?10-window-MDCRates">monitor.cgi?10-MDCRates</a></li>
+</ul>
+
+</body>
+</html>
+$;
--- /dev/null
+
+
+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
--- /dev/null
+#!/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,"<files/$2.htt");
+ my $str = <$MYF>;
+ close($MYF);
+ $str =~ /width(\d+)\sheight(\d+)/;
+ my $width = 80*$1-8;
+ my $height = 50*$2-8;
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Hmon</title>
+<meta http-equiv="content-type" content="text/html;charset=UTF-8"/>
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body >
+<script type="text/javascript">
+ document.write("Opening Window...<br>");
+ win = window.open("$.$newurl.qq$","Hmon$.$newurl.qq$","name=Hmon,innerwidth=$.$width.qq$,innerheight=$.$height.qq$,scrollbars=no,status=no,location=no,menubar=no,resizable=no,titlebar=no,dialog=no");
+ if(win) {
+ win.focus();
+ win.document.title="Hmon $.$newurl.qq#";
+ history.back();
+ }
+ else {
+ document.write("Can't open pop-up window. Please disable pop-up blocker. Starting monitor inline...");
+ setTimeout('window.location.href = "$newurl"',1000);
+ }
+</script>
+#;
+
+ } else {
+
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<!--<meta http-equiv="refresh" content="$.$delay.qq$"/> -->
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+<title>Hmon $.$ENV{'QUERY_STRING'}.qq$</title>
+</head>
+<body ><!--onmousedown="stoprefresh(0);" onmouseup="stoprefresh(0);" ondblclick="stoprefresh(0);"-->
+<div class="button" style="width:45px;right:-8px;" onclick="askclose();"> close </div>
+<div class="button" id = "stop" style="right:35px;width:45px;" onclick="stoprefresh(1)">stop</div>
+<div class="button" id = "big" style="right:75px;width:45px;" onclick="zoom();"> bigger </div>
+
+<div id="content" class="blinkon"></div>
+$;
+
+
+
+$out .= qq$<script language='javascript'>
+ var reloadevery = setTimeout('reload()',10);
+ var saveScrollTop = 0;
+ blinkcnt = 0;
+ blinking = setInterval("blink()",490);
+ currentzoom = 1;
+
+function zoom() {
+ var zoomstep = 1.5;
+ if (currentzoom == 1) {
+ currentzoom = 1.5;
+ document.getElementById('content').style.MozTransform="scale("+currentzoom+")";
+ window.innerWidth *= zoomstep;
+ window.innerHeight*= zoomstep;
+ document.getElementById("big").innerHTML = "small";
+ }
+ else {
+ currentzoom = 1;
+ document.getElementById('content').style.MozTransform="scale("+currentzoom+")";
+ window.innerWidth /= zoomstep;
+ window.innerHeight/= zoomstep;
+ document.getElementById("big").innerHTML = "bigger";
+ }
+ }
+
+function reload() {
+ xmlhttp=new XMLHttpRequest();
+ xmlhttp.onreadystatechange = function() {
+ if(xmlhttp.readyState == 4) {
+ document.getElementById("content").innerHTML=xmlhttp.responseText;
+ if(document.getElementById('logbox')) {
+ if(saveScrollTop) {
+ document.getElementById('logbox').scrollTop = saveScrollTop;
+ }
+ }
+
+ document.getElementById("stop").style.background="#444";
+ reloadevery = setTimeout('reload()',$.($delay*1000).qq$);
+ }
+ };
+ if(document.getElementById('logbox')) {
+ saveScrollTop = document.getElementById('logbox').scrollTop;
+ if (saveScrollTop == 0) {saveScrollTop = 0.1;}
+ }
+ xmlhttp.open("GET","get.cgi?$.$ENV{'QUERY_STRING'}.qq$",true);
+ xmlhttp.send(null);
+ document.getElementById("stop").style.background="#111";
+ }
+
+function stoprefresh(button) {
+ if(reloadevery) {
+ clearTimeout(reloadevery);
+ reloadevery = false;
+ document.getElementById("stop").style.background="red";
+ document.getElementById("stop").style.color="white";
+ document.getElementById("stop").innerHTML="cont.";
+ }
+ else {
+ document.getElementById("stop").style.background="#444";
+ document.getElementById("stop").style.color="#aaa";
+ document.getElementById("stop").innerHTML="stop";
+ reload();
+ }
+ return false;
+ }
+
+function askclose() {
+ if(confirm("Close Window?")==true){window.close();}
+ }
+
+function clk(e) {
+ document.getElementById("footer").innerHTML= e.getAttribute("alt");
+ }
+
+function openhelp(w) {
+ x = "doc.cgi?"+w;
+ y = window.open(x,"TacticalOverviewDocumentation","innerwidth=930,innerheight=900,scrollbars=yes,location=yes,menubar=yes,toolbar=yes");
+ y.focus();
+ }
+
+
+
+function blink() {
+ if(blinkcnt&1) {
+ document.getElementById('content').setAttribute("class","blinkoff");
+ }
+ else {
+ document.getElementById('content').setAttribute("class","blinkon");
+ }
+ blinkcnt++;
+ }
+
+</script>$;
+ }
+$out .= qq$
+</body>
+</html>
+$;
+
+print $out;
+
--- /dev/null
+#!/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/<svg/<svg preserveAspectRatio="XMidYMid" /;
+ if($_ =~ m/<\?/) {next;}
+ if($_ =~ m/<!/) {next;}
+ if($_ =~ m/.dtd/) {next;}
+ }
+ $str .= $_;
+ }
+ }
+ return $str;
+ }
+
+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,"<files/$2.htt");
+ my $str = <$MYF>;
+ close($MYF);
+ $str =~ /width(\d+)\sheight(\d+)/;
+ my $width = 80*$1-8;
+ my $height = 50*$2-8;
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Hmon</title>
+<meta http-equiv="content-type" content="text/html;charset=UTF-8"/>
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body >
+<script type="text/javascript">
+ win = window.open("$.$newurl.qq$","$.$newurl.qq$","innerwidth=$.$width.qq$,innerheight=$.$height.qq$,scrollbars=no,status=no,location=no,menubar=no,resizable=no,titlebar=no,dialog=no");
+ win.focus();
+ win.document.title="Hmon $.$newurl.qq$";
+ history.back();
+</script>
+Opening Window.$;
+
+ } else {
+
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<!--<meta http-equiv="refresh" content="$.$delay.qq$"/> -->
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+<title>Hmon $.$ENV{'QUERY_STRING'}.qq$</title>
+</head>
+<body ><!--onmousedown="stoprefresh(0);" onmouseup="stoprefresh(0);" ondblclick="stoprefresh(0);"-->
+<div class="button" style="right:-8px;" onclick="askclose();"> close </div>
+<div class="button" id = "stop" style="right:40px;width:45px;" onclick="stoprefresh(1)"> stop </div>
+<div id="content"></div>
+$;
+
+
+
+$out .= qq$<script language='javascript'>
+// setTimeout('document.body.style.background="#f11"',$.(($delay+1)*1000).qq$);
+// setTimeout('document.getElementById("title").style.background="#f11"',$.(($delay+1)*1000).qq$);
+// var reloadevery = setTimeout('window.location.reload( true )',$.($delay*1000).qq$);
+ var reloadevery = setTimeout('reload()',10);
+ blinkcnt = 0;
+ blinking = setInterval("blink()",490);
+
+
+// reload();
+
+function reload() {
+ xmlhttp=new XMLHttpRequest();
+ xmlhttp.onreadystatechange = function() {
+ if(xmlhttp.readyState == 4) {
+ document.getElementById("content").innerHTML=xmlhttp.responseText;
+ setTimeout(document.getElementById('logbox').scrollTop = document.getElementById('logbox').scrollHeight,1);
+ clearInterval(blinking);
+ blinking = setInterval("blink(0)",490);
+ reloadevery = setTimeout('reload()',$.($delay*1000).qq$);
+ }
+ };
+ xmlhttp.open("GET","get.cgi?$.$ENV{'QUERY_STRING'}.qq$",true);
+ xmlhttp.send(null);
+ }
+
+function stoprefresh(button) {
+ if(reloadevery) {
+ clearTimeout(reloadevery);
+ reloadevery = false;
+ document.getElementById("stop").style.background="red";
+ document.getElementById("stop").style.color="white";
+ document.getElementById("stop").innerHTML="cont.";
+ }
+ else {
+ reloadevery = setTimeout('window.location.reload( true )',$.($delay*1000).qq$);
+ document.getElementById("stop").style.background="#444";
+ document.getElementById("stop").style.color="#aaa";
+ document.getElementById("stop").innerHTML="stop";
+ if (button) {
+ window.location.reload( true ) ;
+ }
+ }
+ return false;
+ }
+
+function askclose() {
+ if(confirm("Close Window?")==true){window.close();}
+ }
+
+function clk(e) {
+ document.getElementById("footer").innerHTML= e.getAttribute("alt");
+ }
+
+function openhelp(w) {
+ x = "doc.cgi?"+w;
+ y = window.open(x,"TacticalOverviewDocumentation","innerwidth=930,innerheight=900,scrollbars=yes,location=no,menubar=no");
+ y.focus();
+ }
+
+
+
+function blink() {
+ for(j=0;j<document.getElementsByClassName('brdb').length;j++) {
+ document.getElementsByClassName('brdb')[j].style.background= (blinkcnt&1)?"\#f00":"\#000";
+ document.getElementsByClassName('brdb')[j].style.color = (blinkcnt&1)?"\#000":"\#f33";
+ }
+ blinkcnt++;
+// blinking = setTimeout("blink(blinkcnt)",490);
+ }
+
+</script>$;
+ }
+$out .= qq$
+</body>
+</html>
+$;
+
+print $out;
+
--- /dev/null
+#!/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/<svg/<svg preserveAspectRatio="XMidYMid" /;
+ if($_ =~ m/<\?/) {next;}
+ if($_ =~ m/<!/) {next;}
+ if($_ =~ m/.dtd/) {next;}
+ }
+ $str .= $_;
+ }
+ }
+ return $str;
+ }
+
+my $delay = 10;
+my @args = split('-',$ENV{'QUERY_STRING'});
+
+ if ($args[0] =~ m/^(\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,"<files/$2.htt");
+ my $str = <$MYF>;
+ close($MYF);
+ $str =~ /width(\d+)\sheight(\d+)/;
+ my $width = 80*$1-8;
+ my $height = 50*$2-8;
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Hmon</title>
+<meta http-equiv="content-type" content="text/html;charset=UTF-8"/>
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body >
+<script type="text/javascript">
+ win = window.open("$.$newurl.qq$","$.$newurl.qq$","innerwidth=$.$width.qq$,innerheight=$.$height.qq$,scrollbars=no,status=no,location=no,menubar=no,resizable=no,titlebar=no,dialog=no");
+ win.focus();
+ win.document.title="Hmon $.$newurl.qq$";
+ history.back();
+</script>
+Opening Window.$;
+
+ } else {
+
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<!--<meta http-equiv="refresh" content="$.$delay.qq$"/> -->
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+<title>Hmon $.$ENV{'QUERY_STRING'}.qq$</title>
+</head>
+<body ><!--onmousedown="stoprefresh(0);" onmouseup="stoprefresh(0);" ondblclick="stoprefresh(0);"-->
+<div class="button" style="right:-8px;" onclick="askclose();"> close </div>
+<div class="button" id = "stop" style="right:40px;width:45px;" onclick="stoprefresh(1)"> stop </div>
+<div id="content">
+$;
+
+ $out .= addfile("files/note.htt");
+ foreach my $arg (@args) {
+ if ($arg =~ m/(\w+)/) {
+ $out .= addfile("files/$1.htt");
+ }
+ }
+
+ $out .= qq$</div>
+<script language='javascript'>
+// setTimeout('document.body.style.background="#f11"',$.(($delay+1)*1000).qq$);
+ setTimeout('document.getElementById("title").style.background="#f11"',$.(($delay+1)*1000).qq$);
+ var reloadevery = setTimeout('window.location.reload( true )',$.($delay*1000).qq$);
+
+
+ setTimeout(document.getElementById('logbox').scrollTop = document.getElementById('logbox').scrollHeight,1);
+function stoprefresh(button) {
+ if(reloadevery) {
+ clearTimeout(reloadevery);
+ reloadevery = false;
+ document.getElementById("stop").style.background="red";
+ document.getElementById("stop").style.color="white";
+ document.getElementById("stop").innerHTML="cont.";
+ }
+ else {
+ reloadevery = setTimeout('window.location.reload( true )',$.($delay*1000).qq$);
+ document.getElementById("stop").style.background="#444";
+ document.getElementById("stop").style.color="#aaa";
+ document.getElementById("stop").innerHTML="stop";
+ if (button) {
+ window.location.reload( true ) ;
+ }
+ }
+ return false;
+ }
+
+ function askclose() {
+ if(confirm("Close Window?")==true){window.close();}
+ }$;
+ $out .= "</script>\n";
+ }
+$out .= qq$
+</body>
+</html>
+$;
+
+print $out;
+
--- /dev/null
+../HPlot.pm
\ No newline at end of file
--- /dev/null
+../Hmon.pm
\ No newline at end of file
--- /dev/null
+../Perl2Epics.pm
\ No newline at end of file
--- /dev/null
+../QA.pm
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use POSIX qw(strftime);
+use Data::Dumper;
+
+my $header = qq@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<link href="../../files/styles.css" rel="stylesheet" type="text/css"/>
+<script language='javascript'>
+
+function clk(e) {
+ document.getElementById("footer").innerHTML= e.getAttribute("alt");
+ }
+
+function openhelp(w) {
+ x = "doc.cgi?"+w;
+ y = window.open(x,"TacticalOverviewDocumentation","innerwidth=930,innerheight=900,scrollbars=yes,location=yes,menubar=yes,toolbar=yes");
+ y.focus();
+ }
+
+
+
+function blink() {
+ if(blinkcnt&1) {
+ document.getElementById('content').setAttribute("class","blinkoff");
+ }
+ else {
+ document.getElementById('content').setAttribute("class","blinkon");
+ }
+ blinkcnt++;
+ }
+
+</script>
+
+
+</head>
+<body ><!--onmousedown="stoprefresh(0);" onmouseup="stoprefresh(0);" ondblclick="stoprefresh(0);"-->
+<div class="button" style="width:45px;right:-8px;" onclick="askclose();"> close </div>
+<div class="button" id = "stop" style="right:35px;width:45px;" onclick="stoprefresh(1)">stop</div>
+<div class="button" id = "big" style="right:75px;width:45px;" onclick="zoom();"> bigger </div>
+
+<div id="content" class="blinkon">
+@;
+
+
+my $footer = "</div></body></html>";
+
+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
--- /dev/null
+#!/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
--- /dev/null
+#!/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<table class=\"colorfields\">\n<tr><th>";
+for(my $d=1;$d<=16;$d++) {
+ $template .= "<th>$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 \" </dev/null",10);
+ foreach my $a (@out) {
+ if($a =~ /cpu(\d+)/) {
+ my @s = split(/\s/,$a);
+ if(scalar @s > 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<tr><th class=\"title\">$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 .= "<td ";
+ $str .= sprintf("title=\"busy %.1f, sys %.1f, wait %.1f, irq %.1f\" ",$busy,$sys,$io,$irq);
+ $str .= sprintf("style=\"background-color:%4s;\">%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 .= "<tr><th>";
+ }
+ }
+ else {
+ #$str .= "<td>";
+ next;
+ }
+ }
+ }
+ $str .= "</table>\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
--- /dev/null
+#!/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 <E> 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 <E> 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);
+ }
--- /dev/null
+#!/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 .= "<table class=\"colorfields\">\n<tr><th>";
+ for (my $d=1;$d<=22;$d++) {
+ $str .= "<th>$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<tr><th>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 .= "<td ";
+ $str .= sprintf("style=\"background-color:%4s;\">%2i",Hmon::findcolor($store->{$n}->{$id},0,100,0),$store->{$n}->{$id});
+ }
+
+ }
+ $str .= "</table>\n";
+ $str .= Hmon::MakeFooter();
+ Hmon::WriteFile("EBDisks",$str);
+ if ($max <= 95) {
+ } elsif ($max<=98) {
+ system("logger -p local1.info -t DAQ 'EBdisk <W> Eventbuilder ".$maxb." exceeds $max% fill level.'");
+ $max = 120;
+ } elsif ($max<=100) {
+ system("logger -p local1.info -t DAQ 'EBdisk <E> 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;
+}
--- /dev/null
+#!/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 <E> 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);
+ }
+
--- /dev/null
+#!/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 .= "<pre style='text-align:left'> ";
+ 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 .= "</pre>";
+ $out .= Hmon::MakeFooter();
+ Hmon::WriteFile("hldlast",$out);
+
+ sleep(10);
+ }
\ No newline at end of file
--- /dev/null
+#!/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 <time>] : Check time (seconds) for monitoring boards (default: 5 sec)
+ [-b|--busy <time>] : Check time (seconds) for monitoring busy times (default: 1 sec)
+ [-s|--syslog <on|off>] : (Dis/En)able logging via syslog (default: off)
+ [-m|--miss <on|off>] : (Dis/En)able check of missing boards (default: on)
+ [-d|--debug] : Log debug information to ./mon_hub.log
+
+Examples:
+
+ Start monitoring with check times of 10 sec and 0.5 sec for boards and hub busy time:
+ mon_hub.pl --board 10 --busy 0.5
+
+Info:
+
+ If you want to run the script with enabled check of missing boards,
+ the script must be able to access lxhadesdaq:/home/hadaq/oper/daq2ora/daq2ora_current.txt
+ Therefore if you run mon_hub.pl on other machine than lxhadesdaq
+ you have to switch off the check of missing boards: mon_hub.pl -m off
+
+EOF
+
+ }
+
+sub finishAndExit()
+ {
+ # don't allow nested signal handling
+ return if ($ExitCode ne "-1");
+
+ # this will stop the treads, too
+ $ExitCode = shift;
+
+ # reset color
+ print RESET; print "\n";
+ print "mon_hub.pl exited (signal/exit code: $ExitCode).\n";
+
+ # wait until all threads ended - don't join the main thread or ourselves
+ foreach my $thread (threads->list()) {
+ $thread->join()
+ if ($thread->tid() && !threads::equal( $thread, threads->self() ));
+ }
+
+ exit(1);
+ }
+
+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;
+}
+
+sub display()
+ {
+ my $str = "";
+ my ($hub_href) = @_;
+
+ $str = Hmon::MakeTitle(11,12,"Hub Monitor",1);
+ $str .= '<table class="hubmon"><tr><td colspan=5><pre>';
+ chomp($msg);
+ $str .= "Status: ";
+
+ if ($msg =~ /^OK$/ ) {
+ $str .= "<font class='gr'>$msg</font>\n";
+ $log_statMsg_done = 0; # Set back to zero if the error's gone
+ } else {
+ $str .= "<font class='rd'>$msg</font>\n";
+ unless($log_statMsg_done){
+ system("logger -p local1.info -t DAQ MONHUB \\<E\\> $msg") if($Logger && ! ($msg =~ m/^trbcmd:/));
+ $log_statMsg_done = 1; # To avoid logging the same error many times
+ }
+ }
+
+ my $nrOfMissBoards = scalar @missBoards;
+
+ $str .= "Missing boards: ";
+ if ($nrOfMissBoards == 0 || ($nrOfMissBoards == 1 && $missBoards[0] == 0xfc00)) {
+
+ if ($opt_miss eq "on") {
+ $str .= 0;
+ } else {
+ $str .= "-";
+ }
+
+ $log_missBrds_done = 0; # Set back to zero if the error's gone
+ } else {
+ my $cntr = 0;
+ my $miss_msg = "";
+ foreach my $addr (sort @missBoards) {
+ if (!($addr == 0xfc00)) { #Workaround to remove Pexor internal Hub
+ $miss_msg .= sprintf(" %04x",$addr) if($cntr < 15);
+ $cntr++;
+ }
+ }
+
+ $str .= "<font class='rdn'>$cntr</font>";
+ $str .= " Addr:";
+ $str .= "<font class='rdn'>$miss_msg</font>";
+ # print BOLD RED ON_BLACK "$miss_msg";
+
+ $miss_msg = "Missing boards: ".$miss_msg;
+ unless($log_missBrds_done){
+ system("logger -p local1.info -t DAQ MONHUB \\<E\\> $miss_msg") if($Logger);
+ $log_missBrds_done = 1; # To avoid logging the same error many times
+ }
+ }
+ # print "\n\n";
+ #
+ #--- Print busy times
+ #
+ my $col = 0;
+ my $row = 5;
+ my $row_max = 20;
+ my $col_shift = 25;
+ my $cntr = 0;
+ my $busyboardslist = "";
+ my $hub_cntr = 0;
+ my $busyboardscnt = 0;
+
+
+ $str .= "</pre><tr><td><pre> ";
+ foreach my $hub_addr (sort keys %$hub_href) {
+ $cntr++;
+
+ $hub_cntr++;
+
+ my $port_href = $hub_href->{$hub_addr};
+
+ my $status = $port_href->{'status'};
+ my $busy = $port_href->{'busy'};
+
+ # $terminal->Tgoto('cm', $col, $row, *STDOUT);
+
+ # my $links = substr($status,0,18);
+ my $links = sprintf("%15s", (defined($status)?$status:""));
+ # my $line2 = sprintf("%22s", $busy);
+
+ $str .= sprintf("<font class='bl'>%04x</font>",$hub_addr);
+ $str .= "<font class='wh'>$links</font>";
+ $str .= "\n";
+
+ # $terminal->Tgoto('cm', $col+6, $row+1, *STDOUT);
+ $str .= " ";
+ my @busy_list = split(//, $busy) if defined $busy and $busy ne "";
+ my $i = 16;
+ foreach my $busy_time (@busy_list) {
+ if ($busy_time eq "0") {
+ $str .= "<font>";
+ } elsif ($busy_time eq " ") {
+ $str .= "<font>";
+ } elsif ($busy_time eq "#") {
+ if (isFeeHub($hub_addr) == 1) {
+ $busyboardslist .= ", " unless $busyboardslist eq "";
+ $busyboardslist .= sprintf("%04x (%04x-%i)",Hmon::TraceDBGet($hub_addr,$i-1),$hub_addr,($i-1));#
+ $busyboardscnt++;
+ }
+ $str .= "<font class='mg'>";
+ } elsif ($busy_time eq "-" || $busy_time < 4) {
+ $str .= "<font class='gr'>";
+ } elsif ($busy_time < 9) {
+ $str .= "<font class='or'>";
+ } else {
+ $str .= "<font class='rd'>";
+ }
+ $str .= "$busy_time</font>";
+ $i--;
+ }
+
+
+ $str .= "\n";
+
+ $row += 2;
+ if ($row >= 40) {
+ $row = 5;
+ $str .= "</pre><td><pre> ";
+ }
+
+
+ }
+
+ $str .= "</pre></table>\n";
+ $str .= Hmon::MakeFooter();
+ Hmon::WriteFile("hubmon",$str);
+ if ($busyboardscnt) {
+ Hmon::Speak('hubbusy',"$busyboardscnt front-end boards busy.");
+ QA::WriteQALog($fqa,"daq","busy",5,QA::FATAL,"Busy Boards","$busyboardscnt","$busyboardscnt busy hub ports: ".$busyboardslist);
+ if ($msgtimer++ >= 0) {
+ system("logger -p local1.info -t DAQ 'HubMon <W> Following FEE are busy >95%: $busyboardslist'");
+ $msgtimer = -60;
+ }
+ } else {
+ my $msgstr = sprintf("%3.1f%%",$maxpercent);
+ my $qastate = QA::OK;
+ $qastate = QA::ERROR if ($maxpercent > 99);
+ QA::WriteQALog($fqa,"daq","busy",5,$qastate,"Busy",$msgstr,"No busy hub ports - ".$longmsg);
+ $longmsg = "";
+ $msgtimer = -5;
+ }
+ }
+
+my @data1_list;
+my @data2_list;
+
+sub getDataFromTRBNet()
+ {
+ #- Read inclusive 0x4030 - 0x403F
+ # /exclusive busy counters 0x4040 - 0x404F
+ # and global time 0x4050
+
+ # my ($hub_href) = @_;
+
+ @data1_list = @data2_list;
+ unless(defined $data1_list[0]) {
+ @data1_list = `trbcmd rm 0xfffe 0x4030 33 0 2>&1`;
+ }
+ sleep($busy_check_time);
+ @data2_list = `trbcmd rm 0xfffe 0x4030 33 0 2>&1`;
+
+ # unless( @data1_list == @data2_list ){
+ # $msg = "ERROR: output length of 'trbcmd rm' varies!";
+ # return 1;
+ # }
+
+ #- Place the read data into hash
+ return 1 if(&data2hash(\@data1_list, "ports1"));
+ return 1 if(&data2hash(\@data2_list, "ports2"));
+
+ #- Read active ports
+ my @data_list = `trbcmd r 0xfffe 0x84 2>&1`;
+ return 1 if(&data2hash(\@data_list, "active"));
+
+ #- Read uplink ports
+ @data_list = `trbcmd r 0xfffe 0x85 2>&1`;
+ return 1 if(&data2hash(\@data_list, "uplink"));
+
+ #- Read downlink ports
+ @data_list = `trbcmd r 0xfffe 0x86 2>&1`;
+ return 1 if(&data2hash(\@data_list, "downlink"));
+ }
+
+
+sub data2hash()
+ {
+ my ($aref, $type) = @_;
+ #- Loop over ports (registers) with time counters
+ if ($type eq "ports1" || $type eq "ports2") {
+ my $hub_addr;
+ foreach my $line (@$aref) {
+ if ($line =~ /(ERROR|failed)/i ) {
+ $msg = "trbcmd: $line";
+ return 1;
+ }
+ #- Line with Hub address
+ if ( $line =~ /H:\s+0x(\w{4})/ ) {
+ $hub_addr = hex($1);
+ next;
+ }
+ #- Line with register address and value
+ if ( $line =~ /0x(\w{4})\s+0x(\w{8})/ ) { #\s+0x(\w{4})
+ my $reg_addr = hex($1);
+ my $reg_val = hex($2);
+ #- Filter out the data which should not enter the hash
+ next if ( $reg_addr >= 0x4040 && $reg_addr <= 0x404F ); #(&filterData($reg_addr));
+ $hub_href->{$hub_addr}->{$type}->{$reg_addr} = $reg_val;
+ # $hub_href->{$hub_addr}->{$type}->{0x4050} = hex($3)*16;
+ }
+ }
+ } elsif ( $type eq "active" || $type eq "uplink" || $type eq "downlink" ) {
+ foreach my $line (@$aref) {
+ if ( $line =~ /(ERROR|failed)/i) {
+ $msg = "trbcmd: $line";
+ return 1;
+ }
+ #- Line with hub address and value
+ if ( $line =~ /0x(\w{4})\s+0x(\w{8})/ ) {
+ my $hub_addr = hex($1);
+ my $hub_val = hex($2);
+ $hub_href->{$hub_addr}->{$type} = $hub_val;
+ }
+ }
+ }
+ }
+
+sub diffTimes()
+ {
+ my ($time2, $time1,$short) = @_;
+ my $timeDiff;
+ $time2 = 0 unless defined $time2;
+ $time1 = 0 unless defined $time1;
+
+ if ( $time2 < $time1) {
+ if ($short) {
+ $timeDiff = ($time2 - $time1) + 2**32;
+ } else {
+ $timeDiff = ($time2 - $time1) + 2**32;
+ }
+ } else {
+ $timeDiff = $time2 - $time1
+ }
+ return $timeDiff;
+ }
+
+sub calcBusy()
+ {
+ my ($hub_href) = @_;
+
+ foreach my $hub_addr (sort keys %$hub_href) {
+ my $port_href = $hub_href->{$hub_addr};
+
+ #
+ #-------------- Calculate status of ports --------
+ #
+ my $active = $port_href->{'active'} || 0;
+ my $uplink = $port_href->{'uplink'} || 0;
+ my $downlink = $port_href->{'downlink'} || 0;
+
+ my $status1 = ($uplink | $downlink);
+ my $status2 = ($status1 & $active);
+
+ # my $bin1 = sprintf("%016s", &dec2bin($status1));
+ # my $bin2 = sprintf("%016s", &dec2bin($status2));
+ # unpack("B16", pack("n", shift))
+ # my @stat1 = pack("n", $status1);#split(//, dec2bin($status1));
+ # my @stat2 = pack("n", $status2);#split(//, dec2bin($status2));
+
+ my $status;
+
+ for (my $i=0; $i<16; $i++) {
+ my $bit1 = ($status1>>(15-$i))&1;
+ my $bit2 = ($status2>>(15-$i))&1;
+
+ if ($bit1 & $bit2) {
+ $status .= $status_base[$i];
+ } elsif ($bit1 == 1) {
+ $status .= "-";
+ } else {
+ $status .= " ";
+ }
+ }
+
+ if ( defined $status ) {
+ $port_href->{'status'} = $status;
+ } else {
+ $msg = "ERROR: status of ports failed for hub: $hub_addr!";
+ }
+
+ #
+ #-------------- Calculate busy time --------------
+ #
+ my $glob1_val = $port_href->{'ports1'}->{0x4050};
+ my $glob2_val = $port_href->{'ports2'}->{0x4050};
+
+ #- Global time difference in Microseconds
+ my $glob_diff = &diffTimes($glob2_val, $glob1_val,1);
+ my @busy_list;
+
+ foreach my $reg_addr (sort keys %{$port_href->{'ports1'}} ) {
+
+ next if($reg_addr == 0x4050);
+
+ my $reg1_val = $port_href->{'ports1'}->{$reg_addr};
+ my $reg2_val = $port_href->{'ports2'}->{$reg_addr};
+
+ #- Time difference for given register in 10*Nanoseconds
+ my $reg_diff = &diffTimes($reg2_val, $reg1_val,0);
+
+ my $busy = 0;
+ unless( $glob_diff == 0 ){
+ #- Devide by 100 to convert to Microseconds
+ # and multiply by 100 to be in 0-100 region
+ $busy = $reg_diff / $glob_diff;
+ # $busy = sprintf("%3d", $busy);
+ }
+
+# $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"});
+# }
+# ('MDC12' 0,'MDC34' 1,'TOF' 2, 'RPC' 3, 'RICH' 4, 'SHW' 5, 'Start' 6, 'FW' 7)
+# my @keys = ("33","34","36","31","38","37","3b","35");
+ push(@busy_list, $busy);
+ }
+ if ($hub_addr == 0x8001) {
+ $longmsg .= sprintf("RICH: %3.1f%% - ",max($busy_list[8],$busy_list[9],$busy_list[10]));
+ $longmsg .= sprintf("MDC1/2: %3.1f%% - ",$busy_list[3]);
+ $longmsg .= sprintf("MDC3/4: %3.1f%% - ",$busy_list[4]);
+ $longmsg .= sprintf("TOF: %3.1f%% - ",$busy_list[6]);
+ $longmsg .= sprintf("RPC: %3.1f%% - ",max(($busy_list[1],$busy_list[2])));
+ $longmsg .= sprintf("SHW: %3.1f%% - ",$busy_list[7]);
+ $longmsg .= sprintf("FW: %3.1f%% - ",$busy_list[5]);
+ $longmsg .= sprintf("Oth: %3.1f%%",$busy_list[11]);
+ $maxpercent = max(@busy_list);
+ }
+
+ $port_href->{'busy'} = &calcBusyStatus(\@busy_list, $active || 0, $downlink || 0);
+ }
+ }
+
+
+
+sub calcBusyStatus()
+ {
+ my ($busy_aref, $active, $downlink) = @_;
+ my $busy_stat = "";
+ # $active = 0 unless defined $active;
+ # $downlink = 0 unless defined $downlink;
+ for ( my $i=15; $i>=0; $i--) {
+ if (($active & $downlink) & (1<<$i)) {
+ if ( ($busy_aref->[$i] || 0) > 94 ) {
+ $busy_stat .= '#';
+
+ } else {
+ $busy_stat .= int((5 + ($busy_aref->[$i] || 0))/10);
+ }
+ } elsif ($active & (1<<$i)) {
+ $busy_stat .= "-";
+ } else {
+ $busy_stat .= " ";
+ }
+
+ }
+ return $busy_stat;
+ }
+
+
+
+sub getMissingBoards()
+ {
+ my $time_mon = time();
+
+ #- Check boards after $boards_check_time seconds
+ return 0 if($time_mon - $time_old < $boards_check_time);
+
+ #- Get boards from TRB-Net
+ my @board_list = `trbcmd i 0xffff 2>&1`;
+ my $new_board_list = {};
+ my $daq_boards_list = {};
+
+ foreach my $line (@board_list) {
+
+ if ( $line =~ /(ERROR|failed)/i ) {
+ $msg = "trbcmd: $line";
+ return 1;
+ }
+ if ($line =~ /0x(\w{4})\s+0x(\w+)/) {
+ $new_board_list->{$1} = 1;
+ }
+ }
+ my $cmd = Hmon::HMONDIR."files/daq2ora_current.txt";
+
+ my $fh;
+ open($fh,"$cmd") or die "Can't open file $cmd, error: $!";
+
+ my $time_daq = stat($fh)->mtime;
+
+ #- Read boads from DAQ file
+ if ($time_daq - $time_old > 0) {
+ while (<$fh>) {
+ $_ =~ s/^\s+//; # Remove leading spaces
+ if ($_ =~ /(\w{16})\s+(\w{4})\s+\w+\s+\w+/) {
+ $daq_boards_list->{$2} = 1;
+ }
+ }
+ }
+
+ $fh->close;
+
+ #- Compare board lists
+ @missBoards = ();
+ foreach my $addr (keys %{$daq_boards_list}) {
+ unless (defined $new_board_list->{$addr}) {
+ push(@missBoards, hex($addr));
+ }
+ }
+
+ @missBoards = uniq(@missBoards);
+
+ $time_old = $time_mon;
+ }
+
+sub statusClient()
+ {
+ return;
+ #- Get UDP socket
+ my $sock_udp = IO::Socket::INET->new(LocalPort => 1960,
+ Proto => 'udp');
+
+
+ if (defined $sock_udp) {
+ print "UDP sock defined\n" if($opt_debug);
+ } else {
+ print "UDP sock undefined, cannot bind UDP socket! Exit.\n";
+ &finishAndExit(0);
+ }
+
+ my $MAX_BYTES = 100;
+ my $buf;
+
+ while (1) {
+ $sock_udp->recv( $buf, $MAX_BYTES );
+
+ &logMsg("UDP broadcast: $buf\n");
+
+ if ($buf =~ /STARTING/) {
+ $Logger = 0;
+ &tcpClient();
+ }
+
+ if ( $ExitCode ne "-1" ) {
+ &logMsg("Exit status server thread.\n");
+ close($sock_udp);
+ return;
+ }
+ }
+
+ close($sock_udp);
+ }
+
+sub tcpClient()
+ {
+ &logMsg("starting TCP client\n");
+ my $MAX_BYTES = 100;
+
+ #- Sleep some time to make sure that TCP Server
+ # of startup script has already been started
+ sleep(5);
+
+ my $sock = IO::Socket::INET->new(PeerPort => 1972,
+ PeerAddr => "192.168.100.50",
+ Proto => 'tcp',
+ Reuse => 1);
+
+ STDOUT->autoflush(1);
+
+ while (1) {
+ $sock->send("MON_HUB: STILL STARTING?\n");
+ #print scalar <$sock>;
+ #my $answer = <$sock>;
+ my $answer;
+ $sock->recv( $answer, $MAX_BYTES );
+
+ if (defined $answer) {
+ &logMsg("server answer: $answer");
+ unless($answer =~ /STARTING/){
+ last;
+ }
+
+ #- It looks like startup script is
+ # still running, wait some seconds
+ sleep(5);
+ } else {
+ #- TCP Server of startup script does not answer
+ # which means that the startup is over.
+ # We can start logging.
+
+ &logMsg("server is down. Exit.\n");
+ last;
+ }
+
+ if ( $ExitCode ne "-1" ) {
+ &logMsg("Exit TCP client subroutine.\n");
+ close($sock);
+ return;
+ }
+ }
+
+ close($sock);
+
+ $Logger = 1;
+ }
+
+sub logMsg()
+ {
+ my ($msg2log) = @_;
+
+ return unless($opt_debug);
+
+ my $file2log = "./mon_hub.log";
+
+ my $timeStamp = &timeStamp();
+
+ my $fh = new FileHandle($file2log, ">>") or die "Can't open file $file2log, error: $!";
+ print $fh "$timeStamp $msg2log";
+ $fh->close();
+ }
+
+sub timeStamp() {
+ return strftime("%Y-%m-%d %H:%M:%S", localtime());
+}
--- /dev/null
+#!/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 IO::Socket::INET;
+
+my $flog = QA::OpenQAFile();
+
+my $started = 1;
+my $last_mod_time = "---";
+my $num_unchanged =0;
+my $interval = 5;
+my ($socket,$client_socket);
+
+$socket = new IO::Socket::INET (
+ PeerHost => 'hadesdaq02',
+ PeerPort => '12345',
+ Proto => 'tcp'
+ );
+
+while (1) {
+
+ my $title = "Icinga";
+ my $value = "OK";
+ my $longtext = "";
+
+ my $title_etrax = "TRB";
+ my $value_etrax = "OK";
+ my $longtext_etrax = "";
+
+ my $title_power = "Pwrsply";
+ my $value_power = "OK";
+ my $longtext_power = "";
+
+ my $num_errors = 0;
+ my $icinga_running = 0;
+ #my $icinga_status_file = "/var/lib/icinga/status.dat";
+ #my @a = stat($icinga_status_file);
+
+ my $result = undef;
+ if (defined $socket) {
+ #print "print to socket\n";
+ $result = print $socket "secreticinga\n";
+ #print $result . "\n";
+ }
+ if (!$result) {
+ #print "open socket\n";
+ $socket = new IO::Socket::INET (
+ PeerHost => 'hadesdaq02',
+ PeerPort => '12345',
+ Proto => 'tcp');
+ if (!($socket)) {
+ #print "unable to open socket\n";
+ $value = "DOWN";
+ $longtext = "Unable to connect to hadesdaq02 (icinga log deamon)";
+ $num_errors = 999;
+ }
+ }
+
+ my $result_a;
+ if (defined $socket) {
+ #print "hallo\n";
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
+ alarm 10;
+ $result_a = <$socket>;
+ alarm 0;
+ };
+ if ($@) {
+ if ($@ eq "alarm\n") {
+ print "Timeout from server\n";
+ }
+ # timed out
+ }
+
+ #print "blubb\n";
+
+ if (defined $result_a) {
+ #print $result_a . "\n";
+ my @a = split(/\s+/,$result_a);
+ if ($started == 1) {
+ $started = 0;
+ $last_mod_time = $a[8];
+ $num_unchanged = 0;
+ }
+
+ if ($last_mod_time ne $a[8]) {
+ my @a = split(/\s+/,$result_a);
+ $last_mod_time = $a[8];
+ $num_unchanged = 0;
+ } else {
+ $num_unchanged++;
+ }
+ }
+ }
+
+
+
+ if ($num_unchanged > 5) {
+ #if ($num_unchanged > 0) {
+ my $downtime = $num_unchanged*$interval;
+ $value = "DOWN";
+ $longtext = "Icinga not updated since $last_mod_time";
+ QA::WriteQALog($flog,"server","icinga",10,QA::FATAL,$title,$value,$longtext);
+ } else {
+
+
+
+ my $icinga_query_hosts = "ssh hadesdaq02 \"REMOTE_USER='icingaadmin' REQUEST_METHOD='GET' QUERY_STRING='csvoutput&style=hostdetail&hoststatustypes=4&hostprops=10' /usr/lib/icinga/cgi/status.cgi\" | grep -v declare";
+ my @icinga_result_hosts = qx($icinga_query_hosts);
+ splice(@icinga_result_hosts, 0, 7);
+ #printf("@icinga_result_hosts");
+ $num_errors += scalar @icinga_result_hosts;
+
+ my $icinga_query_etrax = "ssh hadesdaq02 \"REMOTE_USER='icingaadmin' REQUEST_METHOD='GET' QUERY_STRING='csvoutput&hostgroup=etrax&style=hostdetail&hoststatustypes=4&hostprops=10' /usr/lib/icinga/cgi/status.cgi\" | grep -v declare";
+ my @icinga_result_etrax = qx($icinga_query_etrax);
+ #printf("@icinga_result_etrax");
+ splice(@icinga_result_etrax, 0, 7);
+ my $num_errors_etrax = scalar @icinga_result_etrax;
+
+ my $icinga_query_power = "ssh hadesdaq02 \"REMOTE_USER='icingaadmin' REQUEST_METHOD='GET' QUERY_STRING='csvoutput&hostgroup=power&style=hostdetail&hoststatustypes=4&hostprops=10' /usr/lib/icinga/cgi/status.cgi\" | grep -v declare";
+ my @icinga_result_power = qx($icinga_query_power);
+ #print @icinga_result_power . "\n";
+ splice(@icinga_result_power, 0, 7);
+ my $num_errors_power = scalar @icinga_result_power;
+
+
+ my $icinga_query_services = "ssh hadesdaq02 \"REMOTE_USER='icingaadmin' REQUEST_METHOD='GET' QUERY_STRING='csvoutput&style=detail&servicestatustypes=16&hoststatustypes=3&serviceprops=2097162' /usr/lib/icinga/cgi/status.cgi\" | grep -v declare";
+ my @icinga_result_services = qx($icinga_query_services);
+ splice(@icinga_result_services, 0, 7);
+ #printf("@icinga_result_services");
+ $num_errors += scalar @icinga_result_services;
+
+ foreach (@icinga_result_hosts) {
+ my @error = split(/\;/);
+ $error[5] =~ s/ - /: /g;
+ $error[5] =~ s/\n/ - /g;
+ $error[5] =~ s/'//g;
+ $longtext .= $error[5];
+ }
+ foreach (@icinga_result_etrax) {
+ my @error_etrax = split(/\;/);
+ $error_etrax[5] =~ s/ - /: /g;
+ $error_etrax[5] =~ s/\n/ - /g;
+ $error_etrax[5] =~ s/'//g;
+ if ($error_etrax[5] =~ m/etraxp2/) {
+ $num_errors_etrax--;
+ } else {
+ $longtext_etrax .= $error_etrax[5];
+ }
+ }
+ foreach (@icinga_result_power) {
+ my @error_power = split(/\;/);
+ $error_power[5] =~ s/ - /: /g;
+ $error_power[5] =~ s/\n/ - /g;
+ $error_power[5] =~ s/'//g;
+ $longtext_power .= $error_power[5];
+ }
+
+ foreach (@icinga_result_services) {
+ my @error = split(/\;/);
+ #printf("$error[6]");
+ $error[6] =~ s/ - /: /g;
+ $error[6] =~ s/\n/ - /g;
+ $error[6] =~ s/'//g;
+ $error[0] =~ s/'//g;
+ $error[1] =~ s/'//g;
+ $longtext .= "[$error[0]:$error[1]] " . $error[6];
+ }
+
+ $longtext =~ s/ - $//;
+
+
+ #printf("$longtext\n");
+
+
+
+ if ($num_errors>0) {
+ $value = "Problem";
+ QA::WriteQALog($flog,"server","icinga",10,QA::ERROR,$title,$value,$longtext);
+ } else {
+ QA::WriteQALog($flog,"server","icinga",10,QA::OK,$title,$value,$longtext);
+ }
+
+ if ($num_errors_etrax>0) {
+ $value_etrax = "Problem";
+ QA::WriteQALog($flog,"server","etrax",10,QA::ERROR,$title_etrax,$value_etrax,$longtext_etrax);
+ } else {
+ QA::WriteQALog($flog,"server","etrax",10,QA::OK,$title_etrax,$value_etrax,$longtext_etrax);
+ }
+
+ if ($num_errors_power>0) {
+ $value_power = "Problem";
+ QA::WriteQALog($flog,"server","pwrsup",10,QA::ERROR,$title_power,$value_power,$longtext_power);
+ } else {
+ QA::WriteQALog($flog,"server","pwrsup",10,QA::OK,$title_power,$value_power,$longtext_power);
+ }
+
+
+ }
+ sleep($interval);
+}
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+use HTML::Entities;
+use Hmon;
+
+my $str;
+my $cht;
+my ($month,$day,$time,$PC,$who,$level,$message);
+my $cmd = "./hmon_ssh -T lxhadesdaqp \"tail -n 50000 -F /home/hadeslog/messages\" </dev/null";
+my @store;
+my @cstore;
+my $msg;
+
+# Mar 11 15:55:18 hadesdaqp02 DAQ: EB <E> Data is sent to not running EB 1, 2, 3, 4, 5, 6, 7, 8
+# Mar 11 17:13:36 hadesdaqp02 DAQ: Chat <C> Test
+
+open(FTRB, "$cmd|");
+while(my $a = <FTRB>) {
+ if ($a =~ m/(NETMEM|EVTBLD)/) {
+ next if ($a =~ /Stream/);
+ next if ($a =~ /queue entries to sync/);
+ next if ($a =~ /Cleared double buffers/);
+ next if ($a =~ /Critical trigger mismatch/);
+ next if ($a =~ /(started|exited)/);
+ next if ($a =~ /rfio is disabled/);
+ next if ($a =~ /discarded events: (\w+)/);# && $1 < 30);
+ next if ($a =~ /opened connection to Data Mover/);
+ }
+ next if ($a =~ /30 boards complain: Event not found: 3000/);
+ next if ($a =~ /30 boards complain: frontend not configured: 3000/);
+ next if ($a =~ /30 boards complain: error: 3000/);
+ next if ($a =~ /30 boards complain: serious error: 3000/);
+ $a =~ s/3000 3001 3002 3003 3004 3010 3011 3012 3013 3014 3020 3021 3022 3023 3024 3030 3031 3032 3033 3034 3040 3041 3042 3043 3044 3050 3051 3052 3053 3054/RICH, /;
+ $a =~ s/0x2000 0x2001 0x2002 0x2003 0x2004 0x2005 0x2006 0x2007 0x2008 0x2009 0x200a 0x200b 0x200c 0x200d 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 0x2138 0x2139 0x213a 0x213b/MDC missing/;
+ if (($month,$day,$time,$PC,$who,$level,$message) = $a =~ m/(\w+)\s+(\d+)\s+(\d\d:\d\d:\d\d)\s+(\w+)\s+\w+.?\w?.?:\s+(\w+-?\d?\d?)\s+.(\w).\s+(.*)/) {
+
+ $msg = "";
+ $msg .= sprintf("\n<tr><td>%s.%s. %s<td>%s<td ",$day,$month,$time,$who);
+ if($level eq 'N') {$msg .= 'style="color:green"><N>';}
+ elsif($level eq 'I') {$msg .= 'style="color:black"><I>';}
+ elsif($level eq 'W') {$msg .= 'style="color:#f70"><W>';}
+ elsif($level eq 'E') {$msg .= 'style="color:red"><E>';}
+ elsif($level eq 'C') {$msg .= 'style="color:#22a"><C>';}
+ else {$msg .= '>';}
+ encode_entities($message);
+ $msg .= " $message";
+# while($msg =~ m/\s\s/){$msg =~ s/\s\s/ /;};
+
+ unshift(@store,$msg);
+ unshift(@cstore,$msg) if $level eq 'C';
+# push(@longstore,$msg);
+ pop(@store) if (scalar @store>200);
+ pop(@cstore) if (scalar @cstore>200);
+# shift(@longstore) if (scalar @longstore>10000);
+
+ $str = Hmon::MakeTitle(12,9,"Last Logfile Entries");
+ $str .= '<div id="logbox" class="textbox" ><table class="logfile">';
+ foreach my $l (@store) {
+ $str .= $l;
+ }
+ $str .= "\n</table></div>\n";
+ $str .= Hmon::MakeFooter();
+ Hmon::WriteFile("logfile",$str);
+
+ $cht = Hmon::MakeTitle(9,6,"Chat Log");
+ $cht .= '<div id="logbox" class="textbox" ><table class="logfile">';
+ foreach my $l (@cstore) {
+ $cht .= $l;
+ }
+ $cht .= "\n</table></div>\n";
+ $cht .= Hmon::MakeFooter();
+ Hmon::WriteFile("chat",$cht);
+
+
+# $str = Hmon::MakeTitle(12,12,"Last Logfile Entries");
+# $str .= '<div id="logbox" class="textbox" onclick="this.scrollTop = this.scrollHeight;"><table class="logfile">';
+# foreach my http://cerberus:8888/mon/monitor.cgi?2-window-MDCRates$l (@longstore) {
+# $str .= $l;
+# }
+# $str .= "</table></div>\n";
+# $str .= "<script language='javascript'>";
+# $str .= "setTimeout(document.getElementById('logbox').scrollTop = document.getElementById('logbox').scrollHeight,100);";
+# $str .= "</script>";
+# $str .= "</div>\n";
+# Hmon::WriteFile("LongLogfile",$str);
+ }
+
+ }
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use POSIX qw(strftime);
+use FileHandle;
+use Hmon;
+use QA;
+use Getopt::Long;
+use Data::Dumper;
+
+
+my %range_list = (
+ 'Time' => {},
+ 'TC1200' => {'min' => 5.2 , 'max' =>5.6 },
+ 'TC1266' => {'min' => 4.9 , 'max' =>5.1 },
+ 'TC1202' => {'min' => 4.4 , 'max' =>4.6 },
+ 'TC1208' => {'min' => 4.5 , 'max' =>4.8 },
+ 'TC1214' => {'min' => 4.4 , 'max' =>4.6 },
+ 'TC1220' => {'min' => 4.4 , 'max' =>4.6 },
+ 'TC1226' => {'min' => 4.5 , 'max' =>4.8 },
+ 'TC1232' => {'min' => 4.4 , 'max' =>4.6 },
+ 'TC1206' => {'min' => 4.0 , 'max' =>6.0 },
+ 'TC1212' => {'min' => 4.0 , 'max' =>6.0 },
+ 'TC1218' => {'min' => 6.0 , 'max' =>7.0 },
+ 'TC1224' => {'min' => 6.0 , 'max' =>8.0 },
+ 'TC1230' => {'min' => 4.6 , 'max' =>8.0 },
+ 'TC1236' => {'min' => 4.4 , 'max' =>6.0 },
+ 'TC1238' => {'min' => 4.6 , 'max' =>4.9 },
+ 'TC1248' => {'min' => 4.5 , 'max' =>4.7 },
+ 'FI1400' => {'min' => 0.36 , 'max' =>0.49 },
+ 'PSUI_rbk' => {'min' => 2495 , 'max' =>2497 },
+ 'PSUV_rbk' => {'min' => 0 , 'max' =>1 },
+ 'BBI' => {'min' => -450 , 'max' =>-419.0},
+ 'LL1708' => {'min' => 55.2 , 'max' =>63.0 },
+ 'TP1240' => {'min' => 75.5 , 'max' =>85.0 , 'cal_max' => 2},
+ 'PI2610' => {'min' => 1.7 , 'max' =>3.1 },
+ 'TP2200' => {'min' => 83.0 , 'max' =>85.5 , 'cal_max' => 2},
+ 'TP2202' => {'min' => 84.0 , 'max' =>87.0 , 'cal_max' => 2},
+ 'TP2204' => {'min' => 81.0 , 'max' =>85.5 , 'cal_max' => 2},
+ 'TP2206' => {'min' => 81.0 , 'max' =>85.0 , 'cal_max' => 2},
+ 'TP2208' => {'min' => 89.0 , 'max' =>95.0 , 'cal_max' => 2},
+ 'TP2210' => {'min' => 80.0 , 'max' =>85.0 , 'cal_max' => 2},
+ 'TP2212' => {'min' => 82.0 , 'max' =>92.0 , 'cal_max' => 2},
+ 'TP2214' => {'min' => 80.0 , 'max' =>85.0 , 'cal_max' => 2},
+ 'TP2216' => {'min' => 80.0 , 'max' =>84.0 , 'cal_max' => 2},
+ 'TP2218' => {'min' => 84.0 , 'max' =>90.5 , 'cal_max' => 2},
+ 'TP2220' => {'min' => 80.0 , 'max' =>84.0 , 'cal_max' => 2},
+ 'TP2222' => {'min' => 81.0 , 'max' =>86.0 , 'cal_max' => 2},
+ 'TP2224' => {'min' => 81.0 , 'max' =>85.0 , 'cal_max' => 2},
+ 'TP2226' => {'min' => 80.0 , 'max' =>100 , 'cal_max' => 2},
+ 'TP2228' => {'min' => 85 , 'max' =>94.0 , 'cal_max' => 2},
+ 'TP2230' => {'min' => 80.0 , 'max' =>85.5 , 'cal_max' => 2},
+ 'PI2600' => {'min' => 1.65 , 'max' =>2.0 },
+ 'VG3000' => {'min' => -6.5 , 'max' =>-6.0 },
+ 'PI1600' => {'min' => 2.94 , 'max' =>2.97 },
+ 'PI1602' => {'min' => 1.30 , 'max' =>1.37 },
+ 'PI1604' => {'min' => 2.7 , 'max' =>2.99 },
+ 'EV1100R' => {'min' => 27 , 'max' =>36 },
+ 'EV1122R' => {'min' => 55 , 'max' =>61 },
+ 'EV1128R' => {'min' => 73 , 'max' =>81 },
+ 'TC1200M' => {'min' => 6.5 , 'max' =>8.5 },
+ 'PI1600I' => {'min' => 1.28 , 'max' =>1.37 }
+ );
+
+
+
+my $range_list_href = \%range_list;
+my $nrOfValues = scalar keys %range_list;
+
+my $flog = QA::OpenQAFile();
+
+my $fatal_error_counter = 0;
+my $red_error_counter = 0;
+my $yellow_error_counter = 0;
+my $interval = 60;
+my $started = 1;
+my $last_mod_time;
+my $last_size;
+my $last_good_time = '--';
+my $temperature_factor = 0;
+my $ssh_fh;
+
+foreach my $rh_val (keys %$range_list_href) {
+ if (defined $range_list_href->{$rh_val}->{'cal_max'}) {
+ $range_list_href->{$rh_val}->{'max'} += $temperature_factor * $range_list_href->{$rh_val}->{'cal_max'};
+ }
+}
+
+
+
+while(1) {
+
+ my $fatal_error_string = "";
+
+ my $get_filename_command = "ssh -o BatchMode=yes magnet\@hadesp28 \"ls -rtl /home/magnet/Hades_Magnet_Labview/Log/log1 | tail -n 1\"";
+ my @get_filename_result = qx($get_filename_command);
+ #printf("$get_filename_result[0]");
+
+ my $title = "Magnet";
+ my $value = "";
+ my $longtext = "";
+ my $time = "--";
+
+ if ((scalar @get_filename_result) != 1) {
+ #if (!defined $ssh_fh || eof($ssh_fh)) {
+ $red_error_counter++;
+ $fatal_error_string = "No ssh connection to magnet PC";
+ } else {
+ my ($Sekunden, $Minuten, $Stunden, $Tag, $Monat,
+ $Jahr, $Wochentag, $Jahrestag, $Sommerzeit) = localtime(time);
+ $Monat += 1;
+ $Jahr += 1900;
+ my $log_localtime = sprintf('%02d%02d%04d', $Tag, $Monat, $Jahr);
+
+ my @get_filename_array = split(/\s+/,$get_filename_result[0]);
+ #printf("@get_filename_array\n");
+ $get_filename_array[8] =~ s/\n//g;
+
+ #printf("$log_localtime $get_filename_array[8]\n");
+ if (!($log_localtime eq $get_filename_array[8])) {
+ $fatal_error_string = "Log file is not up-to-date";
+ $red_error_counter++;
+ } else {
+ my $log_file = "/home/magnet/Hades_Magnet_Labview/Log/log1/" . $log_localtime;
+ #check if file is increasing
+ if ($started == 1) {
+ $started = 0;
+ $last_mod_time = $Sekunden + 60*$Minuten + 60*60*$Stunden;
+ $last_size = $get_filename_array[4];
+ }
+ if ($last_size != $get_filename_array[4]) {
+ $last_mod_time = $Sekunden + 60*$Minuten + 60*60*$Stunden;
+ $last_size = $get_filename_array[4];
+ }
+ my $time_diff = ($Sekunden + 60*$Minuten + 60*60*$Stunden) - $last_mod_time;
+ if ($time_diff > 3*60+20) {
+ $fatal_error_string = "Log file not increased since $time_diff sec.";
+ $red_error_counter++;
+ } else {
+ my $get_filename_command = "ssh -o BatchMode=yes magnet\@hadesp28 \"tail -n 1 /home/magnet/Hades_Magnet_Labview/Log/log1/$get_filename_array[8] \"";
+ my @get_value_array = qx($get_filename_command);
+ #printf("$get_filename_command");
+ #printf("@get_value_array");
+ $get_filename_command = "ssh -o BatchMode=yes magnet\@hadesp28 \"head -n 1 /home/magnet/Hades_Magnet_Labview/Log/log1/$get_filename_array[8] \"";
+ my @get_header_array = qx($get_filename_command);
+ #printf("@get_header_array");
+ if (scalar @get_header_array != 1 || scalar @get_value_array != 1) {
+ $fatal_error_string = "Log file has no header line";
+ $red_error_counter++;
+ } else {
+ my @get_header_array_split = split(/\s+/,$get_header_array[0]);
+ my @get_value_array_split = split(/\s+/,$get_value_array[0]);
+ if ((scalar @get_header_array_split) != (scalar @get_value_array_split) + 1) {
+ $fatal_error_string = "Log file entries not consistent";
+ #print scalar @get_header_array_split . ":" . scalar @get_value_array_split . "\n";
+ $red_error_counter++;
+ #print $fatal_error_string . "\n";
+ } else {
+ my $old_error_counter = $red_error_counter;
+ my $old_red_error_counter = $red_error_counter;
+ my $old_fatal_error_counter = $fatal_error_counter;
+ $time = $get_value_array_split[0];
+ $red_error_counter = 0;
+ $fatal_error_counter = 0;
+ $yellow_error_counter = 0;
+ #print scalar @get_header_array_split . ":" . scalar @get_value_array_split . ":" . $nrOfValues . "\n";
+ for (my $i = 1; $i < scalar @get_header_array_split; $i++) {
+ #print $name . "\n";
+
+ my $name = $get_header_array_split[$i];
+ my $val = $get_value_array_split[$i-1];
+ if (!defined $range_list_href->{$name}) {
+ $fatal_error_string = "Found entry '$name' which is not existing";
+ $red_error_counter = $old_red_error_counter + 1;
+ } else {
+ $range_list_href->{$name}->{'value'} = $val;
+ if (defined $range_list_href->{$name}->{'max'} && $val > $range_list_href->{$name}->{'max'}) {
+ if ($yellow_error_counter>0) {
+ $fatal_error_string .= ", Value '$name' has $val, maximum is $range_list_href->{$name}->{'max'}";
+ } else {
+ $fatal_error_string .= "Value '$name' has $val, maximum is $range_list_href->{$name}->{'max'}";
+ }
+ $yellow_error_counter++;
+ }
+ if (defined $range_list_href->{$name}->{'min'} && $val < $range_list_href->{$name}->{'min'}) {
+ if ($yellow_error_counter>0) {
+ $fatal_error_string .= ", Value '$name' has $val, minimum is $range_list_href->{$name}->{'min'}";
+ } else {
+ $fatal_error_string .= "Value '$name' has $val, minimum is $range_list_href->{$name}->{'min'}";
+ }
+ $yellow_error_counter++;
+ }
+ }
+ } #for
+ if ($yellow_error_counter>2) {
+ #print $yellow_error_counter . "\n";
+ $fatal_error_counter = $old_fatal_error_counter + $yellow_error_counter;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ #print $fatal_error_string . "\n";
+
+ if ($fatal_error_counter>3) {
+ $fatal_error_string .= " (last good check at $last_good_time)";
+ QA::WriteQALog($flog,"other","magnet",$interval+20,QA::FATAL,$title,$value,$fatal_error_string);
+ } elsif ($red_error_counter > 0) {
+ $fatal_error_string .= " (last good check at $last_good_time)";
+ QA::WriteQALog($flog,"other","magnet",$interval+20,QA::ERROR,$title,$value,$fatal_error_string);
+ } elsif ($yellow_error_counter > 0) {
+ $fatal_error_string .= " (last good check at $last_good_time)";
+ QA::WriteQALog($flog,"other","magnet",$interval+20,QA::WARN,$title,$value,$fatal_error_string);
+ } else {
+ $longtext = "Checked at $time";
+ QA::WriteQALog($flog,"other","magnet",$interval+20,QA::OK,$title,$value,$longtext);
+ $last_good_time = $time;
+ }
+
+ sleep($interval);
+}
--- /dev/null
+#!/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 $timer = 0;
+my @colors = ("#003366","#006666","#00cc99","#00ff44","#00cc00","#00ff00","#666600","#aa6600","#ddcc00","#ffcc00","#aa2200","#ff0000");
+my @names = qw( F1 F2 F3 F4 F5 F6 C1 C2 C3 C4 C5 C6 );
+my $connect_status = &trb_init_ports();
+if(!$connect_status) {
+ die("could not connect to trbnetd");
+}
+
+###########
+#Change 3 for-loops to include all four planes again!
+############
+
+# my $fqa = QA::OpenQAFile();
+my @plot;
+foreach my $s (0..5){
+ foreach my $p (0..1) {
+ $plot[$p*6+$s] = ();
+ $plot[$p*6+$s]->{name} = "P".$p."S".$s."I";
+ $plot[$p*6+$s]->{file} = "files/MDCHV".$plot[$p*6+$s]->{name};
+ $plot[$p*6+$s]->{entries} = 1440;
+ $plot[$p*6+$s]->{xscale} = 12;
+ $plot[$p*6+$s]->{type} = HPlot::TYPE_HISTORY;
+ $plot[$p*6+$s]->{output} = HPlot::OUT_PNG;
+ $plot[$p*6+$s]->{xlabel} = "Minutes";
+ $plot[$p*6+$s]->{ylabel} = "Current";
+ $plot[$p*6+$s]->{sizex} = 1130;
+ $plot[$p*6+$s]->{sizey} = 420;
+ $plot[$p*6+$s]->{curves} = 12;
+ $plot[$p*6+$s]->{dots} = 1;
+ $plot[$p*6+$s]->{colors} = \@colors;
+ foreach my $c (0..11) {
+ $plot[$p*6+$s]->{titles}->[$c] = $names[$c];
+ }
+ HPlot::PlotInit($plot[$p*6+$s]);
+ $plot[$p*6+$s+24]->{name} = "P".$p."S".$s."V";
+ $plot[$p*6+$s+24]->{file} = "files/MDCHV".$plot[$p*6+$s+24]->{name};
+ $plot[$p*6+$s+24]->{entries} = 1440;
+ $plot[$p*6+$s+24]->{xscale} = 12;
+ $plot[$p*6+$s+24]->{type} = HPlot::TYPE_HISTORY;
+ $plot[$p*6+$s+24]->{output} = HPlot::OUT_PNG;
+ $plot[$p*6+$s+24]->{xlabel} = "Minutes";
+ $plot[$p*6+$s+24]->{ylabel} = "Voltage";
+ $plot[$p*6+$s+24]->{sizex} = 1130;
+ $plot[$p*6+$s+24]->{sizey} = 420;
+ $plot[$p*6+$s+24]->{curves} = 12;
+ $plot[$p*6+$s+24]->{dots} = 1;
+ $plot[$p*6+$s+24]->{colors} = \@colors;
+ foreach my $c (0..11) {
+ $plot[$p*6+$s+24]->{titles}->[$c] = $names[$c];
+ }
+ HPlot::PlotInit($plot[$p*6+$s+24]);
+ }
+ }
+
+
+for(my $i = 1; $i<=4; $i++) {
+ for(my $j = 1; $j<=6; $j++) {
+ for(my $v = 0; $v<=11; $v++) {
+# print "$i-$j-$v\n";
+ my $s = sprintf("HAD:MDCHV:P%i:S%i:VMON_C%i",$i,$j,$v);
+ Perl2Epics::Connect("$i-$j-$v-V",$s);
+ $s = sprintf("HAD:MDCHV:P%i:S%i:IMON_C%i",$i,$j,$v);
+ Perl2Epics::Connect("$i-$j-$v-I",$s);
+ }
+ }
+ }
+print "Connected.\n";
+
+while(1) {
+ my $data = Perl2Epics::GetAll();
+ my $str = Hmon::MakeTitle(10, 23, "MDC HV", 1, "");
+ $str .= "<table class=\"rates textbox\">"; #<div id=\"logbox\" class=\"textbox\" >
+ for(my $i = 1; $i<=2; $i++) {
+ $str .= "<tr><th colspan=7>Plane $i\n";
+ $str .= "<tr><th><th colspan=1>1<th colspan=1>2<th colspan=1>3<th colspan=1>4<th colspan=1>5<th colspan=1>6";
+ for(my $v = 0; $v<=11; $v++) {
+ $str .= "<tr><td>".$names[$v]." ";
+ for(my $s = 1; $s<=6; $s++) {
+ my $volt = $data->{"$i-$s-$v-V"}->{val};
+ my $curr = $data->{"$i-$s-$v-I"}->{val};
+ my $tv = strftime("%H:%M:%S",localtime($data->{"$i-$s-$v-V"}->{tme} || 0));
+ my $tc = strftime("%H:%M:%S",localtime($data->{"$i-$s-$v-I"}->{tme} || 0));
+ $volt = -1 unless defined $volt;
+ $curr = -1 unless defined $curr;
+ HPlot::PlotAdd("P".($i-1)."S".($s-1)."I",$curr,$v);
+ HPlot::PlotAdd("P".($i-1)."S".($s-1)."V",$volt,$v);
+ my $tmp .= sprintf(" %4i - %5i",$volt,$curr);
+ $tmp =~ s/\s/ /gi;
+ $str .= "<td title=\"$tv / $tc\">".$tmp;
+ }
+ }
+ $str .= "<tr><th colspan=7> \n";
+ }
+ $str .= "</table>";#</div>
+ $str .= Hmon::MakeFooter();
+
+ if(!($timer%2)) {
+ Hmon::WriteFile("MDCHV", $str);
+ }
+ if(!($timer%6)) {
+ foreach my $s (0..5){
+ foreach my $p (0..1) {
+ HPlot::PlotDraw("P".$p."S".$s."I");
+ HPlot::PlotDraw("P".$p."S".$s."V");
+ }
+ }
+ }
+ $timer++;
+ sleep(5);
+ }
--- /dev/null
+#!/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;
+
+
+for(my $i = 1; $i<=4; $i++) {
+ for(my $j = 1; $j<=6; $j++) {
+ my $s = sprintf("HAD:MDC:LV:P%i:S%i:SWITCH_get",$i,$j);
+ Perl2Epics::Connect("p$i$j",$s);
+ }
+ }
+
+while(1) {
+ my $data = Perl2Epics::GetAll();
+# print Dumper $data;
+ my $str = Hmon::MakeTitle(8, 4, "MDC LV Status", 1, "");
+ $str .= "<table class=\"rates status\">\n";
+ $str .= "<tr><th><th>Sector 0<th>Sector 1<th>Sector 2<th>Sector 3<th>Sector 4<th>Sector 5\n";
+ for(my $i = 1; $i<=4; $i++) {
+ $str .= "<tr><th>Plane ".($i-1);
+ for(my $j = 1; $j<=6; $j++) {
+ $str .= "<td><div class=\"greenbutton\"></div>" if $data->{"p$i$j"}->{val} == 0;
+ $str .= "<td><div class=\"redbutton\"></div>" if $data->{"p$i$j"}->{val} == 1;
+ }
+ }
+ $str .= "</table>";
+
+ $str .= Hmon::MakeFooter();
+
+ Hmon::WriteFile("MDCLV", $str);
+
+ sleep(2);
+ }
+
--- /dev/null
+#!/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} = "AtmosPress";
+$plot->{file} = "files/AtmosPress";
+$plot->{entries} = 720;
+$plot->{type} = HPlot::TYPE_HISTORY;
+$plot->{output} = HPlot::OUT_PNG;
+$plot->{titles}->[0] = "";
+$plot->{xlabel} = "Minutes";
+$plot->{ylabel} = "mbar";
+$plot->{sizex} = 630;
+$plot->{sizey} = 220;
+$plot->{ymin} = 950;
+$plot->{ymax} = 1050;
+$plot->{nokey} = 1;
+HPlot::PlotInit($plot);
+
+
+my $plot2 = ();
+$plot2->{name} = "MdcScales";
+$plot2->{file} = "files/MdcScales";
+$plot2->{entries} = 2880;
+$plot2->{type} = HPlot::TYPE_HISTORY;
+$plot2->{output} = HPlot::OUT_PNG;
+$plot2->{titles}->[0] = "Scale_1";
+$plot2->{titles}->[1] = "Scale_2";
+$plot2->{xlabel} = "Minutes";
+$plot2->{ylabel} = "kg";
+$plot2->{sizex} = 630;
+$plot2->{sizey} = 220;
+$plot2->{nokey} = 0;
+$plot2->{curves} = 2;
+HPlot::PlotInit($plot2);
+
+my $str = Hmon::MakeTitle(8,5,"Atmospheric Pressure",0);
+$str .= qq@<img src="%ADDPNG files/AtmosPress.png%" type="image/png">@;
+$str .= Hmon::MakeFooter();
+Hmon::WriteFile("AtmosPress",$str);
+
+$str = Hmon::MakeTitle(8,5,"MDC Scales",0);
+$str .= qq@<img src="%ADDPNG files/MdcScales.png%" type="image/png">@;
+$str .= Hmon::MakeFooter();
+Hmon::WriteFile("MdcScales",$str);
+
+
+my $timer = 0;
+
+
+
+for(my $i = 1; $i<=3; $i+=2) {
+ for(my $j = 1; $j<=6; $j++) {
+ my $s = sprintf("HAD:MDC:P%i:S%i:p_delta",$i,$j);
+ Perl2Epics::Connect("p$i$j",$s);
+ }
+ }
+foreach my $n (@names) {
+ Perl2Epics::Connect($n,"HAD:MDC:GAS:".$n);
+ }
+foreach my $n (@names3) {
+ Perl2Epics::Connect($n,"HAD:TARGET:".$n);
+ }
+foreach my $n (@names2) {
+ Perl2Epics::Connect($n,"HAD:".$n);
+ }
+
+
+print "Connected.\n";
+
+while(1) {
+ my $data = Perl2Epics::GetAll();
+ $str = Hmon::MakeTitle(8, 18, "MDC Gas Pressure", 1, "");
+ $str .= "<h4>p_Delta</h4>\n";
+ $str .= "<table class=\"rates \">\n"; #<div id=\"logbox\" class=\"textbox\" >
+ $str .= "<tr><th><th colspan=1>1<th colspan=1>2<th colspan=1>3<th colspan=1>4<th colspan=1>5<th colspan=1>6\n";
+ for(my $i = 1; $i<=3; $i+=2) {
+ $str .= "<tr><th>$i";
+ for(my $v = 1; $v<=6; $v++) {
+ $str .= sprintf("<td> %.2f\n",$data->{"p$i$v"}->{val} || -1);
+ }
+ }
+ $str .= "</table>\n";
+ $str .= "<h4>Gas System</h4>\n";
+ $str .= "<table class=\"rates \" style=\"margin:auto\">\n";
+ foreach my $i (0.. (scalar @names)-1) {
+ $str .= sprintf("<tr><td>%s<td>%.2f\n",$names[$i],$data->{$names[$i]}->{val} || -1);
+ }
+ foreach my $i (0.. (scalar @names3)-1) {
+ $str .= sprintf("<tr><td>%s<td>%.2f\n",$names3[$i],$data->{$names3[$i]}->{val} || -1);
+ }
+ foreach my $i (0.. (scalar @names2)-1) {
+ $str .= sprintf("<tr><td>%s<td>%.2f\n",$names2[$i],$data->{$names2[$i]}->{val} || -1);
+ }
+ $str .= "</table>\n";
+ $str .= qq@<img src="%ADDPNG files/MdcScales.png%" type="image/png">\n@;
+ $str .= "<br>\n";
+ $str .= qq@<img src="%ADDPNG files/AtmosPress.png%" type="image/png">\n@;
+ $str .= Hmon::MakeFooter();
+
+ Hmon::WriteFile("MDCPressure", $str);
+
+ if(!($timer%6)) {
+ HPlot::PlotAdd("MdcScales",$data->{waage_1_net}->{val},0);
+ HPlot::PlotAdd("MdcScales",$data->{waage_2_net}->{val},1);
+ HPlot::PlotDraw("MdcScales");
+ }
+
+
+ if(!($timer++%6)) {
+ HPlot::PlotAdd("AtmosPress",$data->{reflowPressureAthm}->{val});
+ HPlot::PlotDraw("AtmosPress");
+ }
+
+
+ sleep(10);
+ }
--- /dev/null
+/usr/bin/tail
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl -w
+use FileHandle;
+use Data::Dumper;
+use POSIX qw(strftime);
+use Hmon;
+use QA;
+
+while(1) {
+
+
+open(FLOG, Hmon::HMONDIR."hmon_permanent_tail -F ".Hmon::HMONDIR."files/qalog|");
+
+my $readlines = 0;
+my $str = "";
+my $oldtime = time();
+my $cats = $QA::cats;
+my $entries = $QA::entries;
+my $store;
+
+while($a = <FLOG>) {
+
+#Store new entries
+ chomp $a;
+ my ($timestamp,$cat,$entry,$ttl,$sev,$title,$value,$longtext) = split("\t",$a);
+ $store->{$cat}->{$entry}->{"sev"} = $sev;
+ $store->{$cat}->{$entry}->{"title"} = $title;
+ $store->{$cat}->{$entry}->{"val"} = $value;
+ $store->{$cat}->{$entry}->{"time"} = $timestamp;
+ $store->{$cat}->{$entry}->{"ttl"} = $ttl+$timestamp;
+ $store->{$cat}->{$entry}->{"long"} = $longtext || "No Text";
+
+
+
+#Delete file if it contains more than 10000 lines
+ if($readlines++ > 10000) {
+ $readlines = 0;
+ close(FLOG);
+ open(FL,">".Hmon::HMONDIR."files/qalog");
+ close(FL);
+ open(FLOG, Hmon::HMONDIR."hmon_permanent_tail -F ".Hmon::HMONDIR."files/qalog|");
+ }
+
+#Generate output file at most once per second
+ if($oldtime < time) {
+ $oldtime = scalar time();
+ $str = Hmon::MakeTitle(7,10,"Tactical Overview",1);
+ $str .= "<div class=\"QA\">";
+ foreach my $c (@{$entries->{'cats'}}) {
+ $str .= "<div class=\"header\" style=\"clear:both\">$cats->{$c}</div>\n";
+ foreach my $e (@{$entries->{$c}}) {
+ my $sev = $store->{$c}->{$e}->{'sev'} || 0;
+ my $value = $store->{$c}->{$e}->{'val'} || "";
+ my $title = $store->{$c}->{$e}->{'title'} || $e;
+ my $tim = $store->{$c}->{$e}->{'time'} || -1;
+ my $time = strftime("(%H:%M:%S)",localtime($tim)) if $tim != -1;
+ $time = "" if $tim == -1;
+ my $text = $store->{$c}->{$e}->{'long'} || "";
+ my $ttl = $store->{$c}->{$e}->{'ttl'} || 0;
+
+ if (!defined($sev)||$sev==QA::NA) {$sevcol = "bgr";}
+ elsif ($ttl < $oldtime) {$sevcol = "bwh";}
+ elsif ($sev == QA::SCRIPTERROR) {$sevcol = "bmg";}
+ elsif ($sev < QA::NOTE) {$sevcol = "bgn";}
+ elsif ($sev < QA::WARN) {$sevcol = "byg";}
+ elsif ($sev < QA::WARN_2) {$sevcol = "bye";}
+ elsif ($sev < QA::ERROR) {$sevcol = "bor";}
+ elsif ($sev < QA::LETHAL) {$sevcol = "brd";}
+ elsif ($sev == QA::LETHAL) {$sevcol = "brdb";}
+ else {$sevcol = "bgr";}
+
+
+ $str .= "<div id=\"$c-$e\" class=\"".($sev||0)." $sevcol\" alt=\"".$cats->{$c}."-$title $time: ".QA::LevelName($sev)."<br /> $text\" onmouseover=\"clk(this);\"";
+ $str .= " onclick=\"openhelp('$c-$e')\">".$title."<br/>".$value."</div>\n";
+ }
+ }
+ $str .="<div id=\"footer\" class=\"footer\"></div></div>";
+
+ $str .= Hmon::MakeFooter();
+ Hmon::WriteFile("QA",$str);
+
+
+ $str = Hmon::MakeTitle(8,5,"Status Summary",1);
+ $str .= "<table>";
+
+ $str .= "<tr><td>Trigger Rate<td>".$store->{'main'}->{'rate'}->{'val'} ;
+
+ if(($store->{'trg'}->{'source'}->{'long'} || '') ne "") {
+ $store->{'trg'}->{'source'}->{'long'} =~ m/sources:\s(.*)/;
+ $str .= "<tr><td>Trigger Source<td>$1";
+ }
+ else {
+ $str .= "<tr><td>Trigger Source<td>N/A";
+ }
+
+ $str .= "</table>";
+ $str .= Hmon::MakeFooter();
+ Hmon::WriteFile("Summary",$str);
+ }
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Data::Dumper;
+use Hmon;
+
+my $fh;
+
+
+my $title = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+ <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <!--<meta http-equiv="refresh" content="60"/>-->
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+ <link href="../files/indexstyles.css" rel="stylesheet" type="text/css"/>
+ <title>Hmon Vertex Reconstruction</title>
+ </head>
+ <body class="index" style="position:relative;background:#d8e8f8;width:850px;margin:auto;padding:120px 0 40px 0">
+ <div style="position:fixed;left:0;top:0;width:100%;height:40px;background:#d8e8f8;box-shadow:none;"></div>
+ <h1 style="position:fixed;top:5px;left:0px;width:100%;display:block;text-align:center;margin:26px 0 0px 0">HADES QA Plots</h1>
+ <div style="position:fixed;left:10px;top:30px;background:#346;padding:10px;margin:-22px 5px 5px 15px;"><img style="background:white;padding:6px 0 6px 0;" src = "../doc/background.png" width=84></div>
+ <div style="position:fixed;right:10px;top:30px;float:right;background:#346;padding:10px;margin:-22px 15px 5px 5px;"><img src = "../doc/link.png" width=84 height=84></div>
+ $;
+
+my $foot = qq$
+ </div>
+ </body>
+ </html>$;
+
+my $out = $title;
+ $out .= qq$
+ <div class="linkbox">
+ <ul>
+ <li><a href="qaplot_Main.htm">Main</a><br>
+ <li><a href="qaplot_Start.htm">Start</a><br>
+ <li><a href="qaplot_RICH.htm">RICH</a><br>
+ <li><a href="qaplot_MDC.htm">MDC</a><br>
+ <li><a href="qaplot_MDCTimes.htm">MDCTimes</a><br>
+ <li><a href="qaplot_MDCTimesRaw.htm">MDCTimesRaw</a><br>
+ <li><a href="qaplot_TOF.htm">TOF</a><br>
+ <li><a href="qaplot_RPC.htm">RPC</a><br>
+ <li><a href="qaplot_Wall.htm">Wall</a><br>
+ <li><a href="qaplot_Shower.htm">Shower</a>
+ <li><a href="qaplot_Physics.htm">Physics</a>
+ </ul></div>
+ <div class="linkbox">
+ <ul><li><a href="../qa">All PDFs</a></ul>
+ $;
+
+$out .= $foot;
+
+open ($fh,"> ".Hmon::HMONDIR."/files/qa.htm") or die;
+print $fh $out;
+close $fh;
+
+my @pages = qw(Main Start RICH MDC MDCTimes MDCTimesRaw TOF RPC Wall Shower Physics);
+
+my $files = {};
+$files->{'Main'} = ["MainPTScaler", "MainTRBNetDebugInfo", "MainTrigger", "MainTriggerTrend"];
+$files->{'Start'} = ["StartMain","StartMultDia1","StartMultDia2","StartMultDia3","StartMultVeto","StartRawTimesDia1","StartRawTimesDia2","StartRawTimesVeto","StartRawWidthDia1","StartRawWidthDia2","StartRawWidthVeto"];
+$files->{'RICH'} = ["RICHCharge","RICHColRow","RICHDirClus","RICHHitMult","RICHMult"];
+$files->{'MDC'} = ["MDCMain","MDCMain2","MDCL0","MDCL1","MDCL2","MDCL3","MDCMboNoise","MDCT0","MDCT1","MDCT2","MDCT3","MDCMb","MDCMboTrend","MDCMbTCal0","MDCMbTCal1","MDCMbTCal2","MDCMbTCal3","MDCCalStat","MDCErrStat"];
+$files->{'MDCTimesRaw'} = ["MDCTimesRaw0","MDCTimesRaw1","MDCTimes2Raw","MDCTimesRaw3","MDCpotatoRawP0","MDCpotatoRawP1","MDCpotatoRawP2","MDCpotatoRawP3"];
+$files->{'MDCTimes'} = ["MDCallChambers","MDCTimes0","MDCTimes1","MDCTimes2","MDCTimes3","MDCpotatoP0","MDCpotatoP1","MDCpotatoP2","MDCpotatoP3"];
+$files->{'TOF'} = ["TOFMain","TOFTDC","TOFADC","TOFHIT"];
+$files->{'RPC'} = ["RPCFeeMboDbo","RPCFeeTrbChannel","RPCFeeTrbMbo","RPCMain","RPCRawChargeDiff","RPCRawColCellMult2","RPCRawColCellMult","RPCRawHitsTrend","RPCRawRPCMult","RPCRawSecMult","RPCRpcHit","RPCRpcShower"];
+$files->{'Wall'} = ["WALLMain","WALLHit","WALLControl","WALLControlLATCH"];
+$files->{'Shower'} = ["SHOWERMain","SHOWERMults","SHOWERCAL","SHOWERSUMS","SHOWERSUMTREND"];
+$files->{'Physics'} = ["PhysBetaMomSys0","PhysBetaMomSys1","PhysMatch","PhysMultCand","PhysMultDist","PhysToTmips","PhysVertex"];
+
+# while(1) {
+
+ foreach my $f (@pages) {
+
+ $out = $title;
+
+
+ for(my $p=0; $p < scalar @{$files->{$f}} ;$p++) {
+ $out .= "<h3>$files->{$f}->[$p]</h3>";
+ $out .= "<div class=\"linkbox\" style=\"width:796px\"><img src=\"../qa/png/$files->{$f}->[$p].png\"></div>";
+ }
+
+ $out .= $foot;
+
+ open ($fh,"> ".Hmon::HMONDIR."/files/qaplot_$f.htm") or next;
+ print $fh $out;
+ close $fh;
+ }
+# sleep(60);
+# }
+
+
\ No newline at end of file
--- /dev/null
+#!/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 $flog = QA::OpenQAFile();
+my @colors = ("#333333","#00ff00","#ff0000","#0000ff","#dddd00","#dd00dd");
+
+my $plot = {
+ name => "RichCurr",
+ file => "files/RichCurr",
+ entries => 240,
+ type => HPlot::TYPE_HISTORY,
+ output => HPlot::OUT_PNG,
+ titles => ["A1","A2","A3","A4","A5","A6"],
+ xlabel => "Seconds",
+ ylabel => "nA",
+ sizex => 950,
+ sizey => 260,
+ curves => 6,
+ xscale => 4,
+ colors => ["#333333","#00ff00","#ff0000","#0000ff","#dddd00","#dd00dd"]};
+HPlot::PlotInit($plot);
+
+my $plot2 = {
+ name => "RichCurrLong",
+ file => "files/RichCurrLong",
+ entries => 300,
+ type => HPlot::TYPE_HISTORY,
+ output => HPlot::OUT_PNG,
+ titles => ["A1","A2","A3","A4","A5","A6"],
+ xlabel => "Minutes",
+ ylabel => "nA",
+ sizex => 950,
+ sizey => 260,
+ curves => 6,
+ xscale => 30,
+ colors => ["#333333","#00ff00","#ff0000","#0000ff","#dddd00","#dd00dd"]};
+HPlot::PlotInit($plot2);
+
+
+
+my $timer = 0;
+my $str = "";
+
+
+for(my $i = 1; $i<=6; $i++) {
+ my $s = sprintf("HAD:RICH:HV:A%i_curr",$i);
+ Perl2Epics::Connect("I$i",$s);
+ $s = sprintf("HAD:RICH:HV:PS:C%i:vmon",$i-1);
+ Perl2Epics::Connect("U$i",$s);
+ }
+
+
+print "Connected.\n";
+
+#OVERCURRENT variables
+my $overcurrent_flag = 0;
+my $OVERCURRENT_YELLOW = 200;
+my $OVERCURRENT_RED = 300;
+
+my $OVERCURRENT_period = 3;
+my $overcurrent_alarm_flag = 0;
+my $current_average = 0;
+my $current_sum = 0;
+
+# Only if the current is larger than OVERCURRENT_PERIOD, the alarm will set off.
+
+
+while(1) {
+ my $data = Perl2Epics::GetAll();
+ $str = Hmon::MakeTitle(12, 13, "RICH HV currents", 1, "");
+ $str .= "<table class=\"rates \">\n";
+ $str .= "<tr><th><th>1<th>2<th>3<th>4<th>5<th>6\n";
+ $str .= "<tr><th>Curr.";
+ for(my $v = 1; $v<=6; $v++) {
+ $str .= sprintf("<td> %i nA\n",$data->{"I$v"}->{val} || -1);
+ }
+ $str .= "<tr><th>Volt.";
+ for(my $v = 1; $v<=6; $v++) {
+ $str .= sprintf("<td> %i V\n",$data->{"U$v"}->{val} || -1);
+ }
+ $str .= "</table>\n";
+ $str .= qq@<img src="%ADDPNG files/RichCurr.png%" type="image/png">\n@;
+ $str .= qq@<img src="%ADDPNG files/RichCurrLong.png%" type="image/png">\n@;
+ $str .= Hmon::MakeFooter();
+
+ Hmon::WriteFile("RichHV", $str);
+
+ $timer++;
+
+ # average over current in sector 1 and 6
+ $current_sum += $data->{"I1"}->{val} + $data->{"I6"}->{val} if(defined $data->{"I1"}->{val} && defined defined $data->{"I6"}->{val});
+ #printf "cur val: %d\n", $data->{"I5"}->{val};
+
+ $current_average = $current_sum / $OVERCURRENT_period / 4 / 2;
+
+ my $qastate = QA::OK;
+ my $value = "";
+ my $longtext = "";
+
+ if( $timer % (4*$OVERCURRENT_period) == 0) {
+ $value = sprintf("%i nA",$current_average);
+ $longtext = sprintf("Averaged current in RICH HV: %i uA",$current_average);
+ #print "current_average: $current_average, sum: $current_sum\n";
+ if($current_average > $OVERCURRENT_RED) {
+ $longtext = "RICH overcurrent, please stop the beam request immediately and call the operators!\n";
+ $qastate = QA::WARN;
+ }
+ elsif ($current_average > $OVERCURRENT_YELLOW) {
+ $longtext = "RICH overcurrent yellow, please watch the beam intensity and be alert to remove the beam request!\n";
+ $qastate = QA::WARN_2;
+ }
+ $current_sum = 0;
+ QA::WriteQALog($flog,"other","rich",30,$qastate,"RICH HV",$value,$longtext);
+ }
+
+ for(my $i = 1; $i<=6;$i++) {
+ HPlot::PlotAdd("RichCurr",$data->{"I$i"}->{val},$i-1);
+
+ }
+ if($timer%8 == 0) {
+ HPlot::PlotDraw("RichCurr");
+ for(my $i = 1; $i<=6;$i++) {
+ HPlot::PlotAdd("RichCurrLong",$data->{"I$i"}->{val},$i-1);
+ }
+ HPlot::PlotDraw("RichCurrLong");
+ }
+
+
+ usleep(250000);
+ }
--- /dev/null
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use Data::Dumper;
+use Hmon;
+use QA;
+use HADES::TrbNet;
+
+my $lastspill = 0;
+my $evtrate = 0;
+my $events = 0;
+my $spilllength = 0;
+my $lastres = 0;
+my $outofspill = 0;
+my @spills;
+my $spillavgshort = 0;
+my $spillavglong = 0;
+
+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;
+ $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", 20, $qastate, "Spill Sum",
+ $qashort, $qalong);
+ $events = 0;
+ $spilllength = 0;
+ }
+
+ $qashort = sprintf(" %i ", $evtrate);
+ $qastate = QA::OK;
+ $qastate = QA::WARN_2 if $evtrate <= 1;
+ $qalong = sprintf("current: %i", $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);
+ }
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use POSIX qw(strftime);
+use FileHandle;
+use Hmon;
+use QA;
+use Getopt::Long;
+
+my $flog = QA::OpenQAFile();
+
+while(1) {
+ my $title = "Wall Clock";
+ my $value = strftime("%H:%M:%S", localtime());
+ my $longtext = "This is a good time to work.";
+ QA::WriteQALog($flog,"main","time",10,QA::OK,$title,$value,$longtext);
+
+ # $title = "Day";
+ # $value = strftime("%a %d.%m.%y", localtime());
+ # $longtext = "Beam time ahead!";
+ # QA::WriteQALog($flog,"main","weekday",60,QA::WARN,$title,$value,$longtext);
+ sleep(2);
+}
--- /dev/null
+#!/usr/bin/perl -w
+use Time::HiRes qw( gettimeofday usleep time );
+use FileHandle;
+use Data::Dumper;
+use POSIX qw/floor ceil/;
+use Hmon;
+use QA;
+
+my $fqa = QA::OpenQAFile();
+
+my $qastate = QA::OK;
+my $lastqastate = QA::OK;
+my $cmd = "trbcmd r 0x8001 0 2>&1";
+my $msg;
+my $status = "OK";
+my @out;
+
+
+
+while(1) {
+ $msg = "";
+ $qastate = QA::NA;
+ $status = "N/A";
+ @out = ("Starting");
+
+ @out = Hmon::qxtimeout($cmd,12);
+
+ foreach my $s (@out) {
+ chomp $s;
+# print $s."\n";
+ if ($s =~ /0x(\w{4})\s+0x(\w{8})/ && $status eq "N/A") {
+ $status = "OK";
+ $qastate = QA::OK;
+ }
+ if ($s =~ /RPC:\s+(.+)/) {
+ $qastate = QA::ERROR+1;
+ $status = "Error";
+ $msg .= " - " unless $msg eq "";
+ $msg .= $1;
+ }
+ if ($s =~ /ERROR:\s+(.+)/) {
+ $qastate = QA::ERROR+2;
+ $status = "Error";
+ $msg .= " - " unless $msg eq "";
+ $msg .= $1;
+ }
+ if ($s =~ /WARNING:\s+(.+)/) {
+ $qastate = QA::WARN_2;
+ $status = "Warning";
+ $msg .= " - " unless $msg eq "";
+ $msg .= $1;
+ }
+ if ($s =~ /qxtimeout/) {
+ $qastate = QA::FATAL;
+ $status = "Timeout";
+ $msg = "trbnetd didn't answer within 12 seconds";
+ }
+ }
+ Hmon::Speak('trbnet',"TRB Network Error") if $qastate > 60;
+ QA::WriteQALog($fqa,"daq","trbnet",3,$qastate,"TrbNet",$status,$msg);
+# print $status;
+ if($lastqastate != $qastate) {
+ $msg =~ s/'//g;
+ system("logger -p local1.info -t DAQ 'Trbnet \<E\> $msg '") if $qastate == QA::FATAL;
+ system("logger -p local1.info -t DAQ 'Trbnet \<W\> $msg '") if $qastate == QA::WARN;
+ }
+ $lastqastate = $qastate;
+ sleep 1;
+ }
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Data::Dumper;
+use Hmon;
+
+my $fh;
+
+while(1) {
+
+ open ($fh,"> ".Hmon::HMONDIR."/files/vertex.htm") or die;
+
+ my $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+ <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+ <head>
+ <meta http-equiv="refresh" content="60"/>
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+ <link href="../files/indexstyles.css" rel="stylesheet" type="text/css"/>
+ <title>Hmon Vertex Reconstruction</title>
+ </head>
+ <body class="index" style="position:relative;background:#d8e8f8;width:1250px;margin:auto;padding:120px 0 40px 0">
+ <div style="position:fixed;left:0;top:0;width:100%;height:40px;background:#d8e8f8;box-shadow:none;"></div>
+ <h1 style="position:fixed;top:5px;left:0px;width:100%;display:block;text-align:center;margin:26px 0 0px 0">HADES Vertex Reconstruction</h1>
+ <div style="position:fixed;left:10px;top:30px;background:#346;padding:10px;margin:-22px 5px 5px 15px;"><img style="background:white;padding:6px 0 6px 0;" src = "../doc/background.png" width=84></div>
+ <div style="position:fixed;right:10px;top:30px;float:right;background:#346;padding:10px;margin:-22px 15px 5px 5px;"><img src = "../doc/link.png" width=84 height=84></div>
+ <h3><a href="../vertex">All files</a></h3>
+ <h3>Latest Files</h3>
+ $;
+
+ $out .= "<table>";
+
+ my $cmd = "ls -rt /home/hadaq/trbsoft/daq/tools/hmon/vertex/target_*be*.jpg | tail -n 5";
+ my @files = qx($cmd);
+ @files = reverse @files;
+
+ $cmd = "ls -rt /home/hadaq/trbsoft/daq/tools/hmon/vertex/targetSum10*be*.jpg | tail -n 5";
+ my @files2 = qx($cmd);
+ @files2 = reverse @files2;
+
+
+ foreach my $i (0..4) {
+ $out .= "<tr><td style='text-align:center'>";
+ my @n = split('/',$files[$i]);
+ chop $n[-1];
+ my ($y,$d,$h,$m,$s) = $n[-1] =~ /.*_[\w-][\w-](\d\d)(\d\d\d)(\d\d)(\d\d)(\d\d)_.*/;
+ $out .= qq@20$y-$d $h:$m:$s<br><div class=\"linkbox\" style=\"width:567px\"><img src="../vertex/$n[-1]" style="padding:10px;background:white;"></div>@;
+ $out .= "<td style='text-align:center'>";
+ @n = split('/',$files2[$i]);
+ chop $n[-1];
+ my ($y1,$d1,$h1,$m1,$s1,$y2,$d2,$h2,$m2,$s2) = $n[-1] =~ /.*_[\w-][\w-](\d\d)(\d\d\d)(\d\d)(\d\d)(\d\d)-[\w-][\w-](\d\d)(\d\d\d)(\d\d)(\d\d)(\d\d).*/;
+ $out .= qq@20$y1-$d1 $h1:$m1:$s1 - $h2:$m2:$s2<br><div class=\"linkbox\" style=\"width:567px\"><img src="../vertex/$n[-1]" style="padding:11px 10px;background:white;"></div>\n@;
+ }
+
+
+ $out .= qq$
+ </table>
+ </body>
+ </html>
+ $;
+
+ print $fh $out;
+ close $fh;
+ sleep(60);
+ }
--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+use HTML::Entities;
+use Hmon;
+use QA;
+
+my $inhibit = 0;
+$SIG{USR1} = sub { $inhibit = 1; };
+$SIG{USR2} = sub { $inhibit = 0; system("killall espeak");}; #system("espeak -ven-male2 -s 130 -g 1 \"Speech daemon is online\" 2>/dev/null");
+
+my $fq = QA::OpenQAFile();
+my $cmd = "./hmon_tail -n 0 -F /home/hadaq/trbsoft/daq/tools/hmon/files/speaklog";
+
+# my $fq = "remote";
+# my $cmd = "./hmon_ssh -T $QA::QAServer \"tail -n 0 -F /home/hadaq/trbsoft/daq/tools/hmon/files/speaklog\" </dev/null";
+
+my $f = fork();
+
+
+if($f) {
+ while(1) {
+ open(FTRB, "$cmd|");
+ while(my $a = <FTRB>) {
+ if ($inhibit == 0) {
+ system("espeak -ven+m2 -s 130 -g 1 \"$a\" 2>/dev/null");
+ }
+ }
+ }
+ }
+else {
+ while(1) {
+ if($inhibit == 0) {
+ QA::WriteQALog($fq, "other", "speech", 120, QA::OK,
+ "Speech Output", "running", "The speech daemon is running.");
+ }
+ else {
+ QA::WriteQALog($fq, "other", "speech", 120, QA::WARN,
+ "Speech Output", "muted", "The speech daemon is muted.");
+ }
+ sleep 60;
+ }
+ }
+
+
--- /dev/null
+#!/bin/bash
+↓
+#Mount RAM file system
+#mount -t tmpfs none /var/spool/ramdisk -o size=256m
+
+#Kill old tunnel, make new one. Better: Check if tunnel still exists, if not restart.
+echo " <Hmon> Renewing tunnels and environment..."
+
+pgrep -f 'hmon_ssh -R 8888' >/dev/null
+if [ $? -eq 1 ]; then
+echo " <Hmon> No tunnel found, digging new one";
+./hmon_ssh -R 8888:hades33.gsi.de:80 cerberus.x-matter.uni-frankfurt.de -N &
+fi
+
+killall speakdaemon.pl
+cd /home/hadaq/trbsoft/daq/tools/hmon/
+
+
+
+ # cd permanent
+ # killall hmon_*.pl 2>/dev/null 1>/dev/null
+ # cd ../
+
+export DAQOPSERVER=hadesp31
+
+sshfs -o allow_other hades-qa@lxhadeb06:/home/hades-qa/online/apr12/vertex/vertex_jpg `pwd`/vertex
+sshfs -o allow_other hades-qa@lxhadeb06:/home/hades-qa/online/apr12/pics `pwd`/qa
+
+echo " <Hmon> Linking files to server..."
+ln -fs `pwd`/archive /srv/www/htdocs/mon/
+ln -fs `pwd`/qa /srv/www/htdocs/mon/
+ln -fs `pwd`/vertex /srv/www/htdocs/mon/
+ln -fs `pwd`/files /srv/www/htdocs/mon/
+ln -fs `pwd`/doc /srv/www/htdocs/mon/
+ln -fs `pwd`/doc.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/monitor.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/monitor2.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/get.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/getqa.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/trbcmd.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/index.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/getpic.cgi /srv/www/htdocs/mon/
+ln -fs `pwd`/mdc.png /srv/www/htdocs/mon/
+ln -fs `pwd`/background.png /srv/www/htdocs/mon/files/
+ln -fs `pwd`/QA.pm /srv/www/htdocs/mon/
+ln -fs `pwd`/styles.css files/
+ln -fs `pwd`/indexstyles.css files/
+#rm ~/trbsoft/daq/tools/hmon/files/*.htt
+
+echo " <Hmon> Starting scripts..."
+ls permanent/hmon_*.pl | perl -ne '
+print "\t\t".$_;
+$c="$_";
+$r=fork();
+push(@l, $r);
+if($r==0) {
+ chomp $c;
+ my @t = split("/",$c);
+ my $cmd = "pgrep -f \"permanent/$t[1]\"";
+ my @qx = qx($cmd);
+ exit if (scalar @qx > 0);
+ system("$c 2>>/home/hadaq/trbsoft/daq/tools/hmon/logs/perlerror_$t[1]");
+ exit;
+ }
+END: {if($r!=0 and eof()) {foreach (@l) {wait}}} ' &
+#
+#print $cmd."\n";
+
+ls hmon_*.pl | perl -ne '
+print "\t\t".$_;
+$c="./$_";
+$r=fork();
+push(@l, $r);
+if($r == 0) {
+ chomp $c;
+ my @t = split("/",$c);
+ system("$c 2>>/home/hadaq/trbsoft/daq/tools/hmon/logs/perlerror_$t[1]");
+ exit;
+ }
+END: {if($r!=0 and eof()) {foreach (@l) {wait}}} ' &
+
+rm ~/trbsoft/daq/tools/hmon/files/note.htt
+
+./speakdaemon.pl 2>>/home/hadaq/trbsoft/daq/tools/hmon/logs/perlerror_speakdaemon &
+
+
+sleep 1;
+# echo " <Hmon> Done."
+
--- /dev/null
+#!/bin/bash
+
+echo " <Hmon> Killing all sub-processes..."
+pkill -f "\./hmon_.+\.pl" 2>/dev/null 1>/dev/null
+killall hmon*.sh 2>/dev/null 1>/dev/null
+killall hmon_tail 2>/dev/null 1>/dev/null
+
+# echo " <Hmon> Cleaning up..."
+# rm ~/trbsoft/daq/tools/hmon/files/*.htt
+echo "<div style='position:absolute;top:5px;left:15px;color:red;font-weight:bold;z-index:100'>Scripts Stopped</div>" > ~/trbsoft/daq/tools/hmon/files/note.htt
+#echo " <Hmon> Done."
+
+
+
--- /dev/null
+#!/bin/bash
+
+killall hmon_permanent_tail
+cd permanent
+killall hmon*.pl 2>/dev/null 1>/dev/null
+cd ../
+./stop.sh;
+
+# echo " <Hmon> Killing all sub-processes..."
+# killall hmon_*.pl 2>/dev/null 1>/dev/null
+# cd qa
+# killall hmon_*.pl 2>/dev/null 1>/dev/null
+# cd ../permanent
+# killall hmon*.sh 2>/dev/null 1>/dev/null
+# cd ..
+# killall hmon_tail 2>/dev/null 1>/dev/null
+# killall hmon_hadplot.sh 2>/dev/null 1>/dev/null
+#
+# echo " <Hmon> Cleaning up..."
+# rm ~/trbsoft/daq/tools/hmon/files/*.htt
+# echo "Scripts Stopped." > ~/trbsoft/daq/tools/hmon/files/note.htt
+# echo " <Hmon> Done."
+
+
+
--- /dev/null
+body {
+ font-family:sans-serif;
+ background:#346;/*#def;*/
+ margin:0px;
+ border:0px;
+ text-align:left;
+ }
+
+body>div>div {
+ float:left;
+ margin: 0px 8px 0px 0;
+ padding: 0 0 0 0 ;
+ border: 1px solid #777;
+ border-width:0 1px 1px 1px;
+ text-align:center;
+ /*box-shadow:1px 1px 4px 4px #eee;/*, inset 3px 3px 3px 3px #eee, inset -3px -3px 3px 3px #eee;*/
+ border-radius: 5px 5px 5px 5px;
+ background:#fff;
+ overflow-y:hidden;
+
+}
+
+
+div.timestamp {
+ font-size:11px;
+ color:#888;
+ width: 70px;
+ height:15px;
+ margin:-3px -70px -15px 0;
+ padding:0 0 0 0;
+ border:none;
+ border-top:3px solid #eee;
+ border-radius:0;
+ text-align:center;
+ overflow:hidden;
+}
+
+div.button {
+ position:absolute;
+ top:0px;
+ height:16px;
+ margin: 0px 8px 8px 0;
+ padding: 0 0 0 0 ;
+ cursor:pointer;
+ font-size:12px;
+ color:#aaa;
+ border: 1px solid #777;
+ border-width:0 1px 1px 1px;
+ border-radius:0 5px 0 5px;
+ text-align:center;
+ background:#444;
+ overflow:hidden;
+ z-index:10;
+}
+
+div.errorstamp {
+ font-size:11px;
+ color:red;
+ font-weight:bold;
+ width: 70px;
+ height:15px;
+ margin:-3px -70px -15px 0;
+ padding:0 0 0 0;
+ border:none;
+ border-top:3px solid #eee;
+ border-radius:0;
+ text-align:center;
+ overflow:hidden;
+}
+
+
+div#content {
+ -moz-transform-origin:0 0;
+ -moz-transform:scale(1);
+}
+
+
+
+/*
+ //plus 24 in width, plus 29 in height for each size step.
+ //base is 70x40, 80x50 with border
+ */
+div.width1 {width:70px;}
+div.width2 {width:150px;}
+div.width3 {width:230px;}
+div.width4 {width:310px;}
+div.width5 {width:390px;}
+div.width6 {width:470px;}
+div.width7 {width:550px;}
+div.width8 {width:630px;}
+div.width9 {width:710px;}
+div.width10 {width:790px;}
+div.width11 {width:870px;}
+div.width12 {width:950px;}
+div.width13 {width:1030px;}
+div.width14 {width:1110px;}
+
+div.height1 {height:40px;}
+div.height2 {height:90px;}
+div.height3 {height:140px;}
+div.height4 {height:190px;}
+div.height5 {height:240px;}
+div.height6 {height:290px;}
+div.height7 {height:340px;}
+div.height8 {height:390px;}
+div.height9 {height:440px;}
+div.height10{height:490px;}
+div.height11{height:540px;}
+div.height12{height:590px;}
+div.height13{height:640px;}
+div.height14{height:690px;}
+div.height15{height:740px;}
+div.height16{height:790px;}
+div.height17{height:840px;}
+div.height18{height:890px;}
+div.height19{height:940px;}
+div.height20{height:990px;}
+div.height21{height:1040px;}
+div.height22{height:1090px;}
+div.height23{height:1140px;}
+div.height24{height:1190px;}
+div.height25{height:1240px;}
+div.height26{height:1290px;}
+
+
+body>div h3{
+ background:#444;
+ padding:0 0 2px 0;
+ margin: 0 0 0 0;
+ color:#eee;
+ border-radius: 5px 5px 0px 0px;
+ font-size: 13px;
+ cursor:default;
+ }
+
+
+
+table {
+ margin:0;
+ padding:0;
+ }
+
+
+.textbox, #logbox {
+ margin:auto;
+ background:white;
+ font-family: monospace;
+ text-align:left;
+ overflow-y:scroll;
+ }
+
+.height9 .textbox { height:420px; }
+.height6 .textbox { height:270px; }
+.height11 .textbox { height:520px; }
+
+table.rates{
+ border-collapse:collapse;
+ margin:0px 5px 0px 5px;
+ font-size:13px;
+ }
+
+table.rates th {
+ padding:0px 5px;
+}
+
+
+table.rates td{
+}
+
+table.rates th+th, table.rates td+th{
+ font-weight:bold;
+ width:90px;
+ border-bottom:1px solid black;
+ border-left: 1px solid black;
+ }
+
+table.rates th+td, table.rates td+td {
+ border-left:1px solid black;
+ padding-right:20px;
+ text-align:right;
+ }
+
+table.rates td.on {
+ color:#000;
+ background:#dfd;
+
+ }
+
+table.rates td.off {
+ color:#000;
+ background:#fdd;
+}
+
+table.rates .linebelow {
+ border-bottom:1px solid black;
+ }
+
+
+table.mdc td.ctr{
+ background-position: 50% 50%;
+ background-image: url('../mdc.png');
+ background-repeat: no-repeat;
+ }
+
+table.mdc, table.scale, table.colorfields {
+ font-family:monospace;
+ border-collapse:collapse;
+ margin:0px 10px;
+ display:inline-block;
+ }
+
+table.mdc tr {
+ height:12px;
+ max-height:12px;
+ }
+
+table.mdc td, table.scale td{
+ width: 11px;
+ height: 13px;
+ max-height:12px !important;
+ overflow:hidden;
+ margin: 0;
+ padding: 0px 0 0px 0;
+ color:white;
+ font-size: 8px;
+ border:1px solid white;
+ text-align:center;
+ }
+
+table.mdc td.ctr {
+ font-size:12px;
+ color:black;
+ }
+
+
+table.scale {
+ display:block;
+ margin: 10px auto 0 auto;
+ }
+
+table.scale td {
+ width:13px;
+ }
+
+table.scale td.label {
+ color:black;
+ width:40px;
+ font-size:10px;
+ text-align:right;
+ }
+
+table.scale td+td+.label {
+ text-align:left;
+ }
+
+
+table.colorfields tr{
+ height:20px;
+ color:black;
+
+ }
+
+table.colorfields td {
+ width:25px;
+ font-size:13px;
+ border:2px solid white;
+ cursor:default;
+ }
+
+table.colorfields th.title {
+/* width:80px; */
+ margin:0 10px 0 0;
+ padding:0;
+ text-align:right;
+}
+
+table.logfile tr>td {
+ width:150px;
+ vertical-align:top;
+}
+
+table.logfile td+td {
+ width:100px;
+}
+
+table.logfile td+td+td {
+ width:1000px;
+ font-family:monospace;
+
+}
+
+table.logfile {
+ width:100%;
+ font-size:12px;
+ font-family:sans-serif;
+ border-collapse:collapse;
+ text-align:left;
+}
+
+table.logfile tr {
+ margin:0;
+ padding:0;
+}
+
+table.hubmon {
+ border-collapse:collapse;
+ border:hidden;
+ background:#222;
+ color:white;
+ font-size:11px;
+ width:100%;
+ height:100%;
+ }
+
+table.hubmon td{
+ border-right:1px solid black;
+ border-left:1px solid black;
+ padding:0 15px 0 10px;
+ vertical-align:top;
+ }
+
+.rd {background-color:#f00; color:black;}
+.rdn {color:#f00;}
+.gr {color:#3d3;}
+.or {color:#fa0;}
+
+.mg {
+ background-color:magenta;
+ color:black;
+}
+
+.wh {
+ color:#ddd;
+}
+
+.bl {
+ color:lightblue;
+}
+
+svg {
+ overflow:hidden;
+ margin:-17px 0px 0px 0;
+ border:0;
+ padding:10px 0 10px 0;
+}
+
+.QA {
+ background:#333;
+ height:100%;
+ width:100%;
+ overflow:hidden;
+
+}
+
+.QA .header {
+ width: 27px;
+ height:25px;
+ border-radius: 0;
+ -moz-transform: rotate(-90deg);
+ margin:12px -6px 0 6px;
+ font-size:10px;
+ padding:0;
+ border:0;
+ color:white;
+ box-shadow:none;
+}
+
+.QA div{
+ width: 100px;
+ height: 35px;
+ padding:2px 0 0 0;
+ margin:3px 0 0 3px;
+ overflow:hidden;
+ font-size:12px;
+ line-height:1.3;
+ border:0px solid #000;
+ border-collapse:collapse;
+ float:left;
+ border-radius:10px 2px 2px 2px;
+ position:relative;
+ color:black;
+ cursor:default;
+/* box-shadow:inset 0px 0px 1px 1px #000; */
+}
+
+.bgn {background:#0d0;}
+.byg {background:#ac0;}
+.bye {background:#ff2;}
+.bor {background:#fa0;}
+.brd {background:#f00; }
+.bgr {background:#000;color:#aaa !important;}
+.bwh {background:#eee;}
+.bmg {background:#f0a ;}
+
+.blinkon .brdb {
+ background:#f00;
+ color:#000;
+ box-shadow: 0px 0px 3px 3px #f31;
+ z-index:5;
+ }
+
+.blinkoff .brdb {
+ background:#000;
+ color:#f33;
+ }
+
+
+.QA .stamp {
+ color:#aaa;
+ font-size:6px;
+ position:absolute;
+ top:2px;
+ right:0px;
+}
+
+.QA .footer {
+ margin:0;
+/* position:absolute; */
+/* left:0; */
+/* bottom:0; */
+ border:none;
+ border-top:1px solid #aaa;
+ border-radius:0;
+ margin-top:10px;
+ color:white;
+ width:100%;
+ height:100px;
+ font-size:13px;
+ box-shadow:none;
+ clear:both;
+}
+
+
+.greenbutton, .redbutton {
+ width: 20px;
+ height:20px;
+ border-radius:10px;
+ margin:5px 0px 5px 30px;
+}
+
+.greenbutton {
+ background:green;
+}
+
+.redbutton {
+ background:red;
+}
+
+table.status td {
+ text-align:center;
+}
+
+table.status th {
+ min-width:60px;
+ padding-top:5px;
+}
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl -w
+use warnings;
+use HTML::Entities;
+print "Content-type: text/html\r\n\r\n";
+my $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<meta http-equiv="refresh" content="$.$delay.qq$">/
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body>
+$;
+
+print $out;
+
+my $param_string = $ENV{"QUERY_STRING"};
+
+my($cmd,$addr,$reg,$val,$opt) = split('-',$param_string);
+
+unless ($cmd =~ /^(r|w|rm|rt|rtm|i|setbit|clearbit|help)$/) {
+ print "No valid command";
+ goto FINISH;
+ }
+
+unless ($addr =~ /^(0x([0-9a-fA-F]){4}|)$/) {
+ print "No valid address";
+ goto FINISH;
+ }
+
+unless ($reg =~ /^(0x([0-9a-fA-F]){4}|[0-9]{1,5}|)$/) {
+ print "No valid register";
+ goto FINISH;
+ }
+
+
+unless ($val =~ /^(0x([0-9a-fA-F]){1,8}|[0-9]{1,8}|)$/) {
+ print "No valid value";
+ goto FINISH;
+ }
+
+unless ($opt =~ /^(0|1|)$/) {
+ print "No valid option";
+ goto FINISH;
+ }
+
+
+
+my $command = "trbcmd $cmd $addr $reg $val $opt";
+print $command."<br>";
+$command = "DAQOPSERVER=hadesp31 /home/hadaq/bin/".$command;
+
+print "<hr><div style = \"margin-left:50px;background:white;width:600px;padding:10px;text-align:left\"><pre>";
+
+# my $fh = open(
+
+my @a = qx($command 2>&1);
+
+foreach my $s (@a) {
+ print $s;
+ }
+print "</pre></div>";
+
+
+FINISH:
+print "</body></html>";
--- /dev/null
+#!/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,"<files/$2.htt");
+ my $str = <$MYF>;
+ close($MYF);
+ $str =~ /width(\d+)\sheight(\d+)/;
+ my $width = 80*$1-8;
+ my $height = 50*$2-8;
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Hmon</title>
+<meta http-equiv="content-type" content="text/html;charset=UTF-8"/>
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+</head>
+<body >
+<script type="text/javascript">
+ document.write("Opening Window...<br>");
+ win = window.open("$.$newurl.qq$","Hmon$.$newurl.qq$","name=Hmon,innerwidth=$.$width.qq$,innerheight=$.$height.qq$,scrollbars=no,status=no,location=no,menubar=no,resizable=no,titlebar=no,dialog=no");
+ if(win) {
+ win.focus();
+ win.document.title="Hmon $.$newurl.qq#";
+ history.back();
+ }
+ else {
+ document.write("Can't open pop-up window. Please disable pop-up blocker. Starting monitor inline...");
+ setTimeout('window.location.href = "$newurl"',3000);
+ }
+</script>
+#;
+
+ } else {
+
+ $out = qq$<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+<link href="files/styles.css" rel="stylesheet" type="text/css"/>
+<link href="files/indexstyles.css" rel="stylesheet" type="text/css"/>
+<title>Hmon $.$ENV{'QUERY_STRING'}.qq$</title>
+</head>
+<body ><!--onmousedown="stoprefresh(0);" onmouseup="stoprefresh(0);" ondblclick="stoprefresh(0);"-->
+$;
+
+
+
+
+ }
+$out .= qq$
+</body>
+</html>
+$;
+
+print $out;
+
jspc29 / hadesdaq.git / commitdiff
