From bf0051c63e56912c49d5c56925be9c78b7925803 Mon Sep 17 00:00:00 2001 From: Hadaq Hades Date: Tue, 2 Oct 2018 10:22:21 +0200 Subject: [PATCH] JAM: updated hmon errbits scan --- hmon/permanent/hmon_eberrbits.pl | 279 +++++++++++++++++++------------ 1 file changed, 171 insertions(+), 108 deletions(-) diff --git a/hmon/permanent/hmon_eberrbits.pl b/hmon/permanent/hmon_eberrbits.pl index 2d72350..0d7f65e 100755 --- a/hmon/permanent/hmon_eberrbits.pl +++ b/hmon/permanent/hmon_eberrbits.pl @@ -1,4 +1,5 @@ #!/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 ); @@ -7,104 +8,78 @@ use Data::Dumper; 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 = ""; @@ -112,8 +87,94 @@ my $brokenevents = 0; 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)) { @@ -124,30 +185,32 @@ my $errcnt = 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 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 Events with set error-bits written to file: $longstring'") if ($qastate > 60 && !($timer++%60)); + print 'EB 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 -- 2.43.0