--- /dev/null
+#!/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 <trbcmd|cmdsrv>] : 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 <I> 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);
+ }
+}
--- /dev/null
+#!/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/name>] : Path to the config file (default: ../evtbuild/eb.conf).
+ [-e|--eb <start|stop|restart>] : Start or stop Event Builders (default: start).
+ [-i|--ioc <start|stop>] : Start or stop IOCs (default: start).
+ [-n|--nr <rangeOfEBs>] : Range of numbers of Event Bulders to be started.
+ [-d|--disk <on|off>] : Switch writing to disk on|off.
+ [-r|--rfio <on|off>] : Switch writing to tape on|off.
+ [-p|--prefix <prefix>] : Prefix of hld file.
+ [-o|--online <on|off>] : 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 = <<EOF;
+#!../../bin/linux-x86_64/ebctrl
+
+## You may have to change ebctrl to something else
+## everywhere it appears in this file
+## Set EPICS environment
+
+< envPaths
+
+epicsEnvSet(FILESIZE,"$maxFileSize")
+epicsEnvSet(EBTYPE,"$ebtype")
+epicsEnvSet(EBNUM,"$ebNr")
+epicsEnvSet(ERRBITLOG, "1")
+epicsEnvSet(ERRBITWAIT, "30")
+epicsEnvSet(EPICS_CA_ADDR_LIST,"192.168.103.255")
+epicsEnvSet(EPICS_CA_AUTO_ADDR_LIST,"NO")
+epicsEnvSet(PATH,"/home/scs/base-3-14-11/bin/linux-x86_64:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:.")
+
+cd \${TOP}
+
+## Register all support components
+dbLoadDatabase("dbd/ebctrl.dbd")
+ebctrl_registerRecordDeviceDriver(pdbbase)
+
+## Load record instances
+dbLoadTemplate "db/userHost.substitutions"
+dbLoadRecords("db/evtbuild.db","eb=$ebnum")
+dbLoadRecords("db/netmem.db","eb=$ebnum")
+dbLoadRecords("db/errbit1.db","eb=$ebnum")
+dbLoadRecords("db/errbit2.db","eb=$ebnum")
+dbLoadRecords("db/trignr1.db","eb=$ebnum")
+dbLoadRecords("db/trignr2.db","eb=$ebnum")
+dbLoadRecords("db/portnr1.db","eb=$ebnum")
+dbLoadRecords("db/portnr2.db","eb=$ebnum")
+dbLoadRecords("db/trigtype.db","eb=$ebnum")
+dbLoadRecords("db/cpu.db","eb=$ebnum")
+dbLoadRecords("db/errbitstat.db","eb=$ebnum")
+$comment_totalevt dbLoadRecords("db/totalevtstat.db")
+$comment_genrunid dbLoadRecords("db/genrunid.db","eb=$ebnum")
+
+## Set this to see messages from mySub
+var evtbuildDebug 0
+var netmemDebug 0
+var genrunidDebug 0
+var writerunidDebug 0
+var errbit1Debug 0
+var errbit2Debug 0
+var trigtypeDebug 0
+var cpuDebug 0
+var errbitstatDebug 0
+$comment_totalevt var totalevtscompDebug 0
+cd \${TOP}/iocBoot/\${IOC}
+iocInit()
+
+## Start any sequence programs
+#seq sncExample,"user=scsHost"
+
+dbl > \${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 = <<EOF;
+#!/usr/bin/expect -f
+
+# This script is automatically generated by startup.pl
+# Do not edit, the changes will be lost.
+
+# Print args
+send_user "\$argv0 [lrange \$argv 0 \$argc]\\n"
+
+# Get args
+#
+# ip : IP address of the server
+# iocname : name of IOC screen process (screen -ls)
+#
+if {\$argc>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");
+}
+
jspc29 / hadesdaq.git / commitdiff