From: Hadaq@CountingHouse Date: Mon, 28 Oct 2013 17:29:45 +0000 (+0100) Subject: added eventbuilder control, cts config and cts monitor X-Git-Tag: pre2018~130 X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=fbb94d6611e65629b41f347fb14c254acc48d692;p=hadesdaq.git added eventbuilder control, cts config and cts monitor --- diff --git a/control/ctsmon/mon_cts.pl b/control/ctsmon/mon_cts.pl new file mode 100755 index 0000000..07ea2c0 --- /dev/null +++ b/control/ctsmon/mon_cts.pl @@ -0,0 +1,2697 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use List::MoreUtils qw(any apply); +use Scalar::Util qw(reftype); +use FileHandle; +use IO::Socket; +use Net::Ping; +use Storable; +use Time::HiRes; +use HADES::TrbNet; + + +use constant TRUE => 1; +use constant FALSE => 0; + +my $glob_trbnet_connected = FALSE; + +use Gtk2 '-init'; + +Gtk2::Rc->parse_string(<<__); +style "normal" { + font_name = "sans 7" + bg[NORMAL] = "#FFFFFF" + fg[NORMAL] = "#000000" +} + +style "yellow" { + font_name = "sans 7" + fg[NORMAL] = "#808000" +} + +style "green" { + font_name = "sans 7" + fg[NORMAL] = "#008000" +} + +style "red" { + font_name = "sans 7" + fg[NORMAL] = "#a00000" +} + +style "blue" { + font_name = "sans 7" + fg[NORMAL] = "#0000ff" +} + +widget "*" style "normal" +widget "*yellow*" style "yellow" +widget "*green*" style "green" +widget "*red*" style "red" +widget "*blue*" style "blue" +__ + + +Gtk2->init; + +my @layout1 = ( + {'INPUT_EN' => ['Start','Veto','TOF','RPC','PT']}, + {'DLY_LARGE' => ['Start','Veto','TOF','RPC','PT']}, + {'DLY_SMALL' => ['Start','Veto','TOF','RPC','PT']}, + {'SCALER_DLY' => ['Start','Veto','TOF','RPC','PT']}, + {'WIDTH' => [ '-', '-','TOF','RPC','PT']}, + {'WIDTH_SMALL' => ['Start','-','-','-','-']}, + {' ' => ['-','-','-','-','-']}, + {'DSC' => ['Start','Veto','Mult','-','PT']}, + + {'WIDTH_M' => [ '-', '-','Mult','-','-']}, + {'SCALER_DSC' => ['Start','Veto','Mult','-','PT']}, + {'GATING_DIS' => ['-' ,'-' ,'Mult','-','PT']}, + {'SCALER_C' => ['-' ,'-' ,'Mult','-','PT']}, + {'OUT_EN' => ['Start','Veto','Mult','-','PT']}, + {'SCALER_OUT' => ['Start','Veto','Mult','-','PT']} + ); + +my @layout2 = ( + {'CAL_TRIG' => ['CAL', 'TRIG']}, + {'BUSY' => ['BUSY_BOX']}, + {'BEAM' => ['BEAM_PROFILE']} + ); + +my @layout_set = ( + 'INPUT_EN', + 'DLY_LARGE', + 'DLY_SMALL', + 'WIDTH', + 'WIDTH_SMALL', + 'DSC', + 'WIDTH_M', + 'GATING_DIS', + 'OUT_EN' + ); + +my @layout2_set = ('CAL_TRIG', + 'BEAM'); +my @layout_cal_set = (); # unticoinsidence +my @layout_trig_set = ('TRIG_RATE'); # unticoinsidence +my @layout_beam_set = (); # unticoinsidence + +my %setup_names = ( 'INPUT_EN' => {'first' => 'INPUT', 'second' => 'ENABLE'}, + 'DLY_LARGE' => {'first' => 'DELAY', 'second' => 'LARGE'}, + 'DLY_SMALL' => {'first' => 'DELAY', 'second' => 'SMALL'}, + 'SCALER_DLY' => {'first' => 'SCALER', 'second' => 'DELAY'}, + 'WIDTH' => {'first' => 'WIDTH', 'second' => ''}, + 'WIDTH_SMALL' => {'first' => 'WIDTH', 'second' => 'SMALL'}, + 'DSC' => {'first' => 'DSC', 'second' => ''}, + 'WIDTH_M' => {'first' => 'WIDTH', 'second' => 'M'}, + 'SCALER_DSC' => {'first' => 'SCALER', 'second' => 'DSC'}, + 'GATING_DIS' => {'first' => 'GAITING', 'second' => 'DISABLE'}, + 'SCALER_C' => {'first' => 'SCALER', 'second' => 'C'}, + 'OUT_EN' => {'first' => 'OUTPUT', 'second' => 'ENABLE'}, + 'SCALER_OUT' => {'first' => 'SCALER', 'second' => 'OUT'}, + ); + +my %setup = ( +'INPUT_EN' => + { 'Start' => + { 'Start0' => { 'addr' => 'C3', 'mask' => '0' }, + 'Start1' => { 'addr' => 'C3', 'mask' => '1' }, + 'Start2' => { 'addr' => 'C3', 'mask' => '2' }, + 'Start3' => { 'addr' => 'C3', 'mask' => '3' }, + 'Start4' => { 'addr' => 'C3', 'mask' => '4' }, + 'Start5' => { 'addr' => 'C3', 'mask' => '5' }, + 'Start6' => { 'addr' => 'C3', 'mask' => '6' }, + 'Start7' => { 'addr' => 'C3', 'mask' => '7' }, + 'Start8' => { 'addr' => 'C4', 'mask' => '4' }, + 'Start9' => { 'addr' => 'C4', 'mask' => '5' }, + 'Starta' => { 'addr' => 'C4', 'mask' => '6' }, + 'Startb' => { 'addr' => 'C4', 'mask' => '7' }, + 'Startc' => { 'addr' => 'C4', 'mask' => '8' }, + 'Startd' => { 'addr' => 'C4', 'mask' => '9' }, + 'Starte' => { 'addr' => 'C4', 'mask' => '10' }, + 'Startf' => { 'addr' => 'C4', 'mask' => '11' }, + }, + + 'Veto' => + { 'Veto0' => { 'addr' => 'C3', 'mask' => '8' }, + 'Veto1' => { 'addr' => 'C3', 'mask' => '9' }, + 'Veto2' => { 'addr' => 'C3', 'mask' => '10' }, + 'Veto3' => { 'addr' => 'C3', 'mask' => '11' }, + 'Veto4' => { 'addr' => 'C3', 'mask' => '12' }, + 'Veto5' => { 'addr' => 'C3', 'mask' => '13' }, + 'Veto6' => { 'addr' => 'C3', 'mask' => '14' }, + 'Veto7' => { 'addr' => 'C3', 'mask' => '15' }, + }, + 'TOF' => + { + 'TOF1' => { 'addr' => 'C3', 'mask' => '16' }, + 'TOF2' => { 'addr' => 'C3', 'mask' => '17' }, + 'TOF3' => { 'addr' => 'C3', 'mask' => '18' }, + 'TOF4' => { 'addr' => 'C3', 'mask' => '19' }, + 'TOF5' => { 'addr' => 'C3', 'mask' => '20' }, + 'TOF6' => { 'addr' => 'C3', 'mask' => '21' }, + }, + 'RPC' => + { + 'RPC1' => { 'addr' => 'C3', 'mask' => '22' }, + 'RPC2' => { 'addr' => 'C3', 'mask' => '23' }, + 'RPC3' => { 'addr' => 'C3', 'mask' => '24' }, + 'RPC4' => { 'addr' => 'C3', 'mask' => '25' }, + 'RPC5' => { 'addr' => 'C3', 'mask' => '26' }, + 'RPC6' => { 'addr' => 'C3', 'mask' => '27' }, + }, + 'PT' => + { + 'PT1' => { 'addr' => 'C3', 'mask' => '28' }, + 'PT2' => { 'addr' => 'C3', 'mask' => '29' }, + 'PT3' => { 'addr' => 'C3', 'mask' => '30' }, + 'PT4' => { 'addr' => 'C3', 'mask' => '31' }, + 'PT5' => { 'addr' => 'C4', 'mask' => '0' }, + 'PT6' => { 'addr' => 'C4', 'mask' => '1' }, + 'PT7' => { 'addr' => 'C4', 'mask' => '2' }, + 'PT8' => { 'addr' => 'C4', 'mask' => '3' }, + + } + }, +'DLY_LARGE' => + { 'Start' => + { 'Start' => { 'addr' => 'DB', 'mask' => '7-0' }, + }, + 'Veto' => + { 'Veto' => { 'addr' => 'DB', 'mask' => '15-8' }, + }, + 'TOF' => + { + 'TOF' => { 'addr' => 'DB', 'mask' => '23-16' }, + }, + 'RPC' => + { + 'RPC' => { 'addr' => 'DB', 'mask' => '31-24' }, + }, + 'PT' => + { + 'PT1' => { 'addr' => 'DC', 'mask' => '7-0' }, + 'PT2' => { 'addr' => 'DC', 'mask' => '15-8' }, + 'PT3' => { 'addr' => 'DC', 'mask' => '23-16' }, + 'PT4' => { 'addr' => 'DC', 'mask' => '31-24' }, + 'PT5' => { 'addr' => 'DD', 'mask' => '7-0' }, + 'PT6' => { 'addr' => 'DD', 'mask' => '15-8' }, + 'PT7' => { 'addr' => 'DD', 'mask' => '23-16' }, + 'PT8' => { 'addr' => 'DD', 'mask' => '31-24' }, + + } + }, +'DLY_SMALL' => + { 'Start' => + { 'Start0' => { 'addr' => 'D1', 'mask' => '3-0' }, + 'Start1' => { 'addr' => 'D1', 'mask' => '7-4' }, + 'Start2' => { 'addr' => 'D1', 'mask' => '11-8' }, + 'Start3' => { 'addr' => 'D1', 'mask' => '15-12' }, + 'Start4' => { 'addr' => 'D1', 'mask' => '19-16' }, + 'Start5' => { 'addr' => 'D1', 'mask' => '23-20' }, + 'Start6' => { 'addr' => 'D1', 'mask' => '27-24' }, + 'Start7' => { 'addr' => 'D1', 'mask' => '31-28' }, + 'Start8' => { 'addr' => 'D6', 'mask' => '3-0' }, + 'Start9' => { 'addr' => 'D6', 'mask' => '7-4' }, + 'Starta' => { 'addr' => 'D6', 'mask' => '11-8' }, + 'Startb' => { 'addr' => 'D6', 'mask' => '15-12' }, + 'Startc' => { 'addr' => 'D6', 'mask' => '19-16'}, + 'Startd' => { 'addr' => 'D6', 'mask' => '23-20'}, + 'Starte' => { 'addr' => 'D6', 'mask' => '27-24'}, + 'Startf' => { 'addr' => 'D6', 'mask' => '31-28'}, + }, + 'Veto' => + { 'Veto0' => { 'addr' => 'D2', 'mask' => '3-0' }, + 'Veto1' => { 'addr' => 'D2', 'mask' => '7-4' }, + 'Veto2' => { 'addr' => 'D2', 'mask' => '11-8' }, + 'Veto3' => { 'addr' => 'D2', 'mask' => '15-12' }, + 'Veto4' => { 'addr' => 'D2', 'mask' => '19-16' }, + 'Veto5' => { 'addr' => 'D2', 'mask' => '23-20' }, + 'Veto6' => { 'addr' => 'D2', 'mask' => '27-24' }, + 'Veto7' => { 'addr' => 'D2', 'mask' => '31-28' }, + }, + 'TOF' => + { 'TOF1' => { 'addr' => 'D3', 'mask' => '3-0' }, + 'TOF2' => { 'addr' => 'D3', 'mask' => '7-4' }, + 'TOF3' => { 'addr' => 'D3', 'mask' => '11-8' }, + 'TOF4' => { 'addr' => 'D3', 'mask' => '15-12' }, + 'TOF5' => { 'addr' => 'D3', 'mask' => '19-16' }, + 'TOF6' => { 'addr' => 'D3', 'mask' => '23-20' }, + }, + 'RPC' => + { 'RPC1' => { 'addr' => 'D3', 'mask' => '27-24' }, + 'RPC2' => { 'addr' => 'D3', 'mask' => '31-28' }, + 'RPC3' => { 'addr' => 'D4', 'mask' => '3-0' }, + 'RPC4' => { 'addr' => 'D4', 'mask' => '7-4' }, + 'RPC5' => { 'addr' => 'D4', 'mask' => '11-8' }, + 'RPC6' => { 'addr' => 'D4', 'mask' => '15-12' }, + }, + 'PT' => + { + 'PT1' => { 'addr' => 'D4', 'mask' => '19-16' }, + 'PT2' => { 'addr' => 'D4', 'mask' => '23-20' }, + 'PT3' => { 'addr' => 'D4', 'mask' => '27-24' }, + 'PT4' => { 'addr' => 'D4', 'mask' => '31-28' }, + 'PT5' => { 'addr' => 'D5', 'mask' => '3-0' }, + 'PT6' => { 'addr' => 'D5', 'mask' => '7-4' }, + 'PT7' => { 'addr' => 'D5', 'mask' => '11-8' }, + 'PT8' => { 'addr' => 'D5', 'mask' => '15-12' }, + }, + }, +'SCALER_DLY' => + { 'Start' => + { 'Start0' => { 'addr' => '08', 'mask' => '31-0' }, + 'Start1' => { 'addr' => '09', 'mask' => '31-0' }, + 'Start2' => { 'addr' => '0A', 'mask' => '31-0' }, + 'Start3' => { 'addr' => '0B', 'mask' => '31-0' }, + 'Start4' => { 'addr' => '0C', 'mask' => '31-0' }, + 'Start5' => { 'addr' => '0D', 'mask' => '31-0' }, + 'Start6' => { 'addr' => '0E', 'mask' => '31-0' }, + 'Start7' => { 'addr' => '0F', 'mask' => '31-0' }, + + 'Start8' => { 'addr' => '67', 'mask' => '31-0' }, + 'Start9' => { 'addr' => '68', 'mask' => '31-0' }, + 'Starta' => { 'addr' => '69', 'mask' => '31-0' }, + 'Startb' => { 'addr' => '6a', 'mask' => '31-0' }, + 'Startc' => { 'addr' => '6b', 'mask' => '31-0' }, + 'Startd' => { 'addr' => '6c', 'mask' => '31-0' }, + 'Starte' => { 'addr' => '6d', 'mask' => '31-0' }, + 'Startf' => { 'addr' => '6e', 'mask' => '31-0' }, + }, + 'Veto' => + { 'Veto0' => { 'addr' => '10', 'mask' => '31-0' }, + 'Veto1' => { 'addr' => '11', 'mask' => '31-0' }, + 'Veto2' => { 'addr' => '12', 'mask' => '31-0' }, + 'Veto3' => { 'addr' => '13', 'mask' => '31-0' }, + 'Veto4' => { 'addr' => '14', 'mask' => '31-0' }, + 'Veto5' => { 'addr' => '15', 'mask' => '31-0' }, + 'Veto6' => { 'addr' => '16', 'mask' => '31-0' }, + 'Veto7' => { 'addr' => '17', 'mask' => '31-0' }, + }, + 'TOF' => + { 'TOF0' => { 'addr' => '18', 'mask' => '31-0' }, + 'TOF1' => { 'addr' => '19', 'mask' => '31-0' }, + 'TOF2' => { 'addr' => '1A', 'mask' => '31-0' }, + 'TOF3' => { 'addr' => '1B', 'mask' => '31-0' }, + 'TOF4' => { 'addr' => '1C', 'mask' => '31-0' }, + 'TOF5' => { 'addr' => '1D', 'mask' => '31-0' }, + }, + 'RPC' => + { 'RPC0' => { 'addr' => '1E', 'mask' => '31-0' }, + 'RPC1' => { 'addr' => '1F', 'mask' => '31-0' }, + 'RPC2' => { 'addr' => '20', 'mask' => '31-0' }, + 'RPC3' => { 'addr' => '21', 'mask' => '31-0' }, + 'RPC4' => { 'addr' => '22', 'mask' => '31-0' }, + 'RPC5' => { 'addr' => '23', 'mask' => '31-0' }, + }, + 'PT' => + { + 'PT0' => { 'addr' => '24', 'mask' => '31-0' }, + 'PT1' => { 'addr' => '25', 'mask' => '31-0' }, + 'PT2' => { 'addr' => '26', 'mask' => '31-0' }, + 'PT3' => { 'addr' => '27', 'mask' => '31-0' }, + 'PT4' => { 'addr' => '28', 'mask' => '31-0' }, + 'PT5' => { 'addr' => '29', 'mask' => '31-0' }, + 'PT6' => { 'addr' => '2a', 'mask' => '31-0' }, + 'PT7' => { 'addr' => '2b', 'mask' => '31-0' }, + + }, + }, + +'WIDTH' => + { + 'TOF' => + { 'TOF1' => { 'addr' => 'E0', 'mask' => '3-0' }, + 'TOF2' => { 'addr' => 'E0', 'mask' => '7-4' }, + 'TOF3' => { 'addr' => 'E0', 'mask' => '11-8' }, + 'TOF4' => { 'addr' => 'E0', 'mask' => '15-12' }, + 'TOF5' => { 'addr' => 'E0', 'mask' => '19-16' }, + 'TOF6' => { 'addr' => 'E0', 'mask' => '23-20' }, + }, + 'RPC' => + { 'RPC1' => { 'addr' => 'E0', 'mask' => '27-24' }, + 'RPC2' => { 'addr' => 'E0', 'mask' => '31-28' }, + 'RPC3' => { 'addr' => 'E1', 'mask' => '3-0' }, + 'RPC4' => { 'addr' => 'E1', 'mask' => '7-4' }, + 'RPC5' => { 'addr' => 'E1', 'mask' => '11-8' }, + 'RPC6' => { 'addr' => 'E1', 'mask' => '15-12' }, + }, + 'PT' => + { + 'PT1' => { 'addr' => 'E1', 'mask' => '19-16' }, + 'PT2' => { 'addr' => 'E1', 'mask' => '23-20' }, + 'PT3' => { 'addr' => 'E1', 'mask' => '27-24' }, + 'PT4' => { 'addr' => 'E1', 'mask' => '31-28' }, + 'PT5' => { 'addr' => 'E2', 'mask' => '3-0' }, + 'PT6' => { 'addr' => 'E2', 'mask' => '7-4' }, + 'PT7' => { 'addr' => 'E2', 'mask' => '11-8' }, + 'PT8' => { 'addr' => 'E2', 'mask' => '15-12' }, + + }, + }, + +'WIDTH_SMALL' => + { 'Start' => { 'Veto_all' => { 'addr' => 'C0', 'mask' => '23-20' } + } + }, + +'DSC' => + { 'Start' => + { 'Start' => { 'addr' => 'C9', 'mask' => '3-0' } + }, + 'Veto' => + { 'Veto' => { 'addr' => 'C9', 'mask' => '7-4' } + }, + 'Mult' => + { 'Mult1' => { 'addr' => 'C9', 'mask' => '11-8' }, + 'Mult2' => { 'addr' => 'C9', 'mask' => '15-12' }, + 'Mult3' => { 'addr' => 'C9', 'mask' => '19-16' }, + 'Mult4' => { 'addr' => 'C9', 'mask' => '23-20' }, + 'Mult5' => { 'addr' => 'C9', 'mask' => '27-24' }, + 'Mult6' => { 'addr' => 'C9', 'mask' => '31-28' }, + 'Mult7' => { 'addr' => 'CA', 'mask' => '3-0' }, + 'Mult8' => { 'addr' => 'CA', 'mask' => '7-4' }, + 'Mult9' => { 'addr' => 'CA', 'mask' => '11-8' }, + }, + 'PT' => + { + 'PT1' => { 'addr' => 'CA', 'mask' => '15-12' }, + 'PT2' => { 'addr' => 'CA', 'mask' => '19-16' }, + 'PT3' => { 'addr' => 'CA', 'mask' => '23-20' }, + 'PT4' => { 'addr' => 'CA', 'mask' => '27-24' }, + 'PT5' => { 'addr' => 'CA', 'mask' => '31-28' }, + 'PT6' => { 'addr' => 'CB', 'mask' => '3-0' }, + 'PT7' => { 'addr' => 'CB', 'mask' => '7-4' }, + 'PT8' => { 'addr' => 'CB', 'mask' => '11-8' }, + } + }, +'WIDTH_M' => + { 'Mult' => + { 'Mult1' => { 'addr' => 'DE', 'mask' => '3-0' }, + 'Mult2' => { 'addr' => 'DE', 'mask' => '7-4' }, + 'Mult3' => { 'addr' => 'DE', 'mask' => '11-8' }, + 'Mult4' => { 'addr' => 'DE', 'mask' => '15-12' }, + 'Mult5' => { 'addr' => 'DE', 'mask' => '19-16' }, + 'Mult6' => { 'addr' => 'DE', 'mask' => '23-20' }, + 'Mult7' => { 'addr' => 'DE', 'mask' => '27-24' }, + 'Mult8' => { 'addr' => 'DE', 'mask' => '31-28' }, + 'Mult9' => { 'addr' => 'DF', 'mask' => '3-0' } + }, + }, +'SCALER_DSC' => + { 'Start' => + { 'Start' => { 'addr' => '2C', 'mask' => '31-0' }, + }, + 'Veto' => + { 'Veto' => { 'addr' => '2D', 'mask' => '31-0' }, + }, + 'Mult' => + { 'Mult1' => { 'addr' => '2E', 'mask' => '31-0'}, + 'Mult2' => { 'addr' => '2F', 'mask' => '31-0'}, + 'Mult3' => { 'addr' => '30', 'mask' => '31-0'}, + 'Mult4' => { 'addr' => '31', 'mask' => '31-0'}, + 'Mult5' => { 'addr' => '32', 'mask' => '31-0'}, + 'Mult6' => { 'addr' => '33', 'mask' => '31-0'}, + 'Mult7' => { 'addr' => '34', 'mask' => '31-0'}, + 'Mult8' => { 'addr' => '35', 'mask' => '31-0'}, + 'Mult9' => { 'addr' => '36', 'mask' => '31-0'}, + }, + + 'PT' => + { + 'PT0' => { 'addr' => '37', 'mask' => '31-0' }, + 'PT1' => { 'addr' => '38', 'mask' => '31-0' }, + 'PT2' => { 'addr' => '39', 'mask' => '31-0' }, + 'PT3' => { 'addr' => '3A', 'mask' => '31-0' }, + 'PT4' => { 'addr' => '3B', 'mask' => '31-0' }, + 'PT5' => { 'addr' => '3C', 'mask' => '31-0' }, + 'PT6' => { 'addr' => '3D', 'mask' => '31-0' }, + 'PT7' => { 'addr' => '3E', 'mask' => '31-0' }, + }, + }, +'GATING_DIS' => + { + 'Mult' => + { 'Mult1' => { 'addr' => 'C5', 'mask' => '0'}, + 'Mult2' => { 'addr' => 'C5', 'mask' => '1'}, + 'Mult3' => { 'addr' => 'C5', 'mask' => '2'}, + 'Mult4' => { 'addr' => 'C5', 'mask' => '3'}, + 'Mult5' => { 'addr' => 'C5', 'mask' => '4'}, + 'Mult6' => { 'addr' => 'C5', 'mask' => '5'}, + 'Mult7' => { 'addr' => 'C5', 'mask' => '6'}, + 'Mult8' => { 'addr' => 'C5', 'mask' => '7'}, + 'Mult9' => { 'addr' => 'C5', 'mask' => '8'}, + }, + 'PT' => + { + 'PT0' => { 'addr' => 'C5', 'mask' => '9' }, + 'PT1' => { 'addr' => 'C5', 'mask' => '10' }, + 'PT2' => { 'addr' => 'C5', 'mask' => '11' }, + 'PT3' => { 'addr' => 'C5', 'mask' => '12' }, + 'PT4' => { 'addr' => 'C5', 'mask' => '13' }, + 'PT5' => { 'addr' => 'C5', 'mask' => '14' }, + 'PT6' => { 'addr' => 'C5', 'mask' => '15' }, + 'PT7' => { 'addr' => 'C5', 'mask' => '16' }, + }, + }, + +'OUT_EN' => + { 'Start' => + { 'Start' => { 'addr' => 'C7', 'mask' => '0' }, + }, + 'Veto' => + { 'Veto' => { 'addr' => 'C7', 'mask' => '1' }, + }, + 'Mult' => + { 'Mult1' => { 'addr' => 'C7', 'mask' => '2'}, + 'Mult2' => { 'addr' => 'C7', 'mask' => '3'}, + 'Mult3' => { 'addr' => 'C7', 'mask' => '4'}, + 'Mult4' => { 'addr' => 'C7', 'mask' => '5'}, + 'Mult5' => { 'addr' => 'C7', 'mask' => '6'}, + 'Mult6' => { 'addr' => 'C7', 'mask' => '7'}, + 'Mult7' => { 'addr' => 'C7', 'mask' => '8'}, + 'Mult8' => { 'addr' => 'C7', 'mask' => '9'}, + 'Mult9' => { 'addr' => 'C7', 'mask' => '10'}, + }, + 'PT' => + { + 'PT0' => { 'addr' => 'C7', 'mask' => '11' }, + 'PT1' => { 'addr' => 'C7', 'mask' => '12' }, + 'PT2' => { 'addr' => 'C7', 'mask' => '13' }, + 'PT3' => { 'addr' => 'C7', 'mask' => '14' }, + 'PT4' => { 'addr' => 'C7', 'mask' => '15' }, + 'PT5' => { 'addr' => 'C7', 'mask' => '16' }, + 'PT6' => { 'addr' => 'C7', 'mask' => '17' }, + 'PT7' => { 'addr' => 'C7', 'mask' => '18' }, + + }, + }, +'SCALER_C' => + { 'Mult' => + { 'Mult1' => { 'addr' => '52', 'mask' => '31-0'}, + 'Mult2' => { 'addr' => '53', 'mask' => '31-0'}, + 'Mult3' => { 'addr' => '54', 'mask' => '31-0'}, + 'Mult4' => { 'addr' => '55', 'mask' => '31-0'}, + 'Mult5' => { 'addr' => '56', 'mask' => '31-0'}, + 'Mult6' => { 'addr' => '57', 'mask' => '31-0'}, + 'Mult7' => { 'addr' => '58', 'mask' => '31-0'}, + 'Mult8' => { 'addr' => '59', 'mask' => '31-0'}, + 'Mult9' => { 'addr' => '5A', 'mask' => '31-0'}, + }, + 'PT' => + { + 'PT0' => { 'addr' => '5B', 'mask' => '31-0' }, + 'PT1' => { 'addr' => '5C', 'mask' => '31-0' }, + 'PT2' => { 'addr' => '5D', 'mask' => '31-0' }, + 'PT3' => { 'addr' => '5E', 'mask' => '31-0' }, + 'PT4' => { 'addr' => '5F', 'mask' => '31-0' }, + 'PT5' => { 'addr' => '60', 'mask' => '31-0' }, + 'PT6' => { 'addr' => '61', 'mask' => '31-0' }, + 'PT7' => { 'addr' => '62', 'mask' => '31-0' }, + }, + }, + +'SCALER_OUT' => + { 'Start' => + { 'Start' => { 'addr' => '3F', 'mask' => '31-0' }, + }, + 'Veto' => + { 'Veto' => { 'addr' => '40', 'mask' => '31-0' }, + }, + 'Mult' => + { 'Mult1' => { 'addr' => '41', 'mask' => '31-0'}, + 'Mult2' => { 'addr' => '42', 'mask' => '31-0'}, + 'Mult3' => { 'addr' => '43', 'mask' => '31-0'}, + 'Mult4' => { 'addr' => '44', 'mask' => '31-0'}, + 'Mult5' => { 'addr' => '45', 'mask' => '31-0'}, + 'Mult6' => { 'addr' => '46', 'mask' => '31-0'}, + 'Mult7' => { 'addr' => '47', 'mask' => '31-0'}, + 'Mult8' => { 'addr' => '48', 'mask' => '31-0'}, + 'Mult9' => { 'addr' => '49', 'mask' => '31-0'}, + }, + 'PT' => + { + 'PT0' => { 'addr' => '4A', 'mask' => '31-0' }, + 'PT1' => { 'addr' => '4B', 'mask' => '31-0' }, + 'PT2' => { 'addr' => '4C', 'mask' => '31-0' }, + 'PT3' => { 'addr' => '4D', 'mask' => '31-0' }, + 'PT4' => { 'addr' => '4E', 'mask' => '31-0' }, + 'PT5' => { 'addr' => '4F', 'mask' => '31-0' }, + 'PT6' => { 'addr' => '50', 'mask' => '31-0' }, + 'PT7' => { 'addr' => '51', 'mask' => '31-0' }, + }, + }, + +'CAL_TRIG' => + { + 'CAL' => + { + 'MDC_CAL_EN' => { 'addr' => 'C0', 'mask' => '5'}, + 'SHW_CAL_EN' => { 'addr' => 'C0', 'mask' => '8'}, + 'SHW_PED_DIS' => { 'addr' => 'C0', 'mask' => '7'}, + 'DEBUG_EN' => { 'addr' => 'C0', 'mask' => '9'}, + 'BEAM_INH_EN' => { 'addr' => 'C0', 'mask' => '14'}, + + }, + 'TRIG' => + { + 'PULSER' => { 'addr' => 'E3', 'mask' => '27-0'}, + 'OWN_TYPE_EN' => { 'addr' => 'C0', 'mask' => '4'}, + 'OWN_TYPE' => { 'addr' => 'C0', 'mask' => '3-0'}, + 'MDCA_DELAY' => { 'addr' => 'C1', 'mask' => '21-17'}, + 'MDCB_DELAY' => { 'addr' => 'C1', 'mask' => '16-12'}, + 'MULT_SAMPLE' => { 'addr' => 'C1', 'mask' => '3-0'}, + 'TRIG_WIDTH' => { 'addr' => 'C1', 'mask' => '31-28'}, + 'TRIG_RATE' => { 'addr' => '01', 'mask' => '19-0'}, + 'LVL1_INFO' => { 'addr' => 'e4', 'mask' => '13-0'}, + 'EB_LUT' => { 'addr' => 'f0', 'mask' => '15-0'}, + 'EB_EVENTS' => { 'addr' => 'f1', 'mask' => '24-0'}, + 'START_SEL_X' => { 'addr' => 'da', 'mask' => '7-6'}, + 'START_SEL_Y' => { 'addr' => 'da', 'mask' => '9-8'}, + 'ANTI_COINC' => { 'addr' => 'c0', 'mask' => '17-16'}, + }, + }, +'BUSY' => + { + 'BUSY_BOX' => + { + 'LVL1_CTS' => { 'addr' => '00', 'mask' => '20'}, + 'LVL1_TRBENT' => { 'addr' => '00', 'mask' => '21'}, + 'LVL1_LOCAL' => { 'addr' => '00', 'mask' => '22'}, + 'LVL2_CTS' => { 'addr' => '01', 'mask' => '20'}, + 'LVL2_TRBNET' => { 'addr' => '01', 'mask' => '21'}, + 'LVL2_LOCAL' => { 'addr' => '01', 'mask' => '22'}, + 'LVL1-LVL2' => { 'addr' => '01', 'mask' => '31-24'}, + 'LVL1_NUMBER' => { 'addr' => '00', 'mask' => '15-0'}, + 'LVL1_RND' => { 'addr' => '00', 'mask' => '31-24'}, + }, + }, +'BEAM' => + { + 'BEAM_PROFILE' => + { + 'SAMPLE_OFFSET' => { 'addr' => 'C6', 'mask' => '31-0'}, + 'SAMPLE_PERIOD' => { 'addr' => 'C8', 'mask' => '31-0'}, + 'BEAM_LENGTH' => { 'addr' => 'D9', 'mask' => '31-0'}, + 'MULTIPLEX_A' => { 'addr' => 'C2', 'mask' => '7-0'}, + 'MULTIPLEX_B' => { 'addr' => 'C2', 'mask' => '15-8'}, + 'START_V_SEL' => { 'addr' => 'da', 'mask' => '1-0'}, + 'START_H_SEL' => { 'addr' => 'da', 'mask' => '3-2'}, + + }, + }, +); + +my $opt_help = 0; +my $opt_etrax = "etraxp058"; +my $opt_log = 1; +my $opt_mode = "mon"; +my $opt_access = "trbcmd"; # access method: trbcmd/command_server +my $errorType = ""; + +GetOptions ('h|help' => \$opt_help, + 'e|etrax=s' => \$opt_etrax, + 'l|log' => \$opt_log, + 'm|mode=s' => \$opt_mode, + 'a|access=s' => \$opt_access); + +if( $opt_help ) { + &help(); + exit(0); +} + +my $names_href = \%setup_names; +my $setup_href = \%setup; +my @regs2read; +my $regs2read_aref = \@regs2read; +my %regsVals; +my $regsVals_href = \%regsVals; + +my $cmd_base = "rw_trbv2 --addon r 0"; +my $cmd_base_w = "rw_trbv2 --addon w 0"; +my $trb_cmd1 = "/home/hadaq/bin/trbcmd rm 0x0003 0xa000 111 0"; +my $trb_cmd2 = "/home/hadaq/bin/trbcmd rm 0x0003 0xa0c0 52 0"; # read 52 registers starting from a0c0 +#my $cmd_base = "rwv2_addon r 0"; +my $opt_verb = 0; + +my $cmd_server_port = 4712; +my $cmd_server_prtcl = 'tcp'; +my $cmd_server_answer = ""; + +my $log = "/tmp/log_mon_cts.txt"; + +#--- graphics +my $Gtk2_window = Gtk2::Window->new('toplevel'); + +my $Gtk2_table = Gtk2::Table->new( 34, 11, TRUE ); # Rows, Columns +my $Gtk2_table_cal = Gtk2::Table->new( 34, 2, TRUE ); # Rows, Columns +my $Gtk2_table_trig = Gtk2::Table->new( 12, 2, TRUE ); # Rows, Columns +my $Gtk2_table_busy = Gtk2::Table->new( 10, 2, TRUE ); # Rows, Columns +my $Gtk2_table_msg = Gtk2::Table->new( 1, 1, TRUE ); # Rows, Columns +my $Gtk2_table_beam = Gtk2::Table->new( 9, 2, TRUE ); # Rows, Columns + +my $Gtk2_vbox_all = Gtk2::VBox->new(FALSE, 5); +my $Gtk2_hbox = Gtk2::HBox->new(FALSE, 5); +my $Gtk2_hbox2 = Gtk2::HBox->new(FALSE, 5); +my $Gtk2_vbox = Gtk2::VBox->new(FALSE, 5); + +my $Gtk2_frame_main = Gtk2::Frame->new('Main'); +my $Gtk2_frame_cal = Gtk2::Frame->new('Calib'); +my $Gtk2_frame_trig = Gtk2::Frame->new('Trigger'); +my $Gtk2_frame_busy = Gtk2::Frame->new('Busy'); +my $Gtk2_frame_msg = Gtk2::Frame->new('Message'); +my $Gtk2_frame_beam = Gtk2::Frame->new('Beam profile'); + +my $Gtk2_errmsg_lbl; + +my $button_set = Gtk2::Widget->new("Gtk2::Button", + label=>"SET REG"); +$button_set->signal_connect(clicked=>\&set_window, [$regsVals_href]); + +my $button_ctrl = Gtk2::Button->new("SAVE/LOAD"); +$button_ctrl->signal_connect(pressed => \&ctrlWindow); + +my $button_startup = Gtk2::Button->new("\@STARTUP"); +$button_startup->signal_connect(pressed => \&cp2startup); + +if( $opt_mode eq "mon" ){ + &Gtk2_init(); + &Gtk2_setRowTitles(); + &Gtk2_makeTable_main(); + &Gtk2_makeTable_cal(); + &Gtk2_makeTable_trig(); + &Gtk2_makeTable_busy(); + &Gtk2_makeTable_msg(); + &Gtk2_makeTable_beam(); +} +elsif( $opt_mode eq "set" ){ + &Gtk2_init(); + &Gtk2_setRowTitles(); + &Gtk2_makeTable_main_set(); + &Gtk2_makeTable_cal_set(); + &Gtk2_makeTable_trig_set(); + &Gtk2_makeTable_msg(); + &Gtk2_makeTable_beam_set(); + #&Gtk2_button_ctrl(); +} +else{ + print "Unknown option $opt_mode. Exit.\n" if( defined $opt_mode ); + print "Undefined option opt_mode. Exit.\n" unless( defined $opt_mode ); + exit(1); +} + +$Gtk2_frame_main->add($Gtk2_table); +$Gtk2_frame_cal->add($Gtk2_table_cal); +$Gtk2_frame_trig->add($Gtk2_table_trig); +$Gtk2_frame_busy->add($Gtk2_table_busy); +$Gtk2_frame_msg->add($Gtk2_table_msg); +$Gtk2_frame_beam->add($Gtk2_table_beam); + +$Gtk2_vbox->pack_start($Gtk2_frame_cal, FALSE, FALSE, 0); +$Gtk2_vbox->pack_start($Gtk2_frame_trig, FALSE, FALSE, 0); +$Gtk2_vbox->pack_start($Gtk2_frame_busy, FALSE, FALSE, 0) if($opt_mode eq "mon"); +$Gtk2_vbox->pack_start($Gtk2_frame_beam, FALSE, FALSE, 0); + +$Gtk2_hbox->pack_start($Gtk2_frame_main, FALSE, FALSE, 0); +$Gtk2_hbox->pack_start($Gtk2_vbox, FALSE, FALSE, 0); + +$Gtk2_hbox2->pack_start($Gtk2_frame_msg, FALSE, FALSE, 0); +$Gtk2_hbox2->pack_start($button_set, FALSE, FALSE, 0); +$Gtk2_hbox2->pack_start($button_ctrl, FALSE, FALSE, 0) if($opt_mode eq "set"); +$Gtk2_hbox2->pack_start($button_startup, FALSE, FALSE, 0) if($opt_mode eq "set"); + +$Gtk2_vbox_all->pack_start($Gtk2_hbox, FALSE, FALSE, 0); +$Gtk2_vbox_all->pack_start($Gtk2_hbox2, FALSE, FALSE, 0); +#$Gtk2_vbox_all->pack_start($Gtk2_frame_msg, FALSE, FALSE, 0); + +$Gtk2_window->add($Gtk2_vbox_all); +$Gtk2_window->show_all; + +my @regs_array = (); +my $shellScriptName = "read_regs_" . $$ . ".sh"; + +if($opt_access eq "cmdsrv"){ + &getRegs2read($regs2read_aref); + &writeShellScript($regs2read_aref); +} + +if($opt_mode eq "set"){ + if($opt_access eq "cmdsrv"){ + &connectCmdServer2("/home/hadaq/tmp/$shellScriptName", + $opt_etrax, $cmd_server_port, $cmd_server_prtcl, \@regs_array); + &readArray(\@regs_array); + } + elsif($opt_access eq "trbcmd"){ + &readRegs_trbcmd(); + } + else{ + print "Wrong option -a|--access: $opt_access. Exit.\n"; + exit(0); + } +} + +while(1) { + if($opt_mode eq "mon"){ + if($opt_access eq "cmdsrv"){ + if($opt_log){ + &connectCmdServer("/home/hadaq/tmp/$shellScriptName", + $opt_etrax, $cmd_server_port, $cmd_server_prtcl, $log); + &readLog($log); + } + else{ + &connectCmdServer2("/home/hadaq/tmp/$shellScriptName", + $opt_etrax, $cmd_server_port, $cmd_server_prtcl, \@regs_array); + &readArray(\@regs_array); + } + } + elsif($opt_access eq "trbcmd"){ + &readRegs_trbcmd(); + } + else{ + print "Wrong option -a|--access: $opt_access. Exit.\n"; + exit(0); + } + + &fillVals2hash(); + } + + + if($opt_mode eq "mon") { + for (1..2) { + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } + Gtk2::Gdk->flush; + select (undef,undef,undef,0.45); + } + } + else { # faster for interactive input + for (1..20) { + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } + Gtk2::Gdk->flush; + select (undef,undef,undef,0.05); + } + } + + + } + +exit(0); + +###################### END OF MAIN #################### + +sub help() +{ + print "\n"; + print << 'EOF'; +mon_cts.pl + + This script connects to the CTS via command_server ot trbcmd and + reads the content of the registers specified in the hash at the beginning + of this script. + +Usage: + + Command line: mon_cts.pl + [-h|--help] : Show this help. + [-e|--etrax name] : CTS Etrax name (default: etraxp058). + [-l|--log] : Store the output of command_server in log file, + works only with --access cmdsrv + (default: read directly to an array). + [-a|--access ] : Access method (default: trbcmd). + +Example: + + Monitor local CTS which runs on etrax109: + mon_cts.pl -e etrax109 + +EOF +} + +sub Gtk2_init() +{ + #- Make window + $Gtk2_window->signal_connect(destroy => sub { Gtk2->main_quit; }); + $Gtk2_window->signal_connect(delete_event => sub { exit; }); + $Gtk2_window->set_title("CTS Monitor"); + $Gtk2_window->set_border_width(5); +} + +sub Gtk2_makeTable_main() +{ + my $lable; + my $l = 2; + my $r = 3; + my $t = 0; + my $b = 1; + + foreach my $href (@layout1){ + + #- Loop over Columns + foreach my $var ( sort keys %$href ) { + + $t = 0; + $b = 1; + + if( $var eq "WIDTH_SMALL"){ + $l++; + $r++; + } + + my $ext = $l . $r . $t . $b; + + $lable = Gtk2::Label->new($names_href->{$var}->{'first'}); + $lable->set_name("green".$ext); + $Gtk2_table->attach($lable, $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $t++; + $b++; + + $lable = Gtk2::Label->new($names_href->{$var}->{'second'}); + $lable->set_name("green".$ext); + $Gtk2_table->attach($lable, $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $sys (@{$href->{$var}}){ + + &shiftIndex($var, $sys, \$t, \$b); + + #- Loop over Rows + foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ + $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} = Gtk2::Label->new(); + + $t++; + $b++; + $Gtk2_table->attach($setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}, + $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + + my $addr = lc($setup_href->{$var}->{$sys}->{$subsys}->{'addr'}); + } + } + + $l++; + $r++; + } + } + +# foreach my $href (@layout2){ +# foreach my $var ( sort keys %$href ) { +# foreach my $sys (@{$href->{$var}}){ +# foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ +# $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} = Gtk2::Label->new(); +# } +# } +# } +# } + + $Gtk2_table->set_col_spacings(1); + $Gtk2_table->set_homogeneous(0); +} + +sub Gtk2_setRowTitles() +{ + my $lable; + + $lable = Gtk2::Label->new('Start X'); + $lable->set_name("blue".1); + $Gtk2_table->attach($lable, 0, 1, 2, 3, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('Start Y'); + $lable->set_name("blue".1); + $Gtk2_table->attach($lable, 0, 1, 10, 11, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('Veto'); + $lable->set_name("blue".2); + $Gtk2_table->attach($lable, 0, 1, 18, 19, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('TOF'); + $lable->set_name("blue".3); + $Gtk2_table->attach($lable, 0, 1, 26, 27, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('RPC'); + $lable->set_name("blue".4); + $Gtk2_table->attach($lable, 0, 1, 32, 33, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('PT'); + $lable->set_name("blue".5); + $Gtk2_table->attach($lable, 0, 1, 38, 39, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $i (1..8){ + $lable = Gtk2::Label->new($i); + my $ext = 1 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+1, $i+2, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + + foreach my $i (1..8){ + $lable = Gtk2::Label->new($i); + my $ext = 1 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+9, $i+10, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + + foreach my $i (1..8){ + $lable = Gtk2::Label->new($i); + my $ext = 2 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+17, $i+18, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + foreach my $i (1..6){ + $lable = Gtk2::Label->new($i); + my $ext = 3 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+25, $i+26, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + foreach my $i (1..6){ + $lable = Gtk2::Label->new($i); + my $ext = 4 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+31, $i+32, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + foreach my $i (1..8){ + $lable = Gtk2::Label->new($i); + my $ext = 5 . $i; $lable->set_name("blue".$ext); + $Gtk2_table->attach($lable, 1, 2, $i+37, $i+38, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + + #--- Another column with row titles before 'DSC' + + my $l = 9; + my $r = 10; + + if( $opt_mode eq "set" ){ + $l = 6; + $r = 7; + } + + $lable = Gtk2::Label->new('Start all'); + $lable->set_name("blue".1); + $Gtk2_table->attach($lable, $l, $r, 2, 3, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('Veto width'); + $lable->set_name("blue".1); + $Gtk2_table->attach($lable, $l, $r, 5, 6, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('for Start'); + $lable->set_name("blue".1); + $Gtk2_table->attach($lable, $l, $r, 6, 7, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('Veto all'); + $lable->set_name("blue".2); + $Gtk2_table->attach($lable, $l, $r, 18, 19, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $i (18..23){ + my $multNr = $i - 17; + my $mult = "mult " . $multNr; + $lable = Gtk2::Label->new($mult); + $lable->set_name("blue".3); + $Gtk2_table->attach($lable, $l, $r, $i+8, $i+1+8, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + } + + $lable = Gtk2::Label->new('m2 no neigh'); + $lable->set_name("blue".3); + $Gtk2_table->attach($lable, $l, $r, 32, 33, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('m3 no neigh'); + $lable->set_name("blue".3); + $Gtk2_table->attach($lable, $l, $r, 33, 34, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $lable = Gtk2::Label->new('m2 opp sect'); + $lable->set_name("blue".3); + $Gtk2_table->attach($lable, $l, $r, 34, 35, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); +} + +sub shiftIndex() +{ + my ($var, $sys, $t, $b) = @_; + + if($var eq "DLY_LARGE" && ($sys eq "Veto")){ + $$t = $$t + 16 - 1; + $$b = $$b + 16 - 1; + } + elsif($var eq "DLY_LARGE" && ($sys eq "TOF")){ + $$t = $$t + 8 - 1; + $$b = $$b + 8 - 1; + } + + elsif($var eq "DLY_LARGE" && ($sys eq "RPC" || $sys eq "PT")){ + $$t = $$t + 6 - 1; + $$b = $$b + 6 - 1; + } + elsif( ($var eq "DSC" || $var eq "SCALER_DSC" || $var eq "OUT_EN" || $var eq "SCALER_OUT" ) && + ($sys eq "Veto")){ + $$t = $$t + 16 - 1; + $$b = $$b + 16 - 1; + } + elsif( ($var eq "DSC" || $var eq "SCALER_DSC" || $var eq "OUT_EN" || $var eq "SCALER_OUT" ) && + ($sys eq "Mult")){ + $$t = $$t + 8 - 1; + $$b = $$b + 8 - 1; + } + + + elsif( ($var eq "DSC" || $var eq "SCALER_DSC" || $var eq "OUT_EN" || + $var eq "SCALER_OUT" || $var eq "GATING_DIS" || $var eq "SCALER_C") && $sys eq "PT"){ + $$t = $$t + 3; + $$b = $$b + 3; + } + elsif( ($var eq "GATING_DIS" || $var eq "WIDTH_M" || $var eq "WIDTH" || $var eq "SCALER_C") && + ($sys eq "Mult" || $sys eq "TOF")){ + $$t = $$t + 24; + $$b = $$b + 24; + } + elsif( $var eq "WIDTH_SMALL" ){ + $$t = $$t + 4; + $$b = $$b + 4; + } +} + +sub Gtk2_makeTable_cal() +{ + my $lable; + my $entry; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('CAL'); + #$lable->set_name("green".1); + #$Gtk2_table_cal->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'CAL_TRIG'}->{'CAL'}}){ + my $ext = $l . $r . $t . $b; + + $lable = Gtk2::Label->new($subsys); + $lable->set_name("blue".$ext); + $Gtk2_table_cal->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'CAL_TRIG'}->{'CAL'}->{$subsys}->{'lbl'} = Gtk2::Label->new(); + + $Gtk2_table_cal->attach($setup_href->{'CAL_TRIG'}->{'CAL'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + + $t++; + $b++; + } + + $Gtk2_table_cal->set_col_spacings(1); + $Gtk2_table_cal->set_homogeneous(0); +} + +sub Gtk2_makeTable_trig() +{ + my $lable; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('TRIG'); + #$lable->set_name("green".1); + #$Gtk2_table_trig->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'CAL_TRIG'}->{'TRIG'}}){ + $lable = Gtk2::Label->new($subsys); + my $ext = $l . $r . $t . $b; + $lable->set_name("blue".$ext); + $Gtk2_table_trig->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'CAL_TRIG'}->{'TRIG'}->{$subsys}->{'lbl'} = Gtk2::Label->new(); + $Gtk2_table_trig->attach($setup_href->{'CAL_TRIG'}->{'TRIG'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + $t++; + $b++; + } + + $Gtk2_table_trig->set_col_spacings(1); + $Gtk2_table_trig->set_homogeneous(0); +} + +sub Gtk2_makeTable_busy() +{ + my $lable; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('BUSY'); + #$lable->set_name("green".1); + #$Gtk2_table_busy->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'BUSY'}->{'BUSY_BOX'}}){ + $lable = Gtk2::Label->new($subsys); + my $ext = $l . $r . $t . $b; + $lable->set_name("blue".$ext); + $Gtk2_table_busy->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'BUSY'}->{'BUSY_BOX'}->{$subsys}->{'lbl'} = Gtk2::Label->new(); + $Gtk2_table_busy->attach($setup_href->{'BUSY'}->{'BUSY_BOX'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + $t++; + $b++; + } + + $Gtk2_table_busy->set_col_spacings(1); + $Gtk2_table_busy->set_homogeneous(0); +} + +sub Gtk2_makeTable_msg() +{ + $Gtk2_errmsg_lbl = Gtk2::Label->new(); + $Gtk2_errmsg_lbl->set_name("red".1); + $Gtk2_table_msg->attach($Gtk2_errmsg_lbl, 0, 1, 0, 1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); +} + +sub Gtk2_makeTable_beam() +{ + my $lable; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('BUSY'); + #$lable->set_name("green".1); + #$Gtk2_table_busy->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'BEAM'}->{'BEAM_PROFILE'}}){ + $lable = Gtk2::Label->new($subsys); + my $ext = $l . $r . $t . $b; + $lable->set_name("blue".$ext); + $Gtk2_table_beam->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'BEAM'}->{'BEAM_PROFILE'}->{$subsys}->{'lbl'} = Gtk2::Label->new(); + $Gtk2_table_beam->attach($setup_href->{'BEAM'}->{'BEAM_PROFILE'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + $t++; + $b++; + } + + $Gtk2_table_beam->set_col_spacings(1); + $Gtk2_table_beam->set_homogeneous(0); +} + +sub getRegs2read() +{ + my ($regs2read_aref) = @_; + + foreach my $var (sort keys %$setup_href){ + foreach my $sys (sort keys %{$setup_href->{$var}}){ + foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ + my $addr = $setup_href->{$var}->{$sys}->{$subsys}->{'addr'}; + $addr = lc($addr); + push(@$regs2read_aref, $addr) unless(any {$_ eq $addr} @$regs2read_aref); + } + } + } +} + +sub writeShellScript() +{ + my ($regs2read_aref) = @_; + + my $shell_script = "/var/diskless/etrax_fs/tmp/$shellScriptName"; + + my $fh = new FileHandle(">$shell_script"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$shell_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh "# This script is automatically generated by mon_cts.pl\n"; + print $fh "# Do not edit, the changes will be lost.\n\n"; + + foreach my $addr (@$regs2read_aref){ + $addr =~ s/0x//; + print $fh "echo regaddr: $addr; $cmd_base $addr\n"; + } + + $fh->close(); + + system("chmod 755 $shell_script"); +} + +sub getShellScriptName() +{ + + +} + +sub readArray() +{ + my ($aref) = @_; + + my $raddr; + my $readval = 0; + + foreach (@$aref){ + if($_ =~ /regaddr:\s+(\w+)/){ + $raddr = $1; + $readval = 1; + next; + } + + if($readval){ + chomp($_); + #$_ =~ s/0x//; + $regsVals_href->{$raddr} = $_; + $readval = 0; + } + } + + unless( defined $raddr ){ + print "Failed to read registers.\n"; + $Gtk2_errmsg_lbl->set_text("Failed to read registers"); + $Gtk2_errmsg_lbl->set_name("red".1); + #exit(1); + } +} + +sub readLog() +{ + my ($log) = @_; + + my $fh = new FileHandle("$log", "r"); + &isItDefined($fh, $log); + + my $raddr; + my $readval = 0; + + while(<$fh>){ + if($_ =~ /regaddr:\s+(\w+)/){ + $raddr = $1; + $readval = 1; + next; + } + + if($readval){ + chomp($_); + #$_ =~ s/0x//; + $regsVals_href->{$raddr} = $_; + $readval = 0; + } + } + + $fh->close; + + unless( defined $raddr ){ + print "Failed to read registers.\n"; + $Gtk2_errmsg_lbl->set_text("Failed to read registers"); + $Gtk2_errmsg_lbl->set_name("red".1); + #exit(1); + } +} + +sub fillVals2hash() +{ + foreach my $var (sort keys %$setup_href){ + foreach my $sys (sort keys %{$setup_href->{$var}}){ + foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ + my $addr = lc($setup_href->{$var}->{$sys}->{$subsys}->{'addr'}); + + if( defined $regsVals_href->{$addr} ){ + my $mask = $setup_href->{$var}->{$sys}->{$subsys}->{'mask'}; + my $cont = $regsVals_href->{$addr}; + + my $val = &applyMask( $cont, &getMask($mask) ); + + unless( defined $val ){ + print "Value is undef, cont: $cont, mask: $mask\n"; + } + + #if( $subsys eq "TRIG_RATE" ){ + # print "content: $cont, addr: $addr, mask: $mask val: $val\n"; + # &getMask_debug($mask); + #} + + &Gtk2_setValAndColor($setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} ,$var, $subsys, $val); + #$setup_href->{$var}->{$sys}->{$subsys}->{'val'} = $val; + #$setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}->set_text($val); + } + } + } + } +} + +sub Gtk2_setValAndColor() +{ + my ($lvl_ref, $var, $subsys, $val) = @_; + + if($var eq "INPUT_EN" || $var eq "OUT_EN" || $subsys =~ /_EN$/){ + if( $val == 0 ){ + $lvl_ref->set_text("off"); + $lvl_ref->set_name("red".1); + } + elsif( $val == 1 ){ + $lvl_ref->set_text("on"); + $lvl_ref->set_name("green".1); + } + else{ + $lvl_ref->set_text("undef"); + } + } + elsif($var eq "GATING_DIS" || $subsys =~ /_DIS$/){ + if( $val == 0 ){ + $lvl_ref->set_text("off"); + $lvl_ref->set_name("green".1); + } + elsif( $val == 1 ){ + $lvl_ref->set_text("on"); + $lvl_ref->set_name("red".1); + } + else{ + $lvl_ref->set_text("undef"); + } + } + elsif($var eq "DSC"){ + $val = 2 ** $val; + $lvl_ref->set_text($val); + } + elsif($var eq "DLY_LARGE"){ + if($val){ + $val = $val * 5.; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($var eq "DLY_SMALL"){ + if($val){ + $val = $val * 1.25; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($var eq "WIDTH_SMALL"){ + if($val){ + $val = $val * 1.25; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($var eq "WIDTH" || $var eq "WIDTH_M"){ + if($val){ + $val = $val * 5; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "MULTIPLEX_A"){ + if($val){ + $val = $val; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "MULTIPLEX_B"){ + if($val){ + $val = $val; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "MDCA_DELAY"){ + if($val){ + $val = $val * 20; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "MDCB_DELAY"){ + if($val){ + $val = $val * 20; + $val = $val . " ns"; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "PULSER"){ + if($val){ + $val = sprintf("%.2f", 1000000000 / ($val * 5 + 10)); + $val = $val . " Hz"; + } + $lvl_ref->set_text($val); + } + elsif($subsys eq "MULT_SAMPLE"){ + $val = sprintf("%.2f", ($val*5 + 30)); + $val = $val . " ns"; + $lvl_ref->set_text($val); + } + elsif($subsys eq "EB_LUT"){ + $lvl_ref->set_text(&dec2hex($val)); + } + elsif($subsys eq "LVL1_INFO"){ + $lvl_ref->set_text(&dec2hex($val)); + } + elsif($subsys eq "OWN_TYPE"){ + $lvl_ref->set_text(&dec2hex($val)); + } + elsif($var eq "BEAM" && ( $subsys eq "SAMPLE_OFFSET" || $subsys eq "SAMPLE_PERIOD" + ) ){ + if($val){ + #- to convert to time in nanoseconds = 'val' * 100 ns + # therefore to get time in miliseconds = 'val' / 10000 + $val = sprintf("%.4f", $val / 10000); + $val = $val . " ms"; + } + $lvl_ref->set_text($val); + } + elsif($var eq "BEAM" && $subsys eq "BEAM_LENGTH"){ + if($val){ + #- to convert to time in nanoseconds = 'val' * 100 ns + # therefore to get time in seconds = 'val' / 10000000 + $val = sprintf("%.1f", $val / 10000000); + $val = $val . " s"; + } + $lvl_ref->set_text($val); + } + else{ + $lvl_ref->set_text($val); + } +} + +sub getMask() +{ + my ($bits) = @_; + + # The bits can be in two formats: + # 1. As a single digit + # 2. As two digits separated by '-': 5-3 + # which means a range of bits: 3,4,5 + + my $bit_max = $bits; + my $bit_min = $bits; + + if( $bits =~ /(\d+)-(\d+)/ ){ + $bit_max = $1; + $bit_min = $2; + } + + my $one = 1; + my $res = 0; + + foreach my $bit ($bit_min..$bit_max){ + my $val = $one << $bit; + $res = $res | $val; + } + + return $res; +} + +sub getShift() +{ + my ($bits) = @_; + + my $shift = $bits; + + if( $bits =~ /(\d+)-(\d+)/ ){ + $shift = $2; + } + + return $shift; +} + +sub getMask_debug() +{ + my ($bits) = @_; + + # The bits can be in two formats: + # 1. As a single digit + # 2. As two digits separated by '-': 5-3 + # which means a range of bits: 3,4,5 + + my $bit_max = $bits; + my $bit_min = $bits; + + if( $bits =~ /(\d+)-(\d+)/ ){ + $bit_max = $1; + $bit_min = $2; + } + + my $one = 1; + my $res = 0; + + foreach my $bit ($bit_min..$bit_max){ + my $val = $one << $bit; + $res = $res | $val; + } + + return $res; +} + +sub applyMask() +{ + my ($content, $mask) = @_; + + my $nrOfZeros = &count0(0xffffffff & $mask); + + my $val = hex($content) & $mask; + $val = $val >> $nrOfZeros; + + return $val; +} + +sub dec2hex() +{ + my ($foo) = @_; + + return sprintf("%x", $foo); +} + +sub bin2dec { + return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); +} + +sub dec2bin() +{ + my ($dec) = @_; + + #my $str = unpack("B32", pack("C", $dec)); + + my $bin = sprintf("%b", $dec); + + return $bin; +} + +sub count0() +{ + my ($dec) = @_; + + my $bin = &dec2bin($dec); + + my $nrOfZeros = $bin =~ tr/0//; + + return $nrOfZeros; +} + +sub isVarDefined() +{ + my ($var, $name) = @_; + + unless( defined $var ){ + print "$name is not defined! Exit.\n"; + exit(1); + } +} + +sub isItDefined() +{ + my ($fh, $name) = @_; + + if(!$fh) { + my $txt = "\nError! Could not open file \'$name\'. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + return 0; +} + +sub print2file() +{ + my ($fh, $toprint) = @_; + + if( defined $toprint ){ + print $fh $toprint; + + if( $opt_verb || $toprint =~ /ERROR/){ + print "$toprint\n"; + } + } +} + +#################################################################### +# +# The connectCmdServer() will write the answer of command_server +# (running on the Etrax) to the file $log. Then readLog($log) will +# read this file. +# +sub connectCmdServer() +{ + my ($cmd, $remote_host, $remote_port, $protocol, $log) = @_; + + # '$cmd' can be a reference to an array of commands + # or just single command. In the first case, the commands + # from the array will be executed one after another. + + &isVarDefined( $cmd, "connectCmdServer(): cmd" ); + &isVarDefined( $remote_host, "connectCmdServer(): remote_host" ); + + my $fh = new FileHandle(">$log"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$log\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + my $answer; + my $retval = 1; + + my $socket = IO::Socket::INET->new(PeerAddr => $remote_host, + PeerPort => $remote_port, + Proto => $protocol, + Type => SOCK_STREAM) + or $answer = "ERROR: No response from Cmd Server at $remote_host:$remote_port\n"; + + unless( defined $answer ){ + $socket->autoflush(1); + print $socket "iamfromhadesdaq\n"; + $answer = <$socket>; + + &print2file($fh, $answer); + + my $reftype = reftype \$cmd; + + if( $reftype =~ /REF/ ){ + #- Loop over commands to be executed on etrax + foreach my $command ( @{$cmd} ){ + + $command = &cmdParam( $command, $remote_host ); + + print $socket "$command\n"; + + &print2file( $fh, "===> $command\n" ); + + while ( <$socket> ) { + &print2file( $fh, $_ ); + + if( $_ =~ /- END OF OUTPUT -/ ){ + last; + } + } + } + } + else{ + print $socket "$cmd\n"; + + &print2file( $fh, "===> $cmd\n" ); + + while ( <$socket> ) { + &print2file( $fh, $_ ); + + if( $_ =~ /- END OF OUTPUT -/ ){ + last; + } + } + } + + close($socket); + } + else{ + $Gtk2_errmsg_lbl->set_text("No response from Cmd Server at $remote_host:$remote_port"); + $Gtk2_errmsg_lbl->set_name("red".1); + } + + if( $answer =~ /Connection accepted/ ){ + $Gtk2_errmsg_lbl->set_text("Connection to command_server is accepted"); + $Gtk2_errmsg_lbl->set_name("green".1); + $retval = 0; + } + else{ + &print2file( $fh, $answer ); + $Gtk2_errmsg_lbl->set_text("Connection to command_server is NOT accepted"); + $Gtk2_errmsg_lbl->set_name("red".1); + } + + $fh->close(); + +# close LOG_FILE; # gk 28.03.12 + + return $retval; +} + +#################################################################### +# +# The connectCmdServer2() will write the answer of command_server +# (running on the Etrax) to the array. Then readArray() will +# read this array. +# +sub connectCmdServer2() +{ + my ($cmd, $remote_host, $remote_port, $protocol, $aref) = @_; + + # '$cmd' can be a reference to an array of commands + # or just single command. In the first case, the commands + # from the array will be executed one after another. + + &isVarDefined( $cmd, "connectCmdServer(): cmd" ); + &isVarDefined( $remote_host, "connectCmdServer(): remote_host" ); + + my $answer; + my $retval = 1; + + my $socket = IO::Socket::INET->new(PeerAddr => $remote_host, + PeerPort => $remote_port, + Proto => $protocol, + Type => SOCK_STREAM) + or $answer = "ERROR: No response from Cmd Server at $remote_host:$remote_port\n"; + + unless( defined $answer ){ + $socket->autoflush(1); + print $socket "iamfromhadesdaq\n"; + $answer = <$socket>; + + push(@$aref, $answer); + + my $reftype = reftype \$cmd; + + if( $reftype =~ /REF/ ){ + #- Loop over commands to be executed on etrax + foreach my $command ( @{$cmd} ){ + + $command = &cmdParam( $command, $remote_host ); + + print $socket "$command\n"; + push(@$aref, "===> $command"); + + while ( <$socket> ) { + push(@$aref, $_); + + if( $_ =~ /- END OF OUTPUT -/ ){ + last; + } + } + } + } + else{ + print $socket "$cmd\n"; + push(@$aref, "===> $cmd"); + + while ( <$socket> ) { + push(@$aref, $_); + + if( $_ =~ /- END OF OUTPUT -/ ){ + last; + } + } + } + + close($socket); + } + else{ + $Gtk2_errmsg_lbl->set_text("No response from Cmd Server at $remote_host:$remote_port"); + $Gtk2_errmsg_lbl->set_name("red".1); + } + + if( $answer =~ /Connection accepted/ ){ + $Gtk2_errmsg_lbl->set_text("Connection to command_server is accepted"); + $Gtk2_errmsg_lbl->set_name("green".1); + $retval = 0; + } + else{ + push(@$aref, $answer); + + $Gtk2_errmsg_lbl->set_text("Connection to command_server is NOT accepted"); + $Gtk2_errmsg_lbl->set_name("red".1); + } + + return $retval; +} + +sub readRegs_trbcmd() +{ + my $msg = "TRB-Net: OK"; + + + #my $trb_cmd1 = "/home/hadaq/bin/trbcmd rm 0x0003 0xa000 99 0"; + #my $trb_cmd2 = "/home/hadaq/bin/trbcmd rm 0x0003 0xa0c0 52 0"; # read 52 registers starting from a0c0 + + # will put HADES::TrbNet access in here... MT + + if($glob_trbnet_connected == FALSE) { + my $res = trb_init_ports(); + if($res) { + $glob_trbnet_connected = TRUE; + } + else { + $glob_trbnet_connected = FALSE; + return; + } + } + + + my $rh1=trb_register_read_mem(0x3,0xa000, 0, 111); + my $rh2=trb_register_read_mem(0x3,0xa0c0, 0, 52); + + if(!$rh1 || !$rh2) { + $msg = trb_strerror(); + $Gtk2_errmsg_lbl->set_text("$msg"); + $Gtk2_errmsg_lbl->set_name("red".1); + return; + } + + my $addr; + $addr = 0x00; + foreach my $i (0..110) { + $regsVals_href->{sprintf "%02x", $addr+$i} = sprintf "0x%08x", $rh1->{3}->[$i]; + } + + $addr = 0xc0; + foreach my $i (0..51) { + $regsVals_href->{sprintf"%02x",$addr+$i} = sprintf "0x%08x",$rh2->{3}->[$i]; + } + + #print Dumper $rh1; + #print Dumper $rh2; + #print Dumper $regsVals_href; + + $Gtk2_errmsg_lbl->set_text("$msg"); + $Gtk2_errmsg_lbl->set_name("green".1); + + return; + + + #old stuff only for reference, can be deleted as soon as the stuff above is approved to be correct, mt + + my @reg_list1 = `$trb_cmd1 2>&1`; + my @reg_list2 = `$trb_cmd2 2>&1`; + + my $mon_status1 = 0; + my $mon_status2 = 0; + + + foreach my $line (@reg_list1){ + if($line =~ /^0xa0(\w+)\s+(\w+)/){ + my $raddr = $1; + my $rval = $2; + $regsVals_href->{$raddr} = $rval; + $mon_status1 = 1; + } + elsif($line =~ /TX BUSY/){ + $msg = "TRB-Net: TX BUSY"; + } + elsif($line =~ /endpoint not reached/){ + $msg = "TRB-Net: endpoint not reached"; + } + else{ + $msg = "TRB-Net: failed to read CTS regs"; + } + } + + foreach my $line (@reg_list2){ + if($line =~ /^0xa0(\w+)\s+(\w+)/){ + my $raddr = $1; + my $rval = $2; + $regsVals_href->{$raddr} = $rval; + $mon_status2 = 1; + } + elsif($line =~ /TX BUSY/){ + $msg = "TRB-Net: TX BUSY"; + } + elsif($line =~ /endpoint not reached/){ + $msg = "TRB-Net: endpoint not reached"; + } + else{ + $msg = "TRB-Net: failed to read CTS regs"; + } + } + + if($mon_status1 == 1 && $mon_status2 == 1){ + $msg = "TRB-Net: OK"; + } + + print Dumper $regsVals_href; + + $Gtk2_errmsg_lbl->set_text("$msg"); + unless( $msg eq "TRB-Net: OK"){ + $Gtk2_errmsg_lbl->set_name("red".1); + } + else{ + $Gtk2_errmsg_lbl->set_name("green".1); + } +} + +#----------------------------------------------------------------------------------- +#---------------------- Functions for the window in 'SET' mode --------------------- +#----------------------------------------------------------------------------------- + +sub set_window() +{ + if( $opt_mode eq "mon" ){ + system("/home/hadaq/trbsoft/daq/evtbuild/mon_cts.pl -m set -e $opt_etrax -a $opt_access &"); + } + elsif( $opt_mode eq "set" ){ + $errorType = ""; + &set_registers(); # the settings with trbcmd are done inside this function + } + else{ + print "Unknown option $opt_mode. Exit.\n" if( defined $opt_mode ); + print "Undefined option opt_mode. Exit.\n" unless( defined $opt_mode ); + exit(1); + } + + if( $opt_mode eq "set" && $errorType eq "" && $opt_access eq "cmdsrv"){ + &connectCmdServer("/home/hadaq/tmp/set_cts_registers.sh", + $opt_etrax, $cmd_server_port, $cmd_server_prtcl, "/tmp/log_mon_cts_set.txt"); + } +} + +sub convertRegVal() +{ + my ($regs2write_href) = @_; + + my $errorFound = 0; + + foreach my $var (keys %$setup_href){ + + #- Skip all Vars which do not participate in setting regs + next unless( (any { $var eq $_ } @layout_set) || + (any { $var eq $_ } @layout2_set) ); + + foreach my $sys (keys %{$setup_href->{$var}}){ + + #- Loop over Rows + foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ + + next if( (any { $subsys eq $_ } @layout_cal_set) || + (any { $subsys eq $_ } @layout_trig_set) || + (any { $subsys eq $_ } @layout_beam_set)); + + my $txt = $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}->get_text(); + + unless( $txt eq "" ){ + my $dec = &set_any2dec($var, $sys, $subsys, $txt); + + #print "txt: $txt dec: $dec\n"; + + $errorFound = 1 if($errorType ne "" || $dec eq "undef"); + + next unless($errorType eq ""); + + if( $dec eq "undef"){ + print "ERROR: Do not know what to do with \"$txt\" for $var $sys $subsys !\n"; + next; + } + + &set_calcRegVal($regs2write_href, $setup_href->{$var}->{$sys}->{$subsys}, $dec); + } + } + } + } + + #- Print STATUS: OK, if no error was detected + &printOkMsg("OK") if( $errorFound == 0); + +} + +sub set_registers() +{ + my %regs2write; + my $regs2write_href = \%regs2write; + + &convertRegVal($regs2write_href); + + if($opt_access eq "cmdsrv"){ + my $shell_script = "/var/diskless/etrax_fs/tmp/set_cts_registers.sh"; + + my $fh = new FileHandle(">$shell_script"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$shell_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh "# This script is automatically generated by mon_cts.pl\n"; + print $fh "# Do not edit, the changes will be lost.\n\n"; + + foreach my $addr (sort keys %$regs2write_href){ + my $val = &dec2hex($regs2write_href->{$addr}); + print $fh "$cmd_base_w $addr $val\n"; + } + + $fh->close(); + + system("chmod 755 $shell_script"); + } + elsif($opt_access eq "trbcmd"){ + foreach my $addr (sort keys %$regs2write_href){ + my $val = &dec2hex($regs2write_href->{$addr}); + + my $trbcmd = "/home/hadaq/bin/trbcmd w 0x0003 0xa0" . $addr . " 0x" . $val; + print "trbcmd: $trbcmd\n"; + + my @t = split("trbcmd w ", $trbcmd); # gk 28.03.12 + system("logger -p local1.info -t DAQ 'CTSMon Setting register: $t[1]'"); # gk 28.03.12 + + system($trbcmd); + } + } +} + +sub set_calcRegVal() +{ + my ($regs2write_href, $href, $dec) = @_; + + my $addr = lc($href->{'addr'}); + my $mask = &getMask($href->{'mask'}); + my $shift = &getShift($href->{'mask'}); + + #- Get reverse Mask + my $mask2 = 0xffffffff ^ $mask; + + my $regval = $regsVals_href->{$addr}; + + unless( defined $regval ){ + print "ERROR: Register content is not defined for address $addr !!!\n"; + next; + } + + #- Apply reverse mask + my $rest = hex($regval) & $mask2; + + #- Shift the new value + $dec = $dec << $shift; + + #- Remove possible overflow + $dec = &set_rmOverflow($dec, $href->{'mask'}); + + #- Final value: combine with the rest of bits + $dec = $dec | $rest; + + $regsVals_href->{$addr} = &dec2hex($dec); + $regs2write_href->{$addr} = $dec; +} + +sub set_rmOverflow() +{ + my ($val, $bits) = @_; + + my $bit_max = $bits; + if( $bits =~ /(\d+)-(\d+)/ ){ + $bit_max = $1; + } + + my $shift = 31 - $bit_max; + #print "Overflow shift: $shift bitmax: $bit_max\n"; + + $val = $val << $shift; + $val = $val >> $shift; + + return $val; +} + +sub set_any2dec() +{ + my ($var, $sys, $subsys, $txt) = @_; + + # Make here reverse calculation from any value to decimal + + my $retval = "undef"; + + if($var eq "DLY_LARGE"){ + if($txt =~ /\d+/){ + $retval = int($txt / 5.); + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($var eq "DLY_SMALL" || $var eq "WIDTH_SMALL"){ + if($txt =~ /\d+/){ + if($txt > 10){ + $retval = int(10 / 1.25); + } + else{ + $retval = int($txt / 1.25); + } + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($var eq "WIDTH" || $var eq "WIDTH_M"){ + if($txt =~ /\d+/){ + $retval = int($txt / 5); + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($var eq "DSC"){ + if($txt =~ /\d+/){ + $retval = int(&log2($txt)); + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($var eq "INPUT_EN" || $var eq "GATING_DIS" || $var eq "OUT_EN"){ + if( $txt eq "off" ){ + $retval = 0; + } + elsif( $txt eq "on" ){ + $retval = 1; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only on/off are allowed"); + } + } + elsif($var eq "SCALER_OUT"){ + if($txt =~ /\d+/){ + $retval = $txt; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif( $sys eq "CAL" && ($subsys =~ /_DIS$/ || $subsys =~ /_EN$/) ){ + if( $txt eq "off" ){ + $retval = 0; + } + elsif( $txt eq "on" ){ + $retval = 1; + } + } + elsif($sys eq "BEAM_PROFILE" && ( $subsys eq "MULTIPLEX_A" || $subsys eq "MULTIPLEX_B") ){ + if($txt =~ /\d+/){ + $retval = $txt; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed or defined names: start, veto, tof, rpc, pt, delay, width, dsc, 1 ... 8"); + } + } + elsif($sys eq "TRIG" && ( $subsys eq "MDCA_DELAY" || $subsys eq "MDCB_DELAY") ){ + if($txt =~ /\d+/){ + $retval = int($txt / 20); + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($sys eq "TRIG" && ( $subsys eq "START_SEL_X") ){ + if($txt =~ /\d+/){ + if($txt<3) + { + $retval = $txt; + } + else + { + &printErrorMsg($var, $sys, $subsys, "value should be 0 (1-8), 1(5-12), 2(9-16)"); + } + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + + elsif($sys eq "TRIG" && ( $subsys eq "START_SEL_Y") ){ + if($txt =~ /\d+/){ + if($txt<3) + { + $retval = $txt; + } + else + { + &printErrorMsg($var, $sys, $subsys, "value should be 0 (1-8), 1(5-12), 2(9-16)"); + } + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + + elsif($sys eq "TRIG" && ( $subsys eq "ANTI_COINC") ){ + if($txt =~ /\d+/){ + $retval = $txt; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed, value should be 0(start coinc.), 1(start-veto anticoinc) or 2(TOF/RPC used as SATRT in trigg logic)"); + } + } + + elsif($sys eq "TRIG" && $subsys eq "PULSER"){ + if($txt =~ /\d+/){ + if($txt == 0){ + $retval = $txt; + } + else{ + $retval = int((1000000000/$txt - 10)/5); + } + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($sys eq "TRIG" && $subsys eq "MULT_SAMPLE"){ + if($txt =~ /\d+/){ + if($txt >= int(30)) { + $retval = int($txt/5-6);} + else{ + &printErrorMsg($var, $sys, $subsys, "the lowest possible value is 30ns"); + } + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($sys eq "TRIG" && $subsys eq "EB_LUT"){ + $retval = hex($txt); + } + elsif($sys eq "TRIG" && $subsys eq "LVL1_INFO"){ + $retval = hex($txt); + } + elsif($sys eq "BEAM_PROFILE" && ($subsys eq "START_V_SEL" || + $subsys eq "START_H_SEL") ){ + if($txt =~ /\d+/){ + $retval = $txt; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + + elsif($sys eq "TRIG" && ($subsys eq "EB_EVENTS" || + $subsys eq "TRIG_WIDTH") ){ + if($txt =~ /\d+/){ + $retval = $txt; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only numeric values are allowed"); + } + } + elsif($sys eq "TRIG" && ($subsys eq "OWN_TYPE") ){ + $retval = hex($txt); + } + elsif($sys eq "TRIG" && $subsys eq "OWN_TYPE_EN"){ + if( $txt eq "off" ){ + $retval = 0; + } + elsif( $txt eq "on" ){ + $retval = 1; + } + else{ + &printErrorMsg($var, $sys, $subsys, "only on/off are allowed"); + } + } + + elsif($sys eq "BEAM_PROFILE" && ( $subsys eq "SAMPLE_OFFSET" || $subsys eq "SAMPLE_PERIOD" + ) ){ + if($txt){ + #- 'txt' = time in miliseconds + # the target time = 'val' (* 100 ns) + # therefore 'val' = 'txt' * 10000 + $retval = $txt * 10000; + } + } + elsif($var eq "BEAM" && $subsys eq "BEAM_LENGTH"){ + if($txt){ + #- 'txt' = time in seconds + # the target time = 'val' (* 100 ns) + # therefore 'val' = 'txt' * 10000000 + $retval = $txt * 10000000; + } + } + + return $retval; +} + +sub printErrorMsg(){ + + my ($var, $sys, $subsys, $txt) = @_; + + $errorType = "WARNING"; + + my $msg = "ERROR: For $var $sys $subsys: $txt"; + print "$msg\n"; + $Gtk2_errmsg_lbl->set_text("$msg"); + $Gtk2_errmsg_lbl->set_name("red".1); +} + +sub printOkMsg(){ + + my ($txt) = @_; + + $errorType = ""; + my $msg = "STATUS: $txt"; + + $Gtk2_errmsg_lbl->set_text("$msg"); + $Gtk2_errmsg_lbl->set_name("green".1); +} + +sub log2 { + my $n = shift; + return log($n)/log(2); +} + +sub set_writeShellScript() +{ + + +} + +sub Gtk2_makeTable_main_set() +{ + my $lable; + my $l = 2; + my $r = 3; + my $t = 0; + my $b = 1; + + foreach my $href (@layout1){ + + #- Loop over Columns + foreach my $var ( sort keys %$href ) { + + $t = 0; + $b = 1; + + next unless( any{ $var eq $_ } @layout_set); + + if( $var eq "WIDTH_SMALL"){ + $l++; + $r++; + } + + my $ext = $l . $r . $t . $b; + + $lable = Gtk2::Label->new($names_href->{$var}->{'first'}); + $lable->set_name("green".$ext); + $Gtk2_table->attach($lable, $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $t++; + $b++; + + $lable = Gtk2::Label->new($names_href->{$var}->{'second'}); + $lable->set_name("green".$ext); + $Gtk2_table->attach($lable, $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $sys (@{$href->{$var}}){ + + &shiftIndex($var, $sys, \$t, \$b); + + #- Loop over Rows + foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ + $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} = Gtk2::Entry->new(); + &set_entryWidth($setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}, $var, $sys, $subsys); + + $t++; + $b++; + $Gtk2_table->attach($setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}, + $l, $r, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + + my $addr = lc($setup_href->{$var}->{$sys}->{$subsys}->{'addr'}); + } + } + + $l++; + $r++; + } + } + +# foreach my $href (@layout2){ +# foreach my $var ( sort keys %$href ) { + +# next unless( any{ $var eq $_ } @layout_set); +# foreach my $sys (@{$href->{$var}}){ +# foreach my $subsys (sort keys %{$setup_href->{$var}->{$sys}}){ +# $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} = Gtk2::Entry->new(); +# } +# } +# } +# } + + $Gtk2_table->set_col_spacings(1); + $Gtk2_table->set_homogeneous(0); +} + +sub Gtk2_makeTable_cal_set() +{ + my $lable; + my $entry; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('CAL'); + #$lable->set_name("green".1); + #$Gtk2_table_cal->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'CAL_TRIG'}->{'CAL'}}){ + + next if( any{ $subsys eq $_ } @layout_cal_set); + + my $ext = $l . $r . $t . $b; + + $lable = Gtk2::Label->new($subsys); + $lable->set_name("blue".$ext); + $Gtk2_table_cal->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'CAL_TRIG'}->{'CAL'}->{$subsys}->{'lbl'} = Gtk2::Entry->new(); + &set_entryWidth($setup_href->{'CAL_TRIG'}->{'CAL'}->{$subsys}->{'lbl'}, 'CAL_TRIG', 'CAL', $subsys); + $Gtk2_table_cal->attach($setup_href->{'CAL_TRIG'}->{'CAL'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + + $t++; + $b++; + } + + $Gtk2_table_cal->set_col_spacings(1); + $Gtk2_table_cal->set_homogeneous(0); +} + +sub Gtk2_makeTable_trig_set() +{ + my $lable; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('TRIG'); + #$lable->set_name("green".1); + #$Gtk2_table_trig->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'CAL_TRIG'}->{'TRIG'}}){ + + next if( any{ $subsys eq $_ } @layout_trig_set); + + $lable = Gtk2::Label->new($subsys); + my $ext = $l . $r . $t . $b; + $lable->set_name("blue".$ext); + $Gtk2_table_trig->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'CAL_TRIG'}->{'TRIG'}->{$subsys}->{'lbl'} = Gtk2::Entry->new(); + &set_entryWidth($setup_href->{'CAL_TRIG'}->{'TRIG'}->{$subsys}->{'lbl'}, 'CAL_TRIG', 'TRIG', $subsys); + $Gtk2_table_trig->attach($setup_href->{'CAL_TRIG'}->{'TRIG'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + $t++; + $b++; + } + + $Gtk2_table_trig->set_col_spacings(1); + $Gtk2_table_trig->set_homogeneous(0); +} + +sub Gtk2_makeTable_beam_set() +{ + my $lable; + my $l = 0; + my $r = 1; + my $t = 0; + my $b = 1; + + #$lable = Gtk2::Label->new('TRIG'); + #$lable->set_name("green".1); + #$Gtk2_table_trig->attach($lable, $l+1, $r+1, $t, $b, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + foreach my $subsys (sort keys %{$setup_href->{'BEAM'}->{'BEAM_PROFILE'}}){ + + next if( any{ $subsys eq $_ } @layout_beam_set); + + $lable = Gtk2::Label->new($subsys); + my $ext = $l . $r . $t . $b; + $lable->set_name("blue".$ext); + $Gtk2_table_beam->attach($lable, $l, $r, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + + $setup_href->{'BEAM'}->{'BEAM_PROFILE'}->{$subsys}->{'lbl'} = Gtk2::Entry->new(); + &set_entryWidth($setup_href->{'BEAM'}->{'BEAM_PROFILE'}->{$subsys}->{'lbl'}, 'BEAM', 'BEAM_PROFILE', $subsys); + $Gtk2_table_beam->attach($setup_href->{'BEAM'}->{'BEAM_PROFILE'}->{$subsys}->{'lbl'}, + $l+1, $r+1, $t+1, $b+1, 'GTK_SHRINK', 'GTK_SHRINK', 4, 3); + $t++; + $b++; + } + + $Gtk2_table_beam->set_col_spacings(1); + $Gtk2_table_beam->set_homogeneous(0); +} + +sub set_entryWidth() +{ + my ($entry, $var, $sys, $subsys) = @_; + + my $width = 35; + my $hight = 14; + + if( $sys eq 'CAL' ){ + $entry->set_size_request($width, $hight); + } + elsif( any {$var eq $_} @layout_set ){ + $entry->set_size_request($width, $hight); + } + else{ + $entry->set_size_request(70, 14); + } +} + +sub Gtk2_button_ctrl() +{ + my $button_ctrl = Gtk2::Button->new("Save/Load"); + $button_ctrl->signal_connect(pressed => \&ctrlWindow); + + $Gtk2_hbox2->pack_start($button_ctrl, FALSE, FALSE, 0); +} + +sub cp2startup() +{ + my %regs2write; + my $regs2write_href = \%regs2write; + + &convertRegVal($regs2write_href); + + my $cts_conf = "/home/hadaq/trbsoft/daq/cts/cts_settings_mon.trbcmd"; + + my $fh = new FileHandle(">$cts_conf"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$cts_conf\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + foreach my $addr (sort keys %$regs2write_href){ + my $val = &dec2hex($regs2write_href->{$addr}); + my $cmd = "w 0x0003 0xa0" . $addr . " 0x" . $val; + print $fh "$cmd\n"; + } + + $fh->close(); +} + +sub ctrlWindow() +{ + my $loadTableListBox = Gtk2::ComboBox->new_text(); + + &populateTableList($loadTableListBox); + + my $window_ctrl = Gtk2::Window->new('toplevel'); + $window_ctrl->set_title("Ctrl"); + $window_ctrl->set_border_width(5); + $window_ctrl->resize(200,170); + my $vbox_ctrl = Gtk2::VBox->new(FALSE, 5); + + #------------------ Save frame ---------------- + my $saveFrame = Gtk2::Frame->new("Save current settings"); + my $save_vbox_ctrl = Gtk2::VBox->new(FALSE, 5); + + my $lbl_save = Gtk2::Label->new("Table name: "); + my $saveEntry = Gtk2::Entry->new; + my $saveBtn = Gtk2::Button->new("Save settings"); + $saveBtn->signal_connect(pressed => \&saveSettings, [$saveEntry, $loadTableListBox]); + + $save_vbox_ctrl->pack_start($lbl_save, FALSE, FALSE, 0); + $save_vbox_ctrl->pack_start($saveEntry, FALSE, FALSE, 0); + $save_vbox_ctrl->pack_start($saveBtn, FALSE, FALSE, 0); + + $saveFrame->add($save_vbox_ctrl); + + #------------------ Load frame ---------------- + + my $loadFrame = Gtk2::Frame->new("Load saved settings"); + + my $load_vbox_ctrl = Gtk2::VBox->new(FALSE, 5); + + my $lbl_load = Gtk2::Label->new("Table name: "); + + my $loadBtn = Gtk2::Button->new("Load"); + $loadBtn->signal_connect(pressed => \&loadSettings, [$loadTableListBox]); + + $load_vbox_ctrl->pack_start($lbl_load, FALSE, FALSE, 0); + $load_vbox_ctrl->pack_start($loadTableListBox, FALSE, FALSE, 0); + $load_vbox_ctrl->pack_start($loadBtn, FALSE, FALSE, 0); + + $loadFrame->add($load_vbox_ctrl); + + $vbox_ctrl->pack_start($saveFrame, FALSE, FALSE, 0); + $vbox_ctrl->pack_start($loadFrame, FALSE, FALSE, 0); + + $window_ctrl->add($vbox_ctrl); + $window_ctrl->show_all; +} + +sub saveSettings() +{ + my ($btn, @args) = @_; + + my $saveEntry = ${$args[0]}[0]; + my $loadTableListBox = ${$args[0]}[1]; + + my $tablePath = "./tables/" . $saveEntry->get_text . ".hsh"; + + foreach my $var (keys %$setup_href){ + foreach my $sys (keys %{$setup_href->{$var}}){ + foreach my $subsys (keys %{$setup_href->{$var}->{$sys}}){ + + if( defined $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'} ){ + $setup_href->{$var}->{$sys}->{$subsys}->{'val'} = + $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}->get_text; + } + } + } + } + + store($setup_href, $tablePath); + + &populateTableList($loadTableListBox); +} + +sub loadSettings() +{ + my ($btn, @args) = @_; + + my $loadTableListBox = ${$args[0]}[0]; + + my $table = "./tables/" . $loadTableListBox->get_active_text . ".hsh"; + + my $table_href = retrieve($table); + + foreach my $var (keys %$setup_href){ + foreach my $sys (keys %{$setup_href->{$var}}){ + foreach my $subsys (keys %{$setup_href->{$var}->{$sys}}){ + + if(defined $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}){ + $setup_href->{$var}->{$sys}->{$subsys}->{'lbl'}->set_text($table_href->{$var}->{$sys}->{$subsys}->{'val'}); + } + } + } + } +} + +sub populateTableList() +{ + my ($loadTableListBox) = @_; + + for (my $i = 0; $i < 500; $i++) { + $loadTableListBox->remove_text(0); + } + + opendir(my $dir, "./tables") or die "Cannot open directory with tables!"; + my @files = grep(/\.hsh$/,readdir($dir)); + closedir($dir); + + foreach my $s (sort (@files)) { + $s =~ s/\.hsh//g; + $loadTableListBox->append_text($s); + } +} diff --git a/control/ctsmon/tables/.hsh b/control/ctsmon/tables/.hsh new file mode 100644 index 0000000..795c48a Binary files /dev/null and b/control/ctsmon/tables/.hsh differ diff --git a/control/ctsmon/tables/2012-03 RICH Pedestal Mode.hsh b/control/ctsmon/tables/2012-03 RICH Pedestal Mode.hsh new file mode 100644 index 0000000..d6f1e5f Binary files /dev/null and b/control/ctsmon/tables/2012-03 RICH Pedestal Mode.hsh differ diff --git a/control/ctsmon/tables/2012-03-27_cosmics.hsh b/control/ctsmon/tables/2012-03-27_cosmics.hsh new file mode 100644 index 0000000..08ddce7 Binary files /dev/null and b/control/ctsmon/tables/2012-03-27_cosmics.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam 2.hsh b/control/ctsmon/tables/2012-04 Beam 2.hsh new file mode 100644 index 0000000..64433f2 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam 2.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam 3.hsh b/control/ctsmon/tables/2012-04 Beam 3.hsh new file mode 100644 index 0000000..f681cc0 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam 3.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam 4.hsh b/control/ctsmon/tables/2012-04 Beam 4.hsh new file mode 100644 index 0000000..7b3a7a7 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam 4.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam 5.hsh b/control/ctsmon/tables/2012-04 Beam 5.hsh new file mode 100644 index 0000000..326f974 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam 5.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam 6.hsh b/control/ctsmon/tables/2012-04 Beam 6.hsh new file mode 100644 index 0000000..0ff5639 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam 6.hsh differ diff --git a/control/ctsmon/tables/2012-04 Beam.hsh b/control/ctsmon/tables/2012-04 Beam.hsh new file mode 100644 index 0000000..34862a7 Binary files /dev/null and b/control/ctsmon/tables/2012-04 Beam.hsh differ diff --git a/control/ctsmon/tables/2012-04 beam 10.hsh b/control/ctsmon/tables/2012-04 beam 10.hsh new file mode 100644 index 0000000..d632666 Binary files /dev/null and b/control/ctsmon/tables/2012-04 beam 10.hsh differ diff --git a/control/ctsmon/tables/2012-04 beam 11.hsh b/control/ctsmon/tables/2012-04 beam 11.hsh new file mode 100644 index 0000000..0ff5639 Binary files /dev/null and b/control/ctsmon/tables/2012-04 beam 11.hsh differ diff --git a/control/ctsmon/tables/2012-04 beam 12.hsh b/control/ctsmon/tables/2012-04 beam 12.hsh new file mode 100644 index 0000000..bbde18e Binary files /dev/null and b/control/ctsmon/tables/2012-04 beam 12.hsh differ diff --git a/control/ctsmon/tables/2012-04 beam 8.hsh b/control/ctsmon/tables/2012-04 beam 8.hsh new file mode 100644 index 0000000..c233603 Binary files /dev/null and b/control/ctsmon/tables/2012-04 beam 8.hsh differ diff --git a/control/ctsmon/tables/2012-04 beam9.hsh b/control/ctsmon/tables/2012-04 beam9.hsh new file mode 100644 index 0000000..bbde18e Binary files /dev/null and b/control/ctsmon/tables/2012-04 beam9.hsh differ diff --git a/control/ctsmon/tables/2012-04-baem 7.hsh b/control/ctsmon/tables/2012-04-baem 7.hsh new file mode 100644 index 0000000..23290a3 Binary files /dev/null and b/control/ctsmon/tables/2012-04-baem 7.hsh differ diff --git a/control/ctsmon/tables/2012-10 beam-2.hsh b/control/ctsmon/tables/2012-10 beam-2.hsh new file mode 100644 index 0000000..91b574f Binary files /dev/null and b/control/ctsmon/tables/2012-10 beam-2.hsh differ diff --git a/control/ctsmon/tables/2012-10 beam-3.hsh b/control/ctsmon/tables/2012-10 beam-3.hsh new file mode 100644 index 0000000..26fde7d Binary files /dev/null and b/control/ctsmon/tables/2012-10 beam-3.hsh differ diff --git a/control/ctsmon/tables/2012-10-25_test_mdc_a.hsh b/control/ctsmon/tables/2012-10-25_test_mdc_a.hsh new file mode 100644 index 0000000..6e2a227 Binary files /dev/null and b/control/ctsmon/tables/2012-10-25_test_mdc_a.hsh differ diff --git a/control/ctsmon/tables/2012_10-25_test_mdc_a.hsh b/control/ctsmon/tables/2012_10-25_test_mdc_a.hsh new file mode 100644 index 0000000..6e2a227 Binary files /dev/null and b/control/ctsmon/tables/2012_10-25_test_mdc_a.hsh differ diff --git a/control/ctsmon/tables/212-10 beam-1.hsh b/control/ctsmon/tables/212-10 beam-1.hsh new file mode 100644 index 0000000..40002e9 Binary files /dev/null and b/control/ctsmon/tables/212-10 beam-1.hsh differ diff --git a/control/ctsmon/tables/BEAM5.hsh b/control/ctsmon/tables/BEAM5.hsh new file mode 100644 index 0000000..326f974 Binary files /dev/null and b/control/ctsmon/tables/BEAM5.hsh differ diff --git a/control/ctsmon/tables/FW cosmic.hsh b/control/ctsmon/tables/FW cosmic.hsh new file mode 100644 index 0000000..1b7aa48 Binary files /dev/null and b/control/ctsmon/tables/FW cosmic.hsh differ diff --git a/control/ctsmon/tables/test_beam_25102012_a.hsh b/control/ctsmon/tables/test_beam_25102012_a.hsh new file mode 100644 index 0000000..359f6a8 Binary files /dev/null and b/control/ctsmon/tables/test_beam_25102012_a.hsh differ diff --git a/cts/.gitignore b/cts/.gitignore new file mode 100644 index 0000000..ac5d403 --- /dev/null +++ b/cts/.gitignore @@ -0,0 +1 @@ +cts_settings_mon.trbcmd diff --git a/cts/addresses_cts.db b/cts/addresses_cts.db new file mode 100644 index 0000000..15a35d3 --- /dev/null +++ b/cts/addresses_cts.db @@ -0,0 +1,4 @@ +#Address # S/N # FPGA # Design # TRB # +################################################### + 0x0002 900 2 1 058 + 0x0003 900 1 1 058 diff --git a/cts/configure_blr.script b/cts/configure_blr.script new file mode 100644 index 0000000..591bcb3 --- /dev/null +++ b/cts/configure_blr.script @@ -0,0 +1,3 @@ + + +exec_cmd spi_trbv2_7 /home/hadaq/cts/mult_thresholds/ctsblr_thresholds diff --git a/cts/cts_settings.trbcmd b/cts/cts_settings.trbcmd new file mode 100644 index 0000000..b11ee39 --- /dev/null +++ b/cts/cts_settings.trbcmd @@ -0,0 +1,25 @@ +w 0x0003 0xA0f1 0x20 #Events per EB +w 0x0003 0xA0f0 0xff00ff #15 - 0 EB enable , + #31 - 16 downscale of RPC/TOF TDC trailers and headers + + +w 0x0003 0xA0e3 0x0; #Pulser (100MHz/value) (0 is off) +w 0x0003 0xA0e4 0x700; #Trigger Information + +w 0x0003 0xA0e5 0x21; #Start delay +#w 0x0003 0xA0e6 0x02; #PT delay +w 0x0003 0xA0c0 0x42A0; #Trigger settings 5: MDC, 6:Shw ped, 8:shw cal, 9: 0xE, 14 enable beam inhibit input-> shower pedestals trigger +w 0x0003 0xA0c1 0x001CB000; #16-12:MDC34 delay, 21-17: MDC12 delay + +# can you give more details about the bits in the multiplexer here? What do you mean - more details ? +w 0x0003 0xA0c2 0x10005c6f; #Multiplexer + +w 0x0003 0xA0c3 0xffffffff; #All inputs on for monitor +w 0x0003 0xA0c5 0xffff; #fff00000; #anticoincidence +w 0x0003 0xA0c7 0x4000; # pt4 mdc temp trigger 3800; #Output enable +w 0x0003 0xA0ca 0x4000; #PT1 downscaling +w 0x0003 0xA0d1 0x22222222; #fine delay start +w 0x0003 0xA0db 0x000186a0; #sample period 10ms A plot +w 0x0003 0xA0dc 0x000186a0; #sample period 10ms B plot +w 0x0003 0xA0c8 0x000186a0; #sample period 10ms Start plot +w 0x0003 0xA0DD 0x03938700; #beam length 5s \ No newline at end of file diff --git a/cts/serials_cts.db b/cts/serials_cts.db new file mode 100644 index 0000000..6245821 --- /dev/null +++ b/cts/serials_cts.db @@ -0,0 +1,8 @@ +#Serial numbers of central trbs and their unique ids + +# s/n # unique id +########################### + 037 0x3c000001241ee028 + 058 0x3c00000123f5a328 + 900 0x9300000270e8dd28 + diff --git a/cts/startup.script b/cts/startup.script new file mode 100644 index 0000000..661fb34 --- /dev/null +++ b/cts/startup.script @@ -0,0 +1,27 @@ +#Start-up CTS + +#Assign addresses +!ifndef RESTART + set_addresses serials_cts.db addresses_cts.db #addresses for central boards +!endif + + +trbcmd clearbit 0x0003 0xa0c0 0x20000000 #set profile B to start +trbcmd w 0x0003 0xA0E0 0xcccccccc +trbcmd w 0x0003 0xA0E1 0xcc +trbcmd loadbit 0x003 0xA0C1 0x0000000F 0x00000004 +trbcmd setbit 0x0003 0xA0C2 0x01000000 + +!ifndef MON_CTS + trbcmd -f cts_settings.trbcmd +!endif + +!ifdef MON_CTS + trbcmd -f cts_settings_mon.trbcmd +!endif + +trbcmd loadbit 0x0003 0xa0f0 0xffff0000 0xfff0000 + +#Default LVL1 pattern +trbcmd w 0x0003 0xa0e4 0x700 + diff --git a/cts/trb.db b/cts/trb.db new file mode 100644 index 0000000..88b3e40 --- /dev/null +++ b/cts/trb.db @@ -0,0 +1,4 @@ +scs etraxp023 +blr etraxp107 +cts etraxp119 +pexor hadesp31 diff --git a/evtbuild/default_s.tcl b/evtbuild/default_s.tcl new file mode 100644 index 0000000..e69de29 diff --git a/evtbuild/eb.conf b/evtbuild/eb.conf new file mode 120000 index 0000000..175fb1c --- /dev/null +++ b/evtbuild/eb.conf @@ -0,0 +1 @@ +eb.conf.oct12 \ No newline at end of file diff --git a/evtbuild/eb.conf.oct12 b/evtbuild/eb.conf.oct12 new file mode 100644 index 0000000..d330ce8 --- /dev/null +++ b/evtbuild/eb.conf.oct12 @@ -0,0 +1,210 @@ +# +# #Install: Run CPAN and install +# perl -MCPAN -e shell +# +# #At CPAN shell prompt +# install Config::Std + +#---------------------------------------------- +[Main] + +PORT_BASE: 11000 +WMARK: 60000 + +EB_IP: 192.168.100.12 +EB_OUTDIR: /data/lxhadesdaq/tof_test + +# file/null +EB_OUTDEV: null + +EB_EXT: te + +# file size in MBytes +EB_FSIZE: 1500 + +EB_EVTID: 1 +SHMEMNAME: test + +QUEUESIZE: 4000000 + +# enable online server: --online +# disable online server: +ONLINESERVER: --online + +# buffer sizes for evtbuild and netmem (MB) +BUF_SIZE_LOW: 8 +BUF_SIZE_MID: 16 +BUF_SIZE_HIGH: 32 + +#---------------------------------------------- +[Parallel] + +# EB IPS NOT USED IF CONF_FROM_DB + +EB_IP_1: 192.168.100.15 +EB_IP_2: 192.168.100.12 +EB_IP_3: 192.168.100.13 +EB_IP_4: 192.168.100.14 +EB_IP_5: 192.168.100.11 + +# Number of EB processes per server NOT USED IF CONF_FROM_DB +EB_NUM_1: 1 +EB_NUM_2: 1 +EB_NUM_3: 1 +EB_NUM_4: 1 +EB_NUM_5: 1 + +BASE_PORT: 20100 +SHIFT_PORT: 100 +NUM_OF_SOURCES: 1 + +QUEUESIZE: 32 + +# EB Nr 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +#EB_LIST: 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 +EB_LIST: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +# Switch multiple disk ctrl via daq_disks (1=on,0=off) +MULTIDISK: 1 +WRITE_TO_DISK: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +#WRITE_TO_DISK: 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 + + +# Log the output of EB processes (log=1/dev-null=0) +EB_LOG: 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +NM_LOG: 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + +# Switch (on=1/off=0) EPICS Control of EB processes +# IOC Master is by default the IOC for EB process 1 +EPICS_CTRL: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +# RFIO switch (on=1/off=0) for 16 EB processes +# EB Nr 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +#RFIO: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +RFIO: 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + +# RFIO default options for all EB processes +RFIO_PATH: rfiodaq:gstore:/hadesoct12raw/prod01 +RFIO_pcOptions: wb +#### if LUSTRE fails, switch the following RFIO_iCopyMode to 0: ##### +# 0 no copy to Lustre +# 1 copy to Lustre after the file is in the write cash, +# 2 copy in parallel to Lustre +RFIO_iCopyMode: 1 +RFIO_pcCopyPath: /lustre/hades/oct12 +RFIO_iCopyFraction: 1 +# Maxfile 100, pathconvention 1 to create new subfolder on lustre after 100 events +RFIO_iMaxFile: 0 +RFIO_iPathConvention: 0 + +# Configure EBs based on info in DB files (1=yes,0=no) +CONF_FROM_DB: 1 + +# Table with active data sources +DATA_SOURCES: ../main/data_sources.db +GBE_CONF: ../hub/register_configgbe_ip.db +CTS_CONF: ../cts/register_cts.db + +# +# The following is the individual configuration of EBs +# +#---------------------------------------------- +[EB_PROC_1] + +OUTDIR: /data01/data/ +MULTIDISK: 1 +#RESDOWNSCALE: 20 +#RESNUMEVENTS: 2000 +#RESPATH: /data22/data/res +#RESPATH: /data.local1/data/res +#RESSIZELIMIT: 80 + +#RFIO_pcFile: +#RFIO_pcOptions: + +#---------------------------------------------- +[EB_PROC_2] + +ONLINESERVER: on + +OUTDIR: /data10/data/ + +RESDOWNSCALE: 20 +RESNUMEVENTS: 2000 +RESPATH: /data.local1/data/res +RESSIZELIMIT: 80 + +#RFIO_pcFile: +#RFIO_pcOptions: + +#MULTIDISK: 18 + +#---------------------------------------------- +[EB_PROC_3] + +OUTDIR: /data10/data/ + +#---------------------------------------------- +[EB_PROC_4] + +OUTDIR: /data10/data/ +MULTIDISK: 5 + +#---------------------------------------------- +[EB_PROC_5] + +OUTDIR: /data02/data/ +MULTIDISK: 2 +#---------------------------------------------- +[EB_PROC_6] + +OUTDIR: /data11/data/ + +#---------------------------------------------- +[EB_PROC_7] + +OUTDIR: /data11/data/ + +#---------------------------------------------- +[EB_PROC_8] +OUTDIR: /data11/data/ + +#---------------------------------------------- +[EB_PROC_9] + +OUTDIR: /data03/data/ +MULTIDISK: 3 +#---------------------------------------------- +[EB_PROC_10] + +OUTDIR: /data.local1/data + +#---------------------------------------------- +[EB_PROC_11] + +OUTDIR: /data12/data/ + +#---------------------------------------------- +[EB_PROC_12] + +OUTDIR: /data12/data/ + +#---------------------------------------------- +[EB_PROC_13] + +OUTDIR: /data04/data/ +MULTIDISK: 4 +#---------------------------------------------- +[EB_PROC_14] + +OUTDIR: /data13/data/ + +#---------------------------------------------- +[EB_PROC_15] + +OUTDIR: /data.local1/data + +#---------------------------------------------- +[EB_PROC_16] + +OUTDIR: /data.local1/data diff --git a/evtbuild/eb_logmonitor.pl b/evtbuild/eb_logmonitor.pl new file mode 100755 index 0000000..33af989 --- /dev/null +++ b/evtbuild/eb_logmonitor.pl @@ -0,0 +1,297 @@ +#!/usr/bin/perl -w + +#JAM: changed oper_1 to oper_5 after moving EB server + +use strict; +use Data::Dumper; +use Tie::File; +use Fcntl; +use IO::Handle; +use IO::Socket; +use IO::Select; +use Getopt::Long; +use List::MoreUtils qw(any apply); +use Tie::File; +use threads; +use threads::shared; + +my $opt_help = 0; +my $opt_dir = "/home/hadaq/oper"; +my $opt_sleep = 5; # seconds +my $thread_sleep = 5; # seconds +my $opt_verb = 0; +my $opt_daemon = 0; + +GetOptions ('d|dir=s' => \$opt_dir, + 's|sleep=i' => \$opt_sleep, + 't|thsleep=i' => \$thread_sleep, + 'v|verb' => \$opt_verb, + 'b|daemon' => \$opt_daemon, + 'h|help' => \$opt_help); + +if( $opt_help ) { + &help(); + exit(0); +} + +my $central_log = "$opt_dir/eb_all_log.txt"; +my @tied_files; + +my $opt_sport = 50994; # open this port for status server +my $ExitCode : shared = -1; +my $status : shared = "OK"; + +# 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 { &exitProgram( $signal ); }; +} + +my $app_logfile = "/home/hadaq/log/daq/eb_logmonitor.log"; + +#- Daemonize +if($opt_daemon){ + open(STDIN, '>/dev/null'); + open(STDOUT, ">$app_logfile") || die "Cannot redirect STDOUT"; + open(STDERR, ">&STDOUT") || die "Cannot dup STDERR"; + select STDERR; $| = 1; # make unbuffered + select STDOUT; $| = 1; # make unbuffered +} + +#-------- Start status server thread +threads->new( \&statusServer ); + +while(1){ + &findLogFiles(); + + sleep($opt_sleep); +} + +######################## END OF MAIN ############################## + +sub help() +{ + print "\n"; + print << 'EOF'; +eb_logmonitor.pl + + This script reads log files of parallel Event Building processes. + The script starts a new thread for each log file. After processing + the log files the script writes out the formatted output with time stamp + and other information on all EBs to a separate log file. + +Usage: + + Command line: eb_logmonitor.pl + [-h|--help] : Show this help. + [-s|--sleep ] : Sleep time in sec (default: 5). + [-t|--thsleep ] : Sleep time of threads in sec (default: 5). + [-v|--verb] : More verbouse. + [-d|--dir ] : Directory with log files (default: /home/hadaq/oper). + [-b|--daemon] : Execute as a daemon. + +EOF +} + +sub exitProgram() +{ + # don't allow nested signal handling + return if ($ExitCode ne "-1"); + + # this will stop the treads, too + $ExitCode = shift; + + print "eb_logmonitor.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() )); + } + + close(STDOUT); + close(STDERR); + + # exit with code 0 in case a signal was caught + exit( $ExitCode !~ /^\d+$/ ? 0 : $ExitCode ); +} + +sub findLogFiles() +{ + opendir(DIR, $opt_dir) or die "Could not open $opt_dir: $!"; + my @log_dirs = grep(/^oper_[5|2|3|4]/, readdir(DIR)); + closedir(DIR); + + my $message = " check if mounted:"; + + $message = $message . " $opt_dir/oper_5" unless(any {$_ =~ /^oper_5$/} @log_dirs); + $message = $message . ", $opt_dir/oper_2" unless(any {$_ =~ /^oper_2$/} @log_dirs); + $message = $message . ", $opt_dir/oper_3" unless(any {$_ =~ /^oper_3$/} @log_dirs); + $message = $message . ", $opt_dir/oper_4" unless(any {$_ =~ /^oper_4$/} @log_dirs); + + unless($message eq " check if mounted:"){ + &write2log($message); + } + + #- Add full path to a dir name + my @log_list = apply{ s/oper/$opt_dir\/oper/gxms } @log_dirs; + + &checkMount(\@log_list); + + foreach my $log_dir (@log_list){ + my $log_aref = &getLogFilesFromDir($log_dir); + + foreach my $log_file (@$log_aref){ + + unless( any {$_ eq $log_file} @tied_files ){ + threads->new( \&readLogFile, $log_file ); + push(@tied_files, $log_file); + } + } + } +} + +sub write2log() +{ + my ($msg) = @_; + + my $message = sprintf("%s %10s %19s %s\n", &getTimeStamp(), "lxhadesdaq", "eb_logmonitor.pl:", $msg); + + $| = 1; + print "$message" if($opt_verb); + + open (LOGFILE, ">>$central_log") or die "Can't open $central_log : $!"; + print LOGFILE $message; + close (LOGFILE); +} + +sub getTimeStamp() +{ + my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); + $year += 1900; + + my $timestamp = sprintf("%s %02d %02d:%02d:%02d", $abbr[$mon], $mday, $hour, $min, $sec); + + return $timestamp; +} + +sub getLogFilesFromDir() +{ + my ($log_dir) = @_; + + opendir(DIR, $log_dir) or die "Could not open $opt_dir: $!"; + my @log_files = grep(/^eb\d+_log\.txt$/, readdir(DIR)); + closedir(DIR); + + #- Add full path to a dir name + my @logpath_files = apply{ s/eb/$log_dir\/eb/gxms } @log_files; + + return \@logpath_files; +} + +sub readLogFile() +{ + my ($file2read) = @_; + + print "Start new thread, read log file: $file2read\n" if($opt_verb); + + my $lastline_old = -1; + my @lines; + my $i; + + while(1){ + + tie(@lines, 'Tie::File', $file2read, mode => O_RDONLY, memory => 50000) + or die "Cannot tie file $file2read: $!\n"; + + #--- if new lines appeared in the file2read + if( $#lines > $lastline_old ){ + + open (LOGFILE, ">>$central_log") or die "Can't open $central_log : $!"; + + #--- loop over all new lines in the file2read + for( $i=$lastline_old+1; $i < (1 + $#lines); $i++ ){ + + my $line = $lines[$i]; # extract a line with index i + $| = 1; + print "$line\n" if($opt_verb); + print LOGFILE "$line\n"; + } + + close (LOGFILE); + } + + $lastline_old = (1 + $#lines) - 1; #set index of the last line to lastline_old + + if( $ExitCode ne "-1" ){ + untie(@lines); + print "Exit thread, log file: $file2read\n"; + return; + } + + sleep $thread_sleep; + } +} + +sub checkMount() +{ + my ($mdir_aref) = @_; + + my @mount_list = `mount`; + + foreach my $mdir (@$mdir_aref){ + unless(any {$_ =~ /$mdir/} @mount_list){ + my $message = " check if mounted: $mdir"; + &write2log($message); + } + } +} + +sub statusServer() +{ + my $server_socket; + my $client_socket; + my $selector; + + unless (defined( $server_socket = + IO::Socket::INET->new( LocalPort => $opt_sport, + Proto => 'tcp', + Listen => SOMAXCONN ) )) + { + print "ERROR: Cannot start status server!\n"; + } + + $selector = new IO::Select( $server_socket ); + + while(1) { + + # wait 5 seconds for connections + while (my @file_handles = $selector->can_read( 5 )) { + + foreach my $file_handle (@file_handles) { + + if($file_handle == $server_socket) { + + # create a new socket for this transaction + unless (defined( $client_socket = $server_socket->accept() )) + { + print "ERROR: Cannot open socket to send status!\n"; + &exitProgram( 2 ); + } + + print $client_socket $status; + + close( $client_socket ); + } + } + } + + if( $ExitCode ne "-1" ){ + print "Exit status server thread.\n"; + close( $server_socket ); + return; + } + } +} + diff --git a/evtbuild/scan_active_ports.pl b/evtbuild/scan_active_ports.pl new file mode 100755 index 0000000..01e5952 --- /dev/null +++ b/evtbuild/scan_active_ports.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Getopt::Long; +use IO::Socket; + + +#perl -e 'foreach (qw(50000 50003 50004 50005 50006 50007 50009 50010 50016 50017 50018 50019 50020 50021 50022 50023 50024 50025 50026 50027 50032 50033 50034 50035 50036 50037)) {$r=qx(netcat -w1 -u -l -p $_ | hexdump | head -n 1); chomp $r; print "$_ $r\n"; }' | grep -v "0000000" + +&listen2port(50000); + +######################### END OF PERL ########################## + +sub listen2port() +{ + my ($port) = @_; + + my $socket = new IO::Socket::INET ( LocalPort => '5000', + Proto => 'udp' ) + or die "ERROR in Socket Creation : $!\n"; + + my $peer_address; + my $peer_port; + my $recieved_data; + + while(1) + { + # read operation on the socket + $socket->recv($recieved_data,1024); + + #get the peerhost and peerport at which the recent data received. + $peer_address = $socket->peerhost(); + $peer_port = $socket->peerport(); + print "\n($peer_address , $peer_port) said : $recieved_data"; + } + + $socket->close(); + + +# my $sock = new IO::Socket::INET ( LocalHost => 'lxhadesdaq', +# LocalPort => '$port', +# Proto => 'udp' +# Listen => 1, +# Reuse => 1 ) +# die "Could not create socket: $!\n" unless $sock; + +# my $new_sock = $sock->accept(); + +# while(<$new_sock>) { print $_; } +# close($sock); + +} diff --git a/evtbuild/start_daqmon_ioc.pl b/evtbuild/start_daqmon_ioc.pl new file mode 100755 index 0000000..a241eaf --- /dev/null +++ b/evtbuild/start_daqmon_ioc.pl @@ -0,0 +1,270 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use FileHandle; +use List::MoreUtils qw(any apply first_index); +use File::Basename; + +#- the command line option flags +my $opt_help = 0; +my $opt_server = "192.168.100.12"; +my $opt_ioc = ""; +my $opt_test = 0; +my $opt_verb = 0; + +GetOptions ('h|help' => \$opt_help, + 's|server=s' => \$opt_server, + 'i|ioc=s' => \$opt_ioc, + 't|test' => \$opt_test, + 'v|verb' => \$opt_verb); + +if( $opt_help ) { + &help(); + exit(0); +} + +my $expect_ioc_script = "/tmp/ioc_mon_exit.exp"; +my $log_path = "/tmp/log"; + +if($opt_ioc eq "start"){ + &killIOC(); + &startIOC(); +} +elsif($opt_ioc eq "stop"){ + &killIOC(); +} + +exit(0); + +################### END OF MAIN #################### + +sub help() +{ + print "\n"; + print << 'EOF'; +start_daqmon_ioc.pl + + This script starts IOC to monitor DAQ via TRB-Net. + +Usage: + + Command line: start_eb_gbe.pl + [-h|--help] : Show this help. + [-s|--server ] : Server name where IOC will run. + [-i|--ioc ] : Start or stop IOC (default: start). + [-t|--test] : Run script in test mode (without IOC execution). + [-v|--verb] : Verbose mode. + +EOF +} + +sub startIOC() +{ + my $ioc_dir = "/home/scs/ebctrl/ioc/iocBoot/iocebctrl"; + + &writeIOC_stcmd( $ioc_dir ); + + print "Starting IOC...\n" if($opt_verb); + + my $stcmd = sprintf("st_mon%02d.cmd", 1); + my $screen_name = sprintf("ioc_mon%02d", 1); + + my $cmd = "bash; . /home/scs/.bashrc; cd $ioc_dir; screen -dmS $screen_name ../../bin/linux-x86_64/ebctrl $stcmd"; + + my $exe = "ssh -n $opt_server -l scs \"$cmd\""; + + print "Exec: $exe\n" if($opt_verb); + system($exe) unless($opt_test); +} + +sub writeIOC_stcmd() +{ + my ($ioc_dir) = @_; + + print "Copying st.cmd files to server...\n" if($opt_verb); + + my $ioc_stcmd = <$outfile"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$outfile\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $ioc_stcmd; + $fh->close(); + + my $cmd = "scp $outfile scs\@$opt_server:$ioc_dir/."; + + print "Exec: $cmd\n" if($opt_verb); + system($cmd) unless($opt_test); +} + +sub killIOC() +{ + my %ioc; + my $ioc_href = \%ioc; + + print "Looking for running IOCs...\n" if($opt_verb); + + &findRunningIOC($ioc_href); + + &writeExpectIOC() if( defined %$ioc_href ); + + if($opt_verb){ + print "Killing running IOCs...\n"; + print "No IOCs found - nothing to kill, continue...\n" unless( defined %$ioc_href ); + } + + my (@process_list); + + foreach my $ip ( %$ioc_href ){ + foreach my $ioc ( @{$ioc_href->{$ip}} ){ + + my $cmd = $expect_ioc_script . " " . $ip . " " . $ioc; + my $log = $log_path . "/log_" . $ip . "_" . $ioc . ".txt"; + + &forkMe($cmd, $log, \@process_list); + } + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid($cur_child_pid,0); + } +} + +sub forkMe() +{ + my ($cmd, $log, $proc_list) = @_; + + my $child = fork(); + + if( $child ){ # parent + push( @$proc_list, $child ); + } + elsif( $child == 0 ) { # child + system("$cmd > $log"); + exit(0); + } + else{ + print "Could not fork: $!\n"; + exit(1); + } +} + +sub findRunningIOC() +{ + my ($ioc_href) = @_; + + my $exe = "ssh -n $opt_server -l scs \"screen -ls\""; + + my @output = `$exe`; + + foreach my $line (@output){ + if($line =~ /\d+\.(ioc_mon\d{2})\s+/){ + my $name = $1; + push( @{$ioc_href->{$opt_server}}, $name ); + print "Found IOC: $name on $opt_server\n" if($opt_verb); + } + } +} + +sub writeExpectIOC() +{ + # This expect script can be executed to exit IOC. + + #! Look if /tmp dir exists + my $tmp_dir = dirname("/tmp"); + if ( !(-d $tmp_dir) ){ + print "\nCannot access /tmp directory!\nExit.\n"; + exit(1); + } + + my $expect_script_my = <0} { + set ip [lindex \$argv 0] + set iocname [lindex \$argv 1] +} else { + send_user "Usage: \$argv0 ip iocname\\n" +} + +spawn ssh scs@\$ip + +#expect { +# "error" { exit; } +# "login:" { exit; } +# "Password:" { exit; } +#} + +set timeout 240 + +expect "~\$ " +send "screen -r \$iocname\\r" +expect "epics> " +send "exit\\r" +expect "~\$ " + +EOF + + my $fh = new FileHandle(">$expect_ioc_script"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$expect_ioc_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $expect_script_my; + $fh->close(); + + #- open permissions + system("chmod 755 $expect_ioc_script"); +} diff --git a/evtbuild/start_eb.pl b/evtbuild/start_eb.pl new file mode 100755 index 0000000..d24af1f --- /dev/null +++ b/evtbuild/start_eb.pl @@ -0,0 +1,581 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use Config::Std; +use FileHandle; +use List::MoreUtils qw(any apply); +use File::Basename; + +#- the command line option flags +my $opt_help = 0; +my $opt_ebconf = "../evtbuild/eb.conf"; +my $opt_ioc = 0; +my $opt_test = 0; +my $opt_verb = 0; +my $opt_eb = "start"; + +GetOptions ('h|help' => \$opt_help, + 'c|conf=s' => \$opt_ebconf, + 'e|eb=s' => \$opt_eb, + 'i|ioc' => \$opt_ioc, + 't|test' => \$opt_test, + 'v|verb' => \$opt_verb); + +if( $opt_help ) { + &help(); + exit(0); +} + +my $expect_ioc_script = "/tmp/ioc_exit.exp"; +my $log_path = "/tmp/log"; + +my $numOfEBProcs = 0; +my @EB_Args; +my $EB_Args_aref = \@EB_Args; + +my @EB_IP_list; + +&getEBArgs( $EB_Args_aref ); + +if($opt_ioc){ + &killIOC(); + &startIOC(); +} +elsif($opt_eb eq "start"){ + &stopEvtBuilders(); + &startEvtBuilders(); +} +elsif($opt_eb eq "stop"){ + &stopEvtBuilders(); +} + +exit(0); + +################### END OF MAIN #################### + +sub help() +{ + print "\n"; + print << 'EOF'; +start_eb.pl + + This script starts parallel Event Building processes. + The script also starts IOC processes for the run control. + +Usage: + + Command line: startup.pl + [-h|--help] : Show this help. + [-c|--conf ] : Path to the config file (default: ../evtbuild/eb.conf). + [-e|--eb ] : Start or stop Event Builders (default: start). + [-i|--ioc] : Start IOC. + [-t|--test] : Test without execution. + [-v|--verb] : More verbouse. + +EOF +} + +sub getEBArgs() +{ + + my ($aref) = @_; + + my %temp_args; + my $temp_args_href = \%temp_args; + + read_config $opt_ebconf => %$temp_args_href; + + my $prefix = $temp_args_href->{'Main'}->{'EB_EXT'}; + + my $base_port = $temp_args_href->{'Parallel'}->{'BASE_PORT'}; + my $shift_port = $temp_args_href->{'Parallel'}->{'SHIFT_PORT'}; + my $source_num = $temp_args_href->{'Parallel'}->{'NUM_OF_SOURCES'}; + + #- Number of EB process + my $ebproc = 0; + + #- Default RFIO settings + my $rfio = $temp_args_href->{'Parallel'}->{'RFIO'}; + my $rfio_path = $temp_args_href->{'Parallel'}->{'RFIO_PATH'}; + my $rfio_pcOptions = $temp_args_href->{'Parallel'}->{'RFIO_pcOptions'}; + my $rfio_iCopyMode = $temp_args_href->{'Parallel'}->{'RFIO_iCopyMode'}; + my $rfio_pcCopyPath = $temp_args_href->{'Parallel'}->{'RFIO_pcCopyPath'}; + my $rfio_iCopyFrac = $temp_args_href->{'Parallel'}->{'RFIO_iCopyFraction'}; + my $rfio_iMaxFile = $temp_args_href->{'Parallel'}->{'RFIO_iMaxFile'}; + my $rfio_iPathConv = $temp_args_href->{'Parallel'}->{'RFIO_iPathConvention'}; + + my @rfio_list = split(/ /, $rfio); + + #- EPICS Controled + my $epics_ctrl = $temp_args_href->{'Parallel'}->{'EPICS_CTRL'}; + + my @epics_list = split(/ /, $epics_ctrl); + + #- Logging the output of EBs + my $eb_log = $temp_args_href->{'Parallel'}->{'EB_LOG'}; + my $nm_log = $temp_args_href->{'Parallel'}->{'NM_LOG'}; + my @eblog_list = split(/ /, $eb_log); + my @nmlog_list = split(/ /, $nm_log); + + #- Write to disk + my $write2disk = $temp_args_href->{'Parallel'}->{'WRITE_TO_DISK'}; + my @write2disk_list = split(/ /, $write2disk); + + #--- Loop over servers + foreach my $num (1..4){ + + my $ip_name = 'EB_IP_' . $num; + next unless( defined $temp_args_href->{'Parallel'}->{$ip_name} ); + + my $num_name = 'EB_NUM_' . $num; + unless( defined $temp_args_href->{'Parallel'}->{$num_name} ){ + print "\nNumber of EBs per server ($num_name) is not defined in $opt_ebconf!\n"; + print "Exit.\n"; + exit(1); + } + + my $eb_ip = $temp_args_href->{'Parallel'}->{$ip_name}; + my $eb_num = $temp_args_href->{'Parallel'}->{$num_name}; + + push(@EB_IP_list, $eb_ip); + + #--- Loop over EB processes on a given server + foreach my $ebnum (1..$eb_num){ + + #- Increment index of EB process + $ebproc++; + + #- Some checks on number of EB processes + die "Number of EB processes exceeds the number in RFIO setting! Exit." if($ebproc > 1 + $#rfio_list); + die "Number of EB processes exceeds the number in EPICS_CTRL setting! Exit." if($ebproc > 1 + $#epics_list); + + #- Here we can overwrite default rfio settings with individual settings per EB processes + # my $procname = sprintf("EB_PROC_%d", $ebproc); + # $rfio_iCopyMode = $temp_args_href->{$procname}->{'RFIO_iCopyMode'}; + + #- Calculate base port for given EB process + my $baseport = ($ebnum - 1) * $shift_port + $base_port; + + $aref->[$ebproc-1]->{'IP'} = $eb_ip; + $aref->[$ebproc-1]->{'EBNUM'} = $ebproc; + $aref->[$ebproc-1]->{'BASEPORT'} = $baseport; + $aref->[$ebproc-1]->{'SOURCENUM'} = $source_num; + $aref->[$ebproc-1]->{'PREFIX'} = $prefix; + + $aref->[$ebproc-1]->{'RFIO'} = $rfio_list[$ebproc-1]; + $aref->[$ebproc-1]->{'RFIO_PATH'} = $rfio_path; + $aref->[$ebproc-1]->{'RFIO_pcOptions'} = $rfio_pcOptions; + $aref->[$ebproc-1]->{'RFIO_iCopyMode'} = $rfio_iCopyMode; + $aref->[$ebproc-1]->{'RFIO_pcCopyPath'} = $rfio_pcCopyPath; + $aref->[$ebproc-1]->{'RFIO_iCopyFrac'} = $rfio_iCopyFrac; + $aref->[$ebproc-1]->{'RFIO_iMaxFile'} = $rfio_iMaxFile; + $aref->[$ebproc-1]->{'RFIO_iPathConv'} = $rfio_iPathConv; + + $aref->[$ebproc-1]->{'EPICS_CTRL'} = $epics_list[$ebproc-1]; + + $aref->[$ebproc-1]->{'EB_LOG'} = $eblog_list[$ebproc-1]; + $aref->[$ebproc-1]->{'NM_LOG'} = $nmlog_list[$ebproc-1]; + + if( $write2disk_list[$ebproc-1] ){ + my $eb_proc_name = "EB_PROC_" . $ebproc; + $aref->[$ebproc-1]->{'OUTDIR'} = $temp_args_href->{$eb_proc_name}->{'OUTDIR'}; + } + } + } + + $numOfEBProcs = $ebproc; +} + +sub startEvtBuilders() +{ + + my $username = "hadaq"; + + my (@process_list); + + foreach my $ebproc (1..$numOfEBProcs){ + + #--- Prepare execution of daq_evtbuild + my $cmd_eb = "/home/hadaq/bin/daq_evtbuild" . + " -m " . $EB_Args_aref->[$ebproc-1]->{'SOURCENUM'} . + " -q 16000000 " . + " -S " . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . + " --ebnum " . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . + " -x " . $EB_Args_aref->[$ebproc-1]->{'PREFIX'}; + + + if( defined $EB_Args_aref->[$ebproc-1]->{'OUTDIR'}){ + $cmd_eb = $cmd_eb . " -d file -o " . $EB_Args_aref->[$ebproc-1]->{'OUTDIR'}; + } + else{ + $cmd_eb = $cmd_eb . " -d null"; + } + + my $cpu = $EB_Args_aref->[$ebproc-1]->{'IP'}; + + #- add rfio args + my $rfio; + if( $EB_Args_aref->[$ebproc-1]->{'RFIO'} ){ + $rfio = " --rfio " . $EB_Args_aref->[$ebproc-1]->{'RFIO_PATH'} . + " --rfiolustre " . $EB_Args_aref->[$ebproc-1]->{'RFIO_pcCopyPath'} . + " --rfio_pcoption " . $EB_Args_aref->[$ebproc-1]->{'RFIO_pcOptions'} . + " --rfio_icopymode " . $EB_Args_aref->[$ebproc-1]->{'RFIO_iCopyMode'} . + " --rfio_icopyfrac " . $EB_Args_aref->[$ebproc-1]->{'RFIO_iCopyFrac'} . + " --rfio_imaxfile " . $EB_Args_aref->[$ebproc-1]->{'RFIO_iMaxFile'} . + " --rfio_ipathconv " . $EB_Args_aref->[$ebproc-1]->{'RFIO_iPathConv'}; + } + + $cmd_eb = $cmd_eb . $rfio if( defined $rfio ); + + #- add epics controlled + $cmd_eb = $cmd_eb . " --epicsctrl " if( $EB_Args_aref->[$ebproc-1]->{'EPICS_CTRL'} ); + + #- logging the output + my $eblog_file = "/tmp/log_eb_" . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . ".txt"; + my $eb_log = "1>$eblog_file 2>$eblog_file"; + $eb_log = "1>/dev/null 2>/dev/null" unless( $EB_Args_aref->[$ebproc-1]->{'EB_LOG'} ); + + my $exe_eb = "ssh -n $cpu -l $username \"bash; cd /home/hadaq/oper; export DAQ_SETUP=/home/hadaq/oper/eb; $cmd_eb $eb_log &\""; + + + #--- Prepare execution of daq_netmem + my $base_port = $EB_Args_aref->[$ebproc-1]->{'BASEPORT'}; + my $source_num = $EB_Args_aref->[$ebproc-1]->{'SOURCENUM'}; + + my $cmd_nm = "/home/hadaq/bin/daq_netmem" . + " -m " . $source_num . + " -q 16000000 " . + " -S " . $EB_Args_aref->[$ebproc-1]->{'EBNUM'}; + + #--- Loop over data sources + foreach my $source (1..$source_num){ + my $port = $base_port + $source - 1; + + $cmd_nm = $cmd_nm . " -i UDP:0.0.0.0:" . $port; + } + + #- logging the output + my $nmlog_file = "/tmp/log_nm_" . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . ".txt"; + my $nm_log = "1>$nmlog_file 2>$nmlog_file"; + $nm_log = "1>/dev/null 2>/dev/null" unless( $EB_Args_aref->[$ebproc-1]->{'NM_LOG'} ); + + my $exe_nm = "ssh -n $cpu -l $username \"bash; cd /home/hadaq/oper; $cmd_nm $nm_log &\""; + + #--- Open permissions for shared memory + my $eb_shmem = "daq_evtbuild" . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . ".shm"; + my $nm_shmem = "daq_netmem" . $EB_Args_aref->[$ebproc-1]->{'EBNUM'} . ".shm"; + my $exe_open_eb = "ssh -n $cpu -l $username \"chmod 775 /dev/shm/$eb_shmem\""; + my $exe_open_nm = "ssh -n $cpu -l $username \"chmod 775 /dev/shm/$nm_shmem\""; + + &forkEB($exe_eb, $exe_nm, $exe_open_eb, $exe_open_nm, \@process_list); + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid($cur_child_pid,0); + } +} + +sub stopEvtBuilders() +{ + my $username = "hadaq"; + + #--- Loop over server IPs + foreach my $ip (@EB_IP_list){ + + my $exe = "ssh -n $ip -l $username \"killall daq_netmem 1>/dev/null 2>/dev/null; killall daq_evtbuild 1>/dev/null 2>/dev/null\""; + + if($opt_verb){ + print "Killing running EBs...\n"; + print "Exec: $exe\n"; + } + + system("$exe") unless($opt_test); + } +} + +sub startIOC() +{ + my $ioc_dir = "/home/scs/ebctrl/ioc/iocBoot/iocebctrl"; + + &writeIOC_stcmd( $ioc_dir ); + + print "Starting IOCs...\n" if($opt_verb); + + foreach my $ebproc (1..$numOfEBProcs){ + + my $stcmd = sprintf("st_eb%02d.cmd", $ebproc); + my $screen_name = sprintf("ioc_eb%02d", $ebproc); + + my $cmd = "bash; . /home/scs/.bashrc; cd $ioc_dir; screen -dmS $screen_name ../../bin/linux-x86_64/ebctrl $stcmd"; + my $cpu = $EB_Args_aref->[$ebproc-1]->{'IP'}; + + my $exe = "ssh -n $cpu -l scs \"$cmd\""; + + print "Exec: $exe\n" if($opt_verb); + system($exe) unless($opt_test); + } +} + +sub writeIOC_stcmd() +{ + my ($ioc_dir) = @_; + + print "Copying st.cmd files to servers...\n" if($opt_verb); + + foreach my $ebproc (1..$numOfEBProcs){ + + my $ebnum = sprintf("eb%02d", $ebproc); + + my $ebtype = "slave"; + my $comment_genrunid = "#"; + + if($ebproc == 1){ + $ebtype = "master"; + $comment_genrunid = ""; + } + + my $ioc_stcmd = <$outfile"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$outfile\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $ioc_stcmd; + $fh->close(); + + my $ip = $EB_Args_aref->[$ebproc-1]->{'IP'}; + my $cmd = "scp $outfile scs\@$ip:$ioc_dir/."; + + print "Exec: $cmd\n" if($opt_verb); + system($cmd) unless($opt_test); + } +} + +sub killIOC() +{ + my %ioc; + my $ioc_href = \%ioc; + + print "Looking for running IOCs...\n" if($opt_verb); + + #--- Loop over server IPs + foreach my $ip (@EB_IP_list){ + + &findRunningIOC($ip, $ioc_href); + } + + &writeExpectIOC() if( defined %$ioc_href ); + + if($opt_verb){ + print "Killing running IOCs...\n"; + print "No IOCs found - nothing to kill, continue...\n" unless( defined %$ioc_href ); + } + + my (@process_list); + + foreach my $ip ( %$ioc_href ){ + foreach my $ioc ( @{$ioc_href->{$ip}} ){ + + my $cmd = $expect_ioc_script . " " . $ip . " " . $ioc; + my $log = $log_path . "/log_" . $ip . "_" . $ioc . ".txt"; + + &forkMe($cmd, $log, \@process_list); + } + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid($cur_child_pid,0); + } +} + +sub forkMe() +{ + my ($cmd, $log, $proc_list) = @_; + + my $child = fork(); + + if( $child ){ # parent + push( @$proc_list, $child ); + } + elsif( $child == 0 ) { # child + system("$cmd > $log"); + exit(0); + } + else{ + print "Could not fork: $!\n"; + exit(1); + } +} + +sub forkEB() +{ + my ($exe_eb, $exe_nm, $exe_open_eb, $exe_open_nm, $proc_list) = @_; + + my $child = fork(); + + if( $child ){ # parent + push( @$proc_list, $child ); + } + elsif( $child == 0 ) { # child + #--- Execute Event Builder + print "Exec: $exe_eb\n" if($opt_verb); + system($exe_eb) unless($opt_test); + + sleep(1); + + #--- Open permissions for EB shared memory + print "Exec: $exe_open_eb\n" if($opt_verb); + system($exe_open_eb) unless($opt_test); + + sleep(2); + + #--- Execute Net-2-Memory + print "Exec: $exe_nm\n" if($opt_verb); + system($exe_nm) unless($opt_test); + + sleep(1); + + #--- Open permissions for NM shared memory + print "Exec: $exe_open_nm\n" if($opt_verb); + system($exe_open_nm) unless($opt_test); + + exit(0); + } + else{ + print "Could not fork: $!\n"; + exit(1); + } +} + +sub findRunningIOC() +{ + my ($cpu, $ioc_href) = @_; + + my $exe = "ssh -n $cpu -l scs \"screen -ls\""; + + my @output = `$exe`; + + foreach my $line (@output){ + if($line =~ /\d+\.(ioc_eb\d{2})\s+/){ + my $name = $1; + push( @{$ioc_href->{$cpu}}, $name ); + print "Found IOC: $name on $cpu\n" if($opt_verb); + } + } +} + +sub writeExpectIOC() +{ + # This expect script can be executed to exit IOC. + + #! Look if /tmp dir exists + my $tmp_dir = dirname("/tmp"); + if ( !(-d $tmp_dir) ){ + print "\nCannot access /tmp directory!\nExit.\n"; + exit(1); + } + + my $expect_script_my = <0} { + set ip [lindex \$argv 0] + set iocname [lindex \$argv 1] +} else { + send_user "Usage: \$argv0 ip iocname\\n" +} + +spawn ssh scs@\$ip + +#expect { +# "error" { exit; } +# "login:" { exit; } +# "Password:" { exit; } +#} + +set timeout 240 + +expect "~\$ " +send "screen -r \$iocname\\r" +expect "epics> " +send "exit\\r" +expect "~\$ " + +EOF + + my $fh = new FileHandle(">$expect_ioc_script"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$expect_ioc_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $expect_script_my; + $fh->close(); + + #- open permissions + system("chmod 755 $expect_ioc_script"); +} + diff --git a/evtbuild/start_eb_gbe.pl b/evtbuild/start_eb_gbe.pl new file mode 100755 index 0000000..2d22772 --- /dev/null +++ b/evtbuild/start_eb_gbe.pl @@ -0,0 +1,1312 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use Config::Std; +use FileHandle; +use List::MoreUtils qw(any apply first_index); +use File::Basename; +use Cwd; + +#- Copy all the arguments because +# later on the @ARGV becomes empty +my @arg_list = @ARGV; + +#- the command line option flags +my $opt_help = 0; +my $opt_ebconf = "/home/hadaq/trbsoft/daq/evtbuild/eb.conf"; +my $opt_ioc = ""; +my $opt_test = 0; +my $opt_verb = 0; +my $opt_eb = ""; +my @opt_ebrange = (); +my $opt_rfio = 'undef'; +my $opt_disk = 'undef'; +my $opt_online = 'undef'; +my $opt_prefix; + +GetOptions ('h|help' => \$opt_help, + 'c|conf=s' => \$opt_ebconf, + 'e|eb=s' => \$opt_eb, + 'i|ioc=s' => \$opt_ioc, + 't|test' => \$opt_test, + 'n|nr=s' => \@opt_ebrange, + 'd|disk=s' => \$opt_disk, + 'r|rfio=s' => \$opt_rfio, + 'p|prefix=s' => \$opt_prefix, + 'o|online=s' => \$opt_online, + 'v|verb' => \$opt_verb); + +if( $opt_help ) { + &help(); + exit(0); +} + +#- List of EBs provided via command line options +my $active_EBs_aref = &setArgs(); + +#- Hash with status of CPU cores of EBs (used for 'taskset') +my %EB_CPU_status; +my $EB_CPU_status_href = \%EB_CPU_status; +&init_CPU_status($EB_CPU_status_href); + +my $expect_ioc_script = "/tmp/ioc_exit.exp"; +my $log_path = "/tmp/log"; + +my %temp_args; +my $temp_args_href = \%temp_args; +read_config $opt_ebconf => %$temp_args_href; +#print Dumper $temp_args_href; +#exit; + +my $numOfEBProcs = 0; +my %EB_Args; +my $EB_Args_href = \%EB_Args; + +my @EB_IP_list; + +&getEBArgs( $EB_Args_href ); + +if($opt_ioc eq "start"){ + &killIOC(); + &startIOC(); +} +elsif($opt_ioc eq "stop"){ + &killIOC(); +} +elsif($opt_eb eq "start"){ + &writeArgs2file(); + &startEvtBuilders(); +} +elsif($opt_eb eq "stop"){ + &stopEvtBuilders(); +} +elsif($opt_eb eq "restart"){ + &stopEvtBuilders(); + sleep 1; + &writeArgs2file(); + &startEvtBuilders(); +} + +exit(0); + +################### END OF MAIN #################### + +sub help() +{ + print "\n"; + print << 'EOF'; +start_eb_gbe.pl + + This script starts parallel Event Building processes. + The script also starts IOC processes for the run control. + +Usage: + + Command line: start_eb_gbe.pl + [-h|--help] : Show this help. + [-c|--conf ] : Path to the config file (default: ../evtbuild/eb.conf). + [-e|--eb ] : Start or stop Event Builders (default: start). + [-i|--ioc ] : Start or stop IOCs (default: start). + [-n|--nr ] : Range of numbers of Event Bulders to be started. + [-d|--disk ] : Switch writing to disk on|off. + [-r|--rfio ] : Switch writing to tape on|off. + [-p|--prefix ] : Prefix of hld file. + [-o|--online ] : Switch RPC server on|off. + [-t|--test] : Test without execution. + [-v|--verb] : More verbouse. + +Examples: + + Start 6 EBs with the numbers 1,2,3,5,7 and prefix 'md': + start_eb_gbe.pl -e start -n 1-3 -n 5 -n 7 -p md + + Start EBs and enable writing to disks but disable writing to tape for all EBs: + start_eb_gbe.pl -e start --disk on --rfio off + +EOF +} + +sub init_CPU_status() +{ + my ($EB_CPU_status_href) = @_; + + # CPU affinity with 'taskset' + # + # CPU dec bin hex + # 0 1 1 + # 1 10 2 + # 2 100 4 + # 3 1000 8 + # 4 10000 10 + + #cores 0/1 reserved for system 02-05 + #cores 2/3 reserved for interrupts on 02-05 + + foreach my $core (0..7){ + if($core == 1){ + $EB_CPU_status_href->{'192.168.100.11'}->{$core} = "res"; #reserved + } + else{ + $EB_CPU_status_href->{'192.168.100.11'}->{$core} = "free"; + } + } + + foreach my $core (0..11){ + if($core < 4){ + $EB_CPU_status_href->{'192.168.100.12'}->{$core} = "res"; #reserved + $EB_CPU_status_href->{'192.168.100.13'}->{$core} = "res"; #reserved + $EB_CPU_status_href->{'192.168.100.14'}->{$core} = "res"; #reserved + } + else{ + $EB_CPU_status_href->{'192.168.100.12'}->{$core} = "free"; + $EB_CPU_status_href->{'192.168.100.13'}->{$core} = "free"; + $EB_CPU_status_href->{'192.168.100.14'}->{$core} = "free"; + } + } + + foreach my $core (0..23){ + if($core < 4){ + $EB_CPU_status_href->{'192.168.100.15'}->{$core} = "res"; #reserved + } + else{ + $EB_CPU_status_href->{'192.168.100.15'}->{$core} = "free"; + } + } +} + +sub getCoreNr() +{ + my ($ip) = @_; + + my $core_nr; + + foreach my $eb_ip (sort keys %$EB_CPU_status_href){ + next unless($ip eq $eb_ip); + + foreach my $core ( sort {$a <=> $b} keys %{$EB_CPU_status_href->{$eb_ip}} ){ + my $core_status = $EB_CPU_status_href->{$eb_ip}->{$core}; + + next unless(lc($core_status) eq "free"); + + $core_nr = $core; + $EB_CPU_status_href->{$eb_ip}->{$core} = "busy"; + last; + } + } + + #- If no free cores left - take reserved cores + unless( defined $core_nr ){ + foreach my $eb_ip (sort keys %$EB_CPU_status_href){ + next unless($ip eq $eb_ip); + + foreach my $core ( sort {$a <=> $b} keys %{$EB_CPU_status_href->{$eb_ip}} ){ + my $core_status = $EB_CPU_status_href->{$eb_ip}->{$core}; + + if(lc($core_status) eq "res"){ + $core_nr = $core; + $EB_CPU_status_href->{$eb_ip}->{$core} = "busy"; + last; + } + } + } + } + + unless( defined $core_nr ){ + print "No free cores left on CPU $ip. Exit.\n"; + exit(0); + } + + return $core_nr; +} + +sub setArgs() +{ + my @active_EBs; + + if(@opt_ebrange){ + foreach my $range (@opt_ebrange){ + if($range =~ /(\d+)-(\d+)/){ + my $max = $1; + my $min = $2; + + foreach my $eb ($max..$min){ + #- 1 must be subtracted to match + # EB numbering in the register_configgbe_ip.db + # which starts from zero + &checkEB_nr($eb); + push(@active_EBs, $eb-1); + } + } + elsif($range =~ /(\d+)/){ + &checkEB_nr($1); + push(@active_EBs, $1-1); + } + } + } + + return \@active_EBs; +} + +sub checkEB_nr() +{ + my ($eb_nr) = @_; + + if( $eb_nr < 1 || $eb_nr > 16 ){ + print "ERROR: EB number should be in the range 1-16. Exit."; + exit(0); + } +} + +sub getEBArgs() +{ + my ($href) = @_; + + my $prefix = $temp_args_href->{'Main'}->{'EB_EXT'}; + $prefix = $opt_prefix if( defined $opt_prefix ); + my $filesize = $temp_args_href->{'Main'}->{'EB_FSIZE'}; + + my $base_port = $temp_args_href->{'Parallel'}->{'BASE_PORT'}; + my $shift_port = $temp_args_href->{'Parallel'}->{'SHIFT_PORT'}; + my $source_num = $temp_args_href->{'Parallel'}->{'NUM_OF_SOURCES'}; + my $queuesize = $temp_args_href->{'Parallel'}->{'QUEUESIZE'}; + + my $multidisk = $temp_args_href->{'Parallel'}->{'MULTIDISK'}; + + #- Number of EB process + my $ebproc = 0; + + #- List of BEs + my $listOfEBs = $temp_args_href->{'Parallel'}->{'EB_LIST'}; + my @eb_list = split(/\s+/, $listOfEBs); + + #- Default RFIO settings + my $rfio = $temp_args_href->{'Parallel'}->{'RFIO'}; + my $rfio_path = $temp_args_href->{'Parallel'}->{'RFIO_PATH'}; + my $rfio_pcOptions = $temp_args_href->{'Parallel'}->{'RFIO_pcOptions'}; + my $rfio_iCopyMode = $temp_args_href->{'Parallel'}->{'RFIO_iCopyMode'}; + my $rfio_pcCopyPath = $temp_args_href->{'Parallel'}->{'RFIO_pcCopyPath'}; + my $rfio_iCopyFrac = $temp_args_href->{'Parallel'}->{'RFIO_iCopyFraction'}; + my $rfio_iMaxFile = $temp_args_href->{'Parallel'}->{'RFIO_iMaxFile'}; + my $rfio_iPathConv = $temp_args_href->{'Parallel'}->{'RFIO_iPathConvention'}; + + my @rfio_list = split(/\s+/, $rfio); + + #- EPICS Controled + my $epics_ctrl = $temp_args_href->{'Parallel'}->{'EPICS_CTRL'}; + + my @epics_list = split(/\s+/, $epics_ctrl); + + #- Logging the output of EBs + my $eb_log = $temp_args_href->{'Parallel'}->{'EB_LOG'}; + my $nm_log = $temp_args_href->{'Parallel'}->{'NM_LOG'}; + my @eblog_list = split(/\s+/, $eb_log); + my @nmlog_list = split(/\s+/, $nm_log); + + #- Write to disk + my $write2disk = $temp_args_href->{'Parallel'}->{'WRITE_TO_DISK'}; + my @write2disk_list = split(/\s+/, $write2disk); + + #--- Read GbE configuration + my %eb_ids_gbe_hash; + my $eb_ids_gbe_href = \%eb_ids_gbe_hash; + + &getGbEconfig($eb_ids_gbe_href); + + #--- Loop over all EB processes + #print Dumper $eb_ids_gbe_href; + #exit; + foreach my $ebproc ( sort keys %{$eb_ids_gbe_href} ){ + + #- If there was a list of EBs provided via command line options + # go to the next $ebproc if the current $ebproc is not in this list. + #print "active EBs:\n"; + #print Dumper $active_EBs_aref; + + if(@$active_EBs_aref){ + next unless( any {$_ == $ebproc} @$active_EBs_aref ); #from command line args + } + else{ + next unless( $eb_list[$ebproc] ); #from eb.conf + } + + + my $eb_ip = $eb_ids_gbe_href->{$ebproc}->{'IP'}; + + #- Save IP needed by other function to stop EBs. + push(@EB_IP_list, $eb_ip) unless( any {$_ eq $eb_ip} @EB_IP_list ); + + #- Some checks on number of EB processes + die "Number of EB processes exceeds the number in RFIO setting! Exit." if($ebproc > $#rfio_list); + die "Number of EB processes exceeds the number in EPICS_CTRL setting! Exit." if($ebproc > $#epics_list); + + #- Here we can overwrite default rfio settings with individual settings per EB processes + my $procname = sprintf("EB_PROC_%d", 1+$ebproc); + # $rfio_iCopyMode = $temp_args_href->{$procname}->{'RFIO_iCopyMode'}; + + $href->{$ebproc}->{'IP'} = $eb_ip; + $href->{$ebproc}->{'EBNUM'} = $ebproc+1; + $href->{$ebproc}->{'BASEPORT'} = $base_port; + $href->{$ebproc}->{'PORT_LIST'} = $eb_ids_gbe_href->{$ebproc}->{'port_list'}; + $href->{$ebproc}->{'SOURCENUM'} = scalar @{$eb_ids_gbe_href->{$ebproc}->{'port_list'}}; + $href->{$ebproc}->{'BUFSIZE_LIST'} = $eb_ids_gbe_href->{$ebproc}->{'bufsize_list'}; + $href->{$ebproc}->{'PREFIX'} = $prefix; + $href->{$ebproc}->{'QUEUESIZE'} = $queuesize; + $href->{$ebproc}->{'MULTIDISK'} = $multidisk; + $href->{$ebproc}->{'FILESIZE'} = $filesize; + + if( defined $temp_args_href->{$procname}->{'MULTIDISK'} ){ + $href->{$ebproc}->{'MULTIDISK'} = $temp_args_href->{$procname}->{'MULTIDISK'}; + } + elsif($multidisk){ + $href->{$ebproc}->{'MULTIDISK'} = $href->{$ebproc}->{'EBNUM'}; + } + else{ + $href->{$ebproc}->{'MULTIDISK'} = $multidisk; + } + + if( defined $temp_args_href->{$procname}->{'RESDOWNSCALE'} ){ + $href->{$ebproc}->{'RESDOWNSCALE'} = $temp_args_href->{$procname}->{'RESDOWNSCALE'}; + $href->{$ebproc}->{'RESNUMEVENTS'} = $temp_args_href->{$procname}->{'RESNUMEVENTS'}; + $href->{$ebproc}->{'RESPATH'} = $temp_args_href->{$procname}->{'RESPATH'}; + $href->{$ebproc}->{'RESSIZELIMIT'} = $temp_args_href->{$procname}->{'RESSIZELIMIT'}; + } + + if( defined $temp_args_href->{$procname}->{'ONLINESERVER'} ){ + if($opt_online eq "on"){ + $href->{$ebproc}->{'ONLINESERVER'} = "on"; + } + elsif($opt_online eq "off"){ + $href->{$ebproc}->{'ONLINESERVER'} = "off"; + } + else{ + $href->{$ebproc}->{'ONLINESERVER'} = $temp_args_href->{$procname}->{'ONLINESERVER'}; + } + } + else{ + $href->{$ebproc}->{'ONLINESERVER'} = "off"; + } + + $href->{$ebproc}->{'RFIO'} = $rfio_list[$ebproc] if(lc($opt_rfio) eq 'undef'); # 0|1 + $href->{$ebproc}->{'RFIO'} = 1 if(lc($opt_rfio) eq 'on'); # 0|1 + $href->{$ebproc}->{'RFIO'} = 0 if(lc($opt_rfio) eq 'off'); # 0|1 + $href->{$ebproc}->{'RFIO_PATH'} = $rfio_path; + $href->{$ebproc}->{'RFIO_pcOptions'} = $rfio_pcOptions; + $href->{$ebproc}->{'RFIO_iCopyMode'} = $rfio_iCopyMode; + $href->{$ebproc}->{'RFIO_pcCopyPath'} = $rfio_pcCopyPath; + $href->{$ebproc}->{'RFIO_iCopyFrac'} = $rfio_iCopyFrac; + $href->{$ebproc}->{'RFIO_iMaxFile'} = $rfio_iMaxFile; + $href->{$ebproc}->{'RFIO_iPathConv'} = $rfio_iPathConv; + + $href->{$ebproc}->{'EPICS_CTRL'} = $epics_list[$ebproc]; # 0|1 + + $href->{$ebproc}->{'EB_LOG'} = $eblog_list[$ebproc]; # 0|1 + $href->{$ebproc}->{'NM_LOG'} = $nmlog_list[$ebproc]; # 0|1 + + if( $write2disk_list[$ebproc] && lc($opt_disk) eq 'undef' ){ + if(&isVarDefined($temp_args_href->{$procname}->{'OUTDIR'}, "OUTDIR for $procname")){ + $href->{$ebproc}->{'OUTDIR'} = $temp_args_href->{$procname}->{'OUTDIR'}; + } + } + elsif( lc($opt_disk) eq 'on' ){ + if(&isVarDefined($temp_args_href->{$procname}->{'OUTDIR'}, "OUTDIR for $procname")){ + $href->{$ebproc}->{'OUTDIR'} = $temp_args_href->{$procname}->{'OUTDIR'}; + } + } + elsif( lc($opt_disk) eq 'off' ){ + #- do not do anything. If $href->{$ebproc}->{'OUTDIR'} is undefined, + # the data will go to /dev/null + } + } + + $numOfEBProcs = $ebproc; +} + +sub isVarDefined() +{ + my ($var, $msg) = @_; + + my $retval = 1; + + unless( defined $var ){ + print "Undefined variable found: $msg\n"; + $retval = 0; + } + + return $retval; +} + +sub getVarSizeArg() +{ + my ($ebproc) = @_; + + my $i = 0; + my $arg = " "; + + foreach my $size (@{$EB_Args_href->{$ebproc}->{'BUFSIZE_LIST'}}){ + + if($EB_Args_href->{$ebproc}->{'BUFSIZE_LIST'}->[$i] == + $EB_Args_href->{$ebproc}->{'QUEUESIZE'}){ + $i++; + next; + } + + $arg = $arg . " -Q " . $i . ":" . $EB_Args_href->{$ebproc}->{'BUFSIZE_LIST'}->[$i]; + $i++; + } + + return $arg; +} + +sub startEvtBuilders() +{ + + my $username = "hadaq"; + + my (@process_list); + + foreach my $ebproc (sort {$a <=> $b} keys %$EB_Args_href){ + + my $ebnum2print = $ebproc+1; + print "EB process: $ebnum2print\n"; + + #--- Prepare execution of daq_evtbuild + my $cmd_eb = "/home/hadaq/bin/daq_evtbuild" . + " -m " . $EB_Args_href->{$ebproc}->{'SOURCENUM'} . + " -q " . $EB_Args_href->{$ebproc}->{'QUEUESIZE'} . + " -S " . $EB_Args_href->{$ebproc}->{'EBNUM'} . + " --ebnum " . $EB_Args_href->{$ebproc}->{'EBNUM'} . + " -x " . $EB_Args_href->{$ebproc}->{'PREFIX'}; + + #- add queue variable size args + my $varsize_arg = &getVarSizeArg($ebproc); + $cmd_eb = $cmd_eb . $varsize_arg; + + #- add output type + if( defined $EB_Args_href->{$ebproc}->{'OUTDIR'} ){ + if($EB_Args_href->{$ebproc}->{'MULTIDISK'}){ + $cmd_eb = $cmd_eb . " -d file -o " . "/data01/data"; + } + else{ + $cmd_eb = $cmd_eb . " -d file -o " . $EB_Args_href->{$ebproc}->{'OUTDIR'}; + } + } + else{ + $cmd_eb = $cmd_eb . " -d null"; + } + + #- add file size + $cmd_eb = $cmd_eb . " --filesize " . $EB_Args_href->{$ebproc}->{'FILESIZE'}; + + #- add second output with small hdl files + if( defined $EB_Args_href->{$ebproc}->{'RESDOWNSCALE'} ){ + $cmd_eb = $cmd_eb . " --resdownscale " . $EB_Args_href->{$ebproc}->{'RESDOWNSCALE'} . + " --resnumevents " . $EB_Args_href->{$ebproc}->{'RESNUMEVENTS'} . + " --respath " . $EB_Args_href->{$ebproc}->{'RESPATH'} . + " --ressizelimit " . $EB_Args_href->{$ebproc}->{'RESSIZELIMIT'}; + } + + my $cpu = $EB_Args_href->{$ebproc}->{'IP'}; + + #- add rfio args + my $rfio; + if( $EB_Args_href->{$ebproc}->{'RFIO'} ){ + $rfio = " --rfio " . $EB_Args_href->{$ebproc}->{'RFIO_PATH'} . + " --rfiolustre " . $EB_Args_href->{$ebproc}->{'RFIO_pcCopyPath'} . + " --rfio_pcoption " . $EB_Args_href->{$ebproc}->{'RFIO_pcOptions'} . + " --rfio_icopymode " . $EB_Args_href->{$ebproc}->{'RFIO_iCopyMode'} . + " --rfio_icopyfrac " . $EB_Args_href->{$ebproc}->{'RFIO_iCopyFrac'} . + " --rfio_imaxfile " . $EB_Args_href->{$ebproc}->{'RFIO_iMaxFile'} . + " --rfio_ipathconv " . $EB_Args_href->{$ebproc}->{'RFIO_iPathConv'}; + } + + $cmd_eb = $cmd_eb . $rfio if( defined $rfio ); + + #- add multiple disk arg (ctrl via daq_disks) + if($EB_Args_href->{$ebproc}->{'MULTIDISK'} && + defined $EB_Args_href->{$ebproc}->{'OUTDIR'}){ + $cmd_eb = $cmd_eb . " --multidisk " . $EB_Args_href->{$ebproc}->{'MULTIDISK'}; + } + + #- add online RPC server + if( $EB_Args_href->{$ebproc}->{'ONLINESERVER'} eq "on" ){ + $cmd_eb = $cmd_eb . " --online"; + } + + #- add epics controlled + $cmd_eb = $cmd_eb . " --epicsctrl " if( $EB_Args_href->{$ebproc}->{'EPICS_CTRL'} ); + + #- logging the output + my $eblog_file = "/tmp/log_eb_" . $EB_Args_href->{$ebproc}->{'EBNUM'} . ".txt"; + my $eb_log = "1>$eblog_file 2>$eblog_file"; + $eb_log = "1>/dev/null 2>/dev/null" unless( $EB_Args_href->{$ebproc}->{'EB_LOG'} ); + + my $time = 1. * $ebproc; + my $sleep_cmd = "sleep " . $time; + + my $core_nr = &getCoreNr($cpu); + + my $exe_eb = "ssh -n $cpu -l $username \"cd /home/hadaq/oper; export DAQ_SETUP=/home/hadaq/oper/eb; taskset -c $core_nr $cmd_eb $eb_log &\""; + + #print "exec: $exe_eb\n"; + + #--- Prepare execution of daq_netmem + my $cmd_nm = "/home/hadaq/bin/daq_netmem" . + " -m " . $EB_Args_href->{$ebproc}->{'SOURCENUM'} . + " -q " . $EB_Args_href->{$ebproc}->{'QUEUESIZE'} . + " -S " . $EB_Args_href->{$ebproc}->{'EBNUM'}; + + #- add queue variable size args + $cmd_nm = $cmd_nm . $varsize_arg; + + my @port_list = (); + + #- add ports + foreach my $port (@{$EB_Args_href->{$ebproc}->{'PORT_LIST'}}){ + #$cmd_nm = $cmd_nm . " -i UDP:0.0.0.0:" . $port; + $cmd_nm = $cmd_nm . " -i " . $port; + + push(@port_list, $port); + } + + &cpPortList2EB(\@port_list, $EB_Args_href->{$ebproc}->{'EBNUM'}, $cpu); + + #- logging the output + my $nmlog_file = "/tmp/log_nm_" . $EB_Args_href->{$ebproc}->{'EBNUM'} . ".txt"; + my $nm_log = "1>$nmlog_file 2>$nmlog_file"; + $nm_log = "1>/dev/null 2>/dev/null" unless( $EB_Args_href->{$ebproc}->{'NM_LOG'} ); + + $core_nr = &getCoreNr($cpu); + + my $exe_nm = "ssh -n $cpu -l $username \"cd /home/hadaq/oper; export DAQ_SETUP=/home/hadaq/oper/eb; taskset -c $core_nr $cmd_nm $nm_log &\""; + + #print "exec: $exe_nm\n"; + + #--- Open permissions for shared memory + my $eb_shmem = "daq_evtbuild" . $EB_Args_href->{$ebproc}->{'EBNUM'} . ".shm"; + my $nm_shmem = "daq_netmem" . $EB_Args_href->{$ebproc}->{'EBNUM'} . ".shm"; + my $exe_open_eb = "ssh -n $cpu -l $username \"chmod 775 /dev/shm/$eb_shmem\""; + my $exe_open_nm = "ssh -n $cpu -l $username \"chmod 775 /dev/shm/$nm_shmem\""; + + &forkEB($exe_eb, $exe_nm, $exe_open_eb, $exe_open_nm, \@process_list); + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid($cur_child_pid,0); + } +} + +sub stopEvtBuilders() +{ + my $username = "hadaq"; + + my @process_list = (); + + #--- Loop over server IPs + foreach my $ip (@EB_IP_list){ + + my $exe = "ssh -n $ip -l $username \"/home/hadaq/bin/cleanup_evtbuild.pl; /home/hadaq/bin/ipcrm.pl\""; + + if($opt_verb){ + print "Killing running EBs...\n"; + print "Exec: $exe\n"; + } + + my $log = $log_path . "/log_" . $ip . "_" . "stopEB.txt"; + + forkMe($exe, $log, \@process_list) unless($opt_test); + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + print "wait for $cur_child_pid\n"; + waitpid($cur_child_pid,0); + } +} + +sub cpPortList2EB() +{ + my ($port_list_aref, $ebnr, $cpu) = @_; + + my $tmpfile = "/tmp/eb" . $ebnr . "_" . $cpu . ".txt"; + + #- First write ports to tmp file + my $fh = new FileHandle(">$tmpfile"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$tmpfile\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + foreach my $port (@$port_list_aref){ + print $fh "$port\n"; + } + + $fh->close(); + + #- Copy this tmp file to EB + my $exe_cp = "scp $tmpfile hadaq\@$cpu:/tmp/ 1>/dev/null 2>/dev/null"; + system($exe_cp); +} + +sub startIOC() +{ + my $ioc_dir = "/home/scs/ebctrl/ioc/iocBoot/iocebctrl"; + + &writeIOC_stcmd( $ioc_dir ); + + print "Starting IOCs...\n" if($opt_verb); + + foreach my $ebproc (keys %$EB_Args_href){ + + my $stcmd = sprintf("st_eb%02d.cmd", 1 + $ebproc); + my $screen_name = sprintf("ioc_eb%02d", 1 + $ebproc); + + my $cmd = "bash; . /home/scs/.bashrc; cd $ioc_dir; screen -dmS $screen_name ../../bin/linux-x86_64/ebctrl $stcmd"; + my $cpu = $EB_Args_href->{$ebproc}->{'IP'}; + + my $exe = "ssh -n $cpu -l scs \"$cmd\""; + + print "Exec: $exe\n" if($opt_verb); + system($exe) unless($opt_test); + } +} + +sub smallestEBProcNum() +{ + my $smallest = 1000; + + foreach my $ebproc (keys %$EB_Args_href){ + $smallest = $ebproc if($smallest > $ebproc); + } + + return $smallest; +} + +sub writeIOC_stcmd() +{ + my ($ioc_dir) = @_; + + print "Copying st.cmd files to servers...\n" if($opt_verb); + + my $smallest_ebproc = &smallestEBProcNum(); + + foreach my $ebproc (keys %$EB_Args_href){ + + my $ebNr = 1 + $ebproc; + my $ebnum = sprintf("eb%02d", $ebNr); + + #- in MBytes + my $maxFileSize = $EB_Args_href->{$ebproc}->{'FILESIZE'}; + + my $ebtype = "slave"; + my $comment_genrunid = "#"; + my $comment_totalevt = "#"; + + if($ebproc == $smallest_ebproc){ + $ebtype = "master"; + $comment_genrunid = ""; + $comment_totalevt = ""; + } + +# if($ebNr == 1){ +# $comment_totalevt = ""; +# } + + my $ioc_stcmd = < \${TOP}/iocBoot/\${IOC}/$ebnum.dbl + +EOF + + my $outfile = "/tmp/st_" . $ebnum . ".cmd"; + my $fh = new FileHandle(">$outfile"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$outfile\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $ioc_stcmd; + $fh->close(); + + my $ip = $EB_Args_href->{$ebproc}->{'IP'}; + my $cmd = "scp $outfile scs\@$ip:$ioc_dir/."; + + print "Exec: $cmd\n" if($opt_verb); + system($cmd) unless($opt_test); + } +} + +sub killIOC() +{ + my %ioc; + my $ioc_href = \%ioc; + + print "Looking for running IOCs...\n" if($opt_verb); + + #--- Loop over server IPs + foreach my $ip (@EB_IP_list){ + + &findRunningIOC($ip, $ioc_href); + } + + #print Dumper \%$ioc_href; + + &writeExpectIOC() if( defined %$ioc_href ); + + if($opt_verb){ + print "Killing running IOCs...\n"; + print "No IOCs found - nothing to kill, continue...\n" unless( defined %$ioc_href ); + } + + my (@process_list); + + foreach my $ip ( %$ioc_href ){ + foreach my $ioc ( @{$ioc_href->{$ip}} ){ + + my $cmd = $expect_ioc_script . " " . $ip . " " . $ioc; + my $log = $log_path . "/log_" . $ip . "_" . $ioc . ".txt"; + print "cmd: $cmd\n" if($opt_verb); + &forkMe($cmd, $log, \@process_list); + } + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid($cur_child_pid,0); + } +} + +sub forkMe() +{ + my ($cmd, $log, $proc_list) = @_; + + my $child = fork(); + + if( $child ){ # parent + push( @$proc_list, $child ); + } + elsif( $child == 0 ) { # child + system("$cmd > $log"); + exit(0); + } + else{ + print "Could not fork: $!\n"; + exit(1); + } +} + +sub forkEB() +{ + my ($exe_eb, $exe_nm, $exe_open_eb, $exe_open_nm, $proc_list) = @_; + + my $child = fork(); + + if( $child ){ # parent + push( @$proc_list, $child ); + } + elsif( $child == 0 ) { # child + #--- Execute Event Builder + print "Exec: $exe_eb\n" if($opt_verb); + system($exe_eb) unless($opt_test); + + sleep(1); + + #--- Open permissions for EB shared memory + # ! Permissions should be opened by EB process + #print "Exec: $exe_open_eb\n" if($opt_verb); + #system($exe_open_eb) unless($opt_test); + + sleep(2); + + #--- Execute Net-2-Memory + print "Exec: $exe_nm\n" if($opt_verb); + system($exe_nm) unless($opt_test); + + sleep(1); + + #--- Open permissions for NM shared memory + # ! Permissions should be opened by EB process + #print "Exec: $exe_open_nm\n" if($opt_verb); + #system($exe_open_nm) unless($opt_test); + + exit(0); + } + else{ + print "Could not fork: $!\n"; + exit(1); + } +} + +sub findRunningIOC() +{ + my ($cpu, $ioc_href) = @_; + + `ssh -n $cpu -l scs \"screen -wipe\"`; + my $exe = "ssh -n $cpu -l scs \"screen -ls\""; + + my @output = `$exe`; + + foreach my $line (@output){ + if($line =~ /\d+\.(ioc_eb\d{2})\s+/){ + my $name = $1; + push( @{$ioc_href->{$cpu}}, $name ); + print "Found IOC: $name on $cpu\n" if($opt_verb); + } + } +} + +sub writeExpectIOC() +{ + # This expect script can be executed to exit IOC. + + #! Look if /tmp dir exists + my $tmp_dir = dirname("/tmp"); + if ( !(-d $tmp_dir) ){ + print "\nCannot access /tmp directory!\nExit.\n"; + exit(1); + } + + my $expect_script_my = <0} { + set ip [lindex \$argv 0] + set iocname [lindex \$argv 1] +} else { + send_user "Usage: \$argv0 ip iocname\\n" +} + +spawn ssh scs@\$ip + +#expect { +# "error" { exit; } +# "login:" { exit; } +# "Password:" { exit; } +#} + +set timeout 20 +#240 + +expect "~\$ " +send "screen -r \$iocname\\r" +expect "epics> " +send "exit\\r" +expect "~\$ " + +EOF + + my $fh = new FileHandle(">$expect_ioc_script"); + + if(!$fh) { + my $txt = "\nError! Could not open file \"$expect_ioc_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + print $fh $expect_script_my; + $fh->close(); + + #- open permissions + system("chmod 755 $expect_ioc_script"); +} + +sub getGbEconfig() +{ + # + # Read DB configurations of GbE and CTS, + # look for active data sources as well as + # for EB IPs and ports. + # + + my ($eb_ids_href) = @_; + + my $data_sources = $temp_args_href->{'Parallel'}->{'DATA_SOURCES'}; + my $gbe_conf = $temp_args_href->{'Parallel'}->{'GBE_CONF'}; + my $cts_conf = $temp_args_href->{'Parallel'}->{'CTS_CONF'}; + + my %activeSources_hash; + my $activeSources_href = \%activeSources_hash; + + &readActiveSources($data_sources, $activeSources_href); + + my @id_list; + my $id_list_aref = \@id_list; + + #&readEBids($cts_conf, $id_list_aref); + + #- Overwrite array with EB numbers + @id_list = (0 .. 15); + #print Dumper $id_list_aref; + + &readEBports($gbe_conf, $activeSources_href, $id_list_aref, $eb_ids_href); +} + +sub readEBids() +{ + # + # Read EB Ids + # + + my ($file, $id_list_aref) = @_; + + my $nnn_table = 0; + my $val_table = 0; + + my $SPACE = ""; + + my $fh = new FileHandle("$file", "r"); + + while(<$fh>){ + + #- Remove all comments + $_ =~ s{ # Substitue... + \# # ...a literal octothorpe + [^\n]* # ...followed by any number of non-newlines + } + {$SPACE}gxms; # Raplace it with a single space + + #- Skip line if it contains only whitespaces + next unless(/\S/); + + if(/^(\s+)?!Value\stable/){ + $val_table = 1; + $nnn_table = 0; + next; + } + elsif(/^(\s+)?!\w+/){ + $val_table = 0; + $nnn_table = 1; + } + + if($val_table){ + my (@vals) = split(" ", $_); + my @id_list1 = split("", $vals[12]); + my @id_list2 = split("", $vals[13]); + foreach my $id (@id_list1){ + push(@$id_list_aref, hex($id)); + } + foreach my $id (@id_list2){ + push(@$id_list_aref, hex($id)); + } + } + elsif($nnn_table){ + } + } + + $fh->close; +} + +sub readEBports() +{ + # + # Read EB IPs and ports accoring to EB Id (type) + # and TRB-Net addresses of active data sources. + # + + my ($file, $activeSources_href, $id_list_aref, $ports_href) = @_; + + my $nnn_table = 0; + my $val_table = 0; + + my $fh = new FileHandle("$file", "r"); + + &isFileDefined($fh, $file); + + my %tmp; + my $tmp_href = \%tmp; + + my $SPACE = ""; + + while(<$fh>){ + + #print $_; + #- Remove all comments + $_ =~ s{ # Substitue... + \# # ...a literal octothorpe + [^\n]* # ...followed by any number of non-newlines + } + {$SPACE}gxms; # Raplace it with a single space + + #- Skip line if it contains only whitespaces + next unless(/\S/); + + #print $_; + if(/^(\s+)?!Value\stable/){ + $val_table = 1; + $nnn_table = 0; + next; + } + elsif(/^(\s+)?!\w+/){ + $nnn_table = 1; + $val_table = 0; + } + + if($val_table){ + my (@vals) = split(" ", $_); + my $id = $vals[1]; + + #if($id <0 or $id >15) { + # print "error: in $file there is a line with an eventbuilder number different than 0..15, the number given in the file is $id. please correct the config file.\n"; + # exit(128); + #} + + + #- Accept only EB Ids from CTS config file + #print "value: $_"; + next unless( any {$_ eq $id} @$id_list_aref ); + + #print Dumper \@vals; + #print "active sources: "; print Dumper $activeSources_href->{'addr_list'}; + #exit; + + my $ip = &getIP_hex2dec($vals[6]); + my $port = &getPort_hex2dec($vals[2]); + my $addr = $vals[0]; + + #print "got: ip: $ip, port: $port, addr: $addr\n"; + #- Accept only sources from active source list + if( any {hex($_) == hex($addr)} @{$activeSources_href->{'addr_list'}} ){ + $tmp_href->{$id}->{'IP'} = $ip; + push( @{$tmp_href->{$id}->{'port_list'}}, $port ); + push( @{$tmp_href->{$id}->{'addr_list'}}, $addr ); + } + } + } + + $fh->close; + + #print Dumper $tmp_href; + + #- Sort hash according to active data source list + foreach my $id (keys %tmp){ + $ports_href->{$id}->{'IP'} = $tmp_href->{$id}->{'IP'}; + + foreach my $addr (@{$activeSources_href->{'addr_list'}}){ + + my $ind1 = first_index {$_ eq $addr} @{$tmp_href->{$id}->{'addr_list'}}; + my $ind2 = first_index {$_ eq $addr} @{$activeSources_href->{'addr_list'}}; + + next if($ind1 == -1); + + push( @{$ports_href->{$id}->{'port_list'}}, $tmp_href->{$id}->{'port_list'}->[$ind1]); + push( @{$ports_href->{$id}->{'addr_list'}}, $addr); + push( @{$ports_href->{$id}->{'bufsize_list'}}, $activeSources_href->{'bufsize_list'}->[$ind2]); + } + } + + #print Dumper $ports_href; +} + +sub readActiveSources() +{ + # + # Read TRB-Net addresses of active data sources + # + + my ($file, $activeSources_href) = @_; + + my $fh = new FileHandle("$file", "r"); + + &isFileDefined($fh, $file); + + my $SPACE = ""; + + while(<$fh>){ + + #- Remove all comments + $_ =~ s{ # Substitue... + \# # ...a literal octothorpe + [^\n]* # ...followed by any number of non-newlines + } + {$SPACE}gxms; # Raplace it with a single space + + #- Skip line if it contains only whitespaces + next unless(/\S/); + + my ($addr, $astat, $sys, $size) = split(" ", $_); + + next if($astat == 0); + + push( @{$activeSources_href->{'addr_list'}}, $addr); + push( @{$activeSources_href->{'bufsize_list'}}, &getBufSize($size)); + } + + $fh->close; +} + +sub getBufSize() +{ + my ($bufSize) = @_; + + if(lc($bufSize) eq "low"){ + return $temp_args_href->{'Main'}->{'BUF_SIZE_LOW'}; + } + elsif(lc($bufSize) eq "mid"){ + return $temp_args_href->{'Main'}->{'BUF_SIZE_MID'}; + } + elsif(lc($bufSize) eq "high"){ + return $temp_args_href->{'Main'}->{'BUF_SIZE_HIGH'}; + } + else{ + print "Cannot understand $bufSize from data_sources.db.\n"; + exit(0); + } +} + +sub getIP_hex2dec() +{ + my ($ip_hex) = @_; + + my $ip_dec; + + if( $ip_hex =~ /0x(\w{2})(\w{2})(\w{2})(\w{2})/ ){ + $ip_dec = hex($1) . "." . hex($2) . "." . hex($3) . "." . hex($4); + } + else{ + print "getIP_hex2dec(): cannot extract ip address because of diferent format! Exit."; + exit(0); + } + + return $ip_dec; +} + +sub getPort_hex2dec() +{ + my ($port_hex) = @_; + + my $port_dec; + + if( $port_hex =~ /0x(\w+)/ ){ + $port_dec = hex($1); + } + else{ + print "getPort_hex2dec(): cannot extract port number because of diferent format! Exit."; + exit(0); + } + + return $port_dec; +} + +sub isFileDefined() +{ + my ($fh, $name) = @_; + + if(!$fh) { + my $txt = "\nError! Could not open file \'$name\'. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + return 0; +} + +sub writeArgs2file() +{ + my $fileName = $0; + + #- Replace .pl with .sh + $fileName =~ s/\.pl/\.sh/; + + my $fh = new FileHandle(">./$fileName"); + if(!$fh) { + my $txt = "\nError! Could not open file \"$fileName\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + exit(128); + } + + my $current_dir = cwd(); + my $ptogName = $0; + + + #- Write to the file the script name itself + print $fh $0; + + #- Write to the file the arguments + foreach my $arg (@arg_list){ + print $fh " $arg"; + } + print $fh "\n"; + + $fh->close(); + + system("chmod 755 ./$fileName"); +} + diff --git a/evtbuild/start_eb_gbe.sh b/evtbuild/start_eb_gbe.sh new file mode 100755 index 0000000..02a0ba8 --- /dev/null +++ b/evtbuild/start_eb_gbe.sh @@ -0,0 +1 @@ +./start_eb_gbe.pl -v -e restart -n 1-16 -d on -p ri -r off diff --git a/evtbuild/start_eb_iocs.sh b/evtbuild/start_eb_iocs.sh new file mode 100755 index 0000000..716e321 --- /dev/null +++ b/evtbuild/start_eb_iocs.sh @@ -0,0 +1,7 @@ +#!/bin/bash +# JAM 2-2012 +# restart epics iocs for all eventbuilders +# will kill all previous iocs +# need to set environment with this script due to relative paths in config files +cd /home/hadaq/trbsoft/daq/evtbuild +./start_eb_gbe.pl -i start -n 1-16 diff --git a/evtbuild/start_rdosoft.pl b/evtbuild/start_rdosoft.pl new file mode 100755 index 0000000..3df3916 --- /dev/null +++ b/evtbuild/start_rdosoft.pl @@ -0,0 +1,235 @@ +#!/usr/bin/perl -w + +use English; +use strict; +use Getopt::Long; +use Data::Dumper; +use Config::Std; +use FileHandle; +use List::MoreUtils qw(any apply); +use File::Basename; + +#- the command line option flags +my $opt_help = 0; +my $opt_ebconf = "../evtbuild/eb.conf"; +my $opt_test = 0; +my $opt_verb = 0; + +GetOptions ('h|help' => \$opt_help, + 'c|conf=s' => \$opt_ebconf, + 't|test' => \$opt_test, + 'v|verb' => \$opt_verb); + +if( $opt_help ) { + &help(); + exit(0); +} + +my $numOfEBProcs = 0; +my @EB_Args; +my $EB_Args_aref = \@EB_Args; + +&getEBArgs( $EB_Args_aref ); + +my $exedir = "/home/hadaq/test_eb"; + +my @iplist = ("192.168.100.52"); #hades27 + + +&prepareRemotePC(); +&startRdosoft(); +&startUDPMaster(); + +exit(0); + +################### END OF MAIN #################### + +sub help() +{ + print "\n"; + print << 'EOF'; +start_eb.pl + + This script starts soft-readout processes. + +Usage: + + Command line: startup.pl + [-h|--help] : Show this help. + [-c|--conf ] : Path to the config file (default: $opt_ebconf). + [-t|--test] : Test without execution. + [-v|--verb] : More verbouse. + +EOF +} + +sub getEBArgs() +{ + + my ($aref) = @_; + + my %temp_args; + my $temp_args_href = \%temp_args; + + read_config $opt_ebconf => %$temp_args_href; + + my $base_port = $temp_args_href->{'Parallel'}->{'BASE_PORT'}; + my $shift_port = $temp_args_href->{'Parallel'}->{'SHIFT_PORT'}; + my $source_num = $temp_args_href->{'Parallel'}->{'NUM_OF_SOURCES'}; + + #- Number of EB process + my $ebproc = 0; + + #--- Loop over servers + foreach my $num (1..4){ + + my $ip_name = 'EB_IP_' . $num; + next unless( defined $temp_args_href->{'Parallel'}->{$ip_name} ); + + my $num_name = 'EB_NUM_' . $num; + unless( defined $temp_args_href->{'Parallel'}->{$num_name} ){ + print "\nNumber of EBs per server ($num_name) is not defined in $opt_ebconf!\n"; + print "Exit.\n"; + exit(1); + } + + my $eb_ip = $temp_args_href->{'Parallel'}->{$ip_name}; + my $eb_num = $temp_args_href->{'Parallel'}->{$num_name}; + + #--- Loop over EB processes on a given server + foreach my $ebnum (1..$eb_num){ + + #- Increment index of EB process + $ebproc++; + + #- Calculate base port for given EB process + my $baseport = ($ebnum - 1) * $shift_port + $base_port; + + $aref->[$ebproc-1]->{'IP'} = $eb_ip; + $aref->[$ebproc-1]->{'EBNUM'} = $ebproc; + $aref->[$ebproc-1]->{'BASEPORT'} = $baseport; + $aref->[$ebproc-1]->{'SOURCENUM'} = $source_num; + } + } + + $numOfEBProcs = $ebproc; +} + +sub prepareRemotePC() +{ + my $username = "hadaq"; + + foreach my $ip (@iplist){ + my $cmd = "ssh -n $ip -l $username \"mkdir $exedir 1>/dev/null 2>/dev/null\""; + + print "Exec: $cmd\n" if($opt_verb); + system($cmd) unless($opt_test); + + #my $cmd_rs = "scp /home/hadaq/yurevich/newtcpsynch/hwreadout/hwsoft/daq_rdosoft $username\@$ip:$exedir/"; + #my $cmd_mn = "scp /home/hadaq/yurevich/roundrobin/bin/daq_memnet $username\@$ip:$exedir/"; + + my $cmd_rs = "scp /home/hadaq/yurevich/udpctrl_roundrobin/bin/daq_rdosoft $username\@$ip:$exedir/"; + my $cmd_mn = "scp /home/hadaq/yurevich/udpctrl_roundrobin/bin/daq_memnet $username\@$ip:$exedir/"; + + print "Exec: $cmd_rs\n" if($opt_verb); + system($cmd_rs) unless($opt_test); + + print "Exec: $cmd_mn\n" if($opt_verb); + system($cmd_mn) unless($opt_test); + } +} + +sub startRdosoft() +{ + my @process_list = (); + + my $portshift = 0; + + foreach my $ip (@iplist){ + my $child = fork(); + + if( $child ) { + #print "Parent: push child to process_list\n"; + push( @process_list, $child ); + } + elsif ( $child == 0 ) { + #print "Child: execute SoftReadout\n"; + &execSoftReadoutMult( $ip, $portshift ); + exit(0); + } + else { + die "startSoftReadout: Could not fork!\n"; + } + + $portshift++; + } + + foreach my $child_pid (@process_list) { + waitpid( $child_pid, 0); + } +} + +sub execSoftReadoutMult() +{ + my ($rdo_ip, $portshift) = @_; + + my $udpsynch = "UDP:0.0.0.0:19999"; + my $username = "hadaq"; + + #-------- DAQ MEMORY 2 NETWORK + my $daq_mn = "cd /home/hadaq/test_eb/; ./daq_memnet -q 16000000 --shmnum $portshift -E $numOfEBProcs"; + + foreach my $ebproc (1..$numOfEBProcs){ + my $ip = $EB_Args_aref->[$ebproc-1]->{'IP'}; + my $port = $EB_Args_aref->[$ebproc-1]->{'BASEPORT'}; # base port + + $port = $port + $portshift; + + $daq_mn = $daq_mn . " -o UDP:$ip:$port"; + } + + $daq_mn = $daq_mn . " < /dev/null > /dev/null 2>&1 \&"; + + #-------- DAQ READOUT SOFT + my $daq_rs = "cd /home/hadaq/test_eb/; ./daq_rdosoft -w 1000 --synch $udpsynch --spilltime 20 --evtrate 15000 --evtsize 1000 -q 16000000 --shmnum $portshift -E $numOfEBProcs"; + $daq_rs = $daq_rs . " < /dev/null > /dev/null 2>&1 \&"; + + #my $eb_sh_script = </dev/null 2>/dev/null & + + + my $exe_mn = "ssh -n $rdo_ip -l $username \"$daq_mn\""; + my $exe_rs = "ssh -n $rdo_ip -l $username \"$daq_rs\""; + + print "Exec: $exe_mn\n" if($opt_verb); + system($exe_mn) unless($opt_test); + + print "Exec: $exe_rs\n" if($opt_verb); + system($exe_rs) unless($opt_test); + +} + +sub startUDPMaster() +{ + my $udp = ""; + + foreach my $ip (@iplist){ + $udp = "$udp -o $ip -p 19999 -m 1"; + } + + #- separate window + my $term_name = "-T \"UDP Master\""; + my $term_geom = "-geometry 80x13+20+810"; + my $term_opt = "-fn 10x20 -fg DarkOliveGreen3 -bg black -cr red -ms green"; + my $exec_command = "/home/hadaq/yurevich/test/oper/bin/client -t 30 $udp"; #time interval of 30 seconds + + system("xterm $term_name $term_geom $term_opt -e '$exec_command' &") unless($opt_test); + + print "exec command: $exec_command\n"; +}