#!/usr/bin/perl -w
+# adjusted for BNET with dabc webserver JAM 2-Oct-2018
use strict;
use warnings;
use Time::HiRes qw( gettimeofday usleep time );
use POSIX qw/floor ceil/;
use Hmon;
use QA;
-use Perl2Epics;
use HADES::TrbNet;
+use LWP::Simple;
+use JSON qw( decode_json );
my $timer = 0;
my $flog = QA::OpenQAFile();
-# my $connect_status = &trb_init_ports();
-# if(!$connect_status) {
-# die("could not connect to trbnetd");
-# }
-
-
-### JAM2018: we have to write this completely new for BNET.
-
-
-
-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 $opt_debug = 0;
+my $opt_verbose =0;
+
+
+my $sources = {
+TRB_0x8800 => "CentralCTS",
+TRB_0x8400 =>"RPC123 ",
+TRB_0x8410 =>"RPC456 ",
+TRB_0x8600 =>"TOF ",
+TRB_0x8700 =>"FW ",
+TRB_0x8880 => "StartTRB3",
+TRB_0x8890 => "VetoTRB3",
+TRB_0x8900 => "Pion1 ",
+TRB_0x8910 => "Pion2 ",
+TRB_0x1000 => "MDC12sec1",
+TRB_0x1010 => "MDC12sec2",
+TRB_0x1020 => "MDC12sec3",
+TRB_0x1030 => "MDC12sec4",
+TRB_0x1040 => "MDC12sec5",
+TRB_0x1050 => "MDC12sec6",
+TRB_0x1100 => "MDC34sec1",
+TRB_0x1110 => "MDC34sec2",
+TRB_0x1120 => "MDC34sec3",
+TRB_0x1130 => "MDC34sec4",
+TRB_0x1140 => "MDC34sec5",
+TRB_0x1150 => "MDC34sec6",
+TRB_0x8a00 => "ECal0 ",
+TRB_0x8a01 => "ECal1 ",
+TRB_0x8a02 => "ECal2 ",
+TRB_0x8a03 => "ECal3 ",
+TRB_0x8a04 => "ECal4 ",
+TRB_0x8a05 => "ECal5 ",
+TRB_0x83c0 => "RICH0 ",
+TRB_0x83c1 => "RICH1 ",
+TRB_0x83c2 => "RICH2 ",
+TRB_0x83c3 => "RICH3 ",
+TRB_0x83c4 => "RICH4 ",
+TRB_0x83c5 => "RICH5 ",
+TRB_0x83c6 => "RICH6 ",
+TRB_0x83c7 => "RICH7 ",
+TRB_0x83c8 => "RICH8 ",
+TRB_0x83c9 => "RICH9 ",
+TRB_0x83ca => "RICHa ",
+TRB_0x83cb => "RICHb "
+};
+
+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);
+
+
+# JAM 2018 here figure out corresponding json calles
+my $masterurl = 'http://lxhadeb07:8099/';
+
+my $url_inputs = $masterurl . 'Master/BNET/Inputs/get.json?field="value"';
+
+#my $url_cts_histo = $masterurl . '/BNET-IN-4/TRB8800_TdcCal/TRB_8800/TRB_8800_TrigType/get.json?field="bins"';
+
+# http://lxhadeb07:8099/BNET-IN-4/TRB8800_TdcCal/TRB_8800/TRB_8800_ErrorBits/get.json?field=%"bins"
+
+
+
+while (1)
+{
+
+ my $store = {};
my $longstring = "";
my $qastate = QA::OK;
my $value = "";
my $maxperc = 0;
my $sumperc = 0;
my $errcnt = 0;
+
+
+
+ my $num_bnetin=0;
+my $inputs = get ($url_inputs);
+#print Dumper $inputs;
+my $inputs_array;
+if (defined $inputs)
+{
+ $inputs_array = decode_json($inputs);
+ $num_bnetin = scalar @$inputs_array;
+}
+
+
+ ## find out how many of the active eventbuilders are actually receiving stuff:
+my $num_act_ins=0;
+for my $inpnode (@$inputs_array) {
+ #print " node is $inpnode \n";
+ # todo: remove FirstLevel from inpnode
+ my $lastslash = rindex($inpnode, "/") + 1;
+ my $nodepath = substr($inpnode, 0, $lastslash);
+ #print "nodepath is $nodepath\n";
+ my $url_nodehierarchy = $masterurl . $nodepath . '/h.json';
+ my $nodehierarchy = get ($url_nodehierarchy);
+ print "\n--------------\n$url_nodehierarchy \n" if $opt_verbose;
+ #print Dumper $nodehierarchy;
+ if (defined $nodehierarchy)
+ {
+ my $inpnode_array = decode_json($nodehierarchy);
+# print Dumper $inpnode_array;
+ my $numchilds = scalar $inpnode_array->{'_childs'};
+ my $i=0; my $j=0; my $k=0;
+ for ($i=0; $i < $numchilds; $i = $i + 1)
+ {
+ last unless (defined $inpnode_array->{'_childs'}[$i]->{'_name'});
+ my $childname= $inpnode_array->{'_childs'}[$i]->{'_name'};
+ print "name $i = $childname \n" if $opt_verbose;
+ if($childname =~ /TRB/)
+ {
+ print "found trb node $childname \n" if $opt_verbose;
+ # scan array of subchildren:
+ my $numsubchilds = scalar $inpnode_array->{'_childs'}[$i]->{'_childs'};
+ for ($j=0; $j < $numsubchilds; $j = $j + 1)
+ {
+ last unless (defined $inpnode_array->{'_childs'}[$i]->{'_childs'}[$j]->{'_name'});
+ my $subchildname = $inpnode_array->{'_childs'}[$i]->{'_childs'}[$j]->{'_name'};
+ if($subchildname =~ /TRB/)
+ {
+ my $numsubsubchilds = scalar @{$inpnode_array->{'_childs'}[$i]->{'_childs'}[$j]->{'_childs'}};
+ print "found subnode $subchildname with $numsubsubchilds childs \n" if $opt_verbose;
+ for ($k=0; $k < $numsubsubchilds; $k = $k + 1)
+ {
+ last unless (defined $inpnode_array->{'_childs'}[$i]->{'_childs'}[$j]->{'_childs'}[$k]->{'_name'});
+ my $subsubchildname = $inpnode_array->{'_childs'}[$i]->{'_childs'}[$j]->{'_childs'}[$k]->{'_name'};
+ print "scanning subsubnode $subsubchildname.. \n" if $opt_verbose;
+ if($subsubchildname =~ /ErrorBits/)
+ {
+ print "found errorbits histogram $subsubchildname \n" if $opt_verbose;
+ my $errorbits_url = "$masterurl$nodepath/$childname/$subchildname/$subsubchildname/get.json?field=\"bins\"";
+ print "url is $errorbits_url \n" if $opt_verbose;
+ my $errorbits = get ($errorbits_url);
+ #print Dumper $errorbits;
+ next unless (defined $errorbits);
+ my $errorbits_array = decode_json($errorbits);
+ foreach my $bit (0 .. 31) {
+ if($errorbits_array->[$bit+4])
+ {
+ $store->{$subchildname}->{$bit}+= $errorbits_array->[$bit+4];
+ $store->{all}->{$bit}+=$errorbits_array->[$bit+4];
+ }
+ }
+ }
+ }
+ }
+ }
+
+ }
+
+ last if($i > 1000);
+ }
+
+ }
+}
+
+print Dumper $store if $opt_verbose;
- foreach my $k (sort keys %$store) {
+# JAM2018 - same as before with epics:
+foreach my $k (sort keys %$store) {
if ($k ne "all") {
foreach my $b (sort keys %{$store->{$k}}) {
if(($b != 0)) {
$sources->{$k},
$store->{$k}->{$b},
$perc,
- @bits[$b]);
- $longstring .= $ts;
-
+ $bits[$b]);
+ $longstring .= $ts;
$brokenevents += $store->{$k}->{$b};
}
}
}
}
$value = sprintf("%s (%.1f%%)",QA::SciNotation($brokenevents), $sumperc);
-
- ## JAM2018: following should be $store->{"all"}->{0} ??????
- $longstring = "Total Events in file: ".($store->{50010}->{0} || "")." - ".
+ $longstring = "Total Events in file: ".($store->{TRB_8800}->{0} || "")." - ".
"Events with errors: ".$value." - ".
$longstring;
chop $longstring;chop $longstring;chop $longstring;
-
+ print "$longstring \n" if $opt_debug;
$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);
- }
+ $qastate, "#Evt w/ errors", $value, $longstring) unless $opt_debug;
+# JAM2018: do we want system log and speaker again?
+ # system("logger -p local1.info -t DAQ 'EB <E> Events with set error-bits written to file: $longstring'") if ($qastate > 60 && !($timer++%60));
+ print 'EB <E> Events with set error-bits written to file: $longstring' if ($opt_debug && $qastate > 60 && !($timer++%60));
+ $timer = 0 if $qastate <= 60;
+ #Hmon::Speak("Eventbuilder receive events with set error bits") if $brokenevents > 1000 && $qastate >= 60;
+
+
+sleep (2);
+}
+
+
+
\ No newline at end of file
jspc29 / hadesdaq.git / commitdiff