From c515471f590ac69d2bd3ee398652120229c54db7 Mon Sep 17 00:00:00 2001 From: Hades DAQ Date: Wed, 25 Apr 2018 03:20:26 +0200 Subject: [PATCH] fixed missing board message, mt --- main/startup.pl | 3324 +++++++++++++++++++++++------------------------ 1 file changed, 1661 insertions(+), 1663 deletions(-) diff --git a/main/startup.pl b/main/startup.pl index 57e65b1..83d1772 100755 --- a/main/startup.pl +++ b/main/startup.pl @@ -31,72 +31,74 @@ use threads::shared; #use Clone qw(clone); #- the command line option flags -my $opt_help = 0; -my $opt_eb = "on"; -my $opt_check = 1; -my $opt_rdo = 0; -my $opt_test = 0; -my $opt_file = "../main/startup.script"; -my $opt_etrax = "etraxp058"; -my $opt_verb = 0; -my $opt_ora = "file"; +my $opt_help = 0; +my $opt_eb = "on"; +my $opt_check = 1; +my $opt_rdo = 0; +my $opt_test = 0; +my $opt_file = "../main/startup.script"; +my $opt_etrax = "etraxp058"; +my $opt_verb = 0; +my $opt_ora = "file"; my @opt_macro; my @dead_cservers; -GetOptions ('h|help' => \$opt_help, - 'b|eb=s' => \$opt_eb, - 'c|check=i' => \$opt_check, - 'r|rdo' => \$opt_rdo, - 'f|file=s' => \$opt_file, - 'e|etrax=s' => \$opt_etrax, - 'm|macro=s' => \@opt_macro, - 'v|verb' => \$opt_verb, - 'o|oracle=s' => \$opt_ora, - 't|test' => \$opt_test); - -if( $opt_help ) { - &help(); - exit(0); +GetOptions( + 'h|help' => \$opt_help, + 'b|eb=s' => \$opt_eb, + 'c|check=i' => \$opt_check, + 'r|rdo' => \$opt_rdo, + 'f|file=s' => \$opt_file, + 'e|etrax=s' => \$opt_etrax, + 'm|macro=s' => \@opt_macro, + 'v|verb' => \$opt_verb, + 'o|oracle=s' => \$opt_ora, + 't|test' => \$opt_test +); + +if ($opt_help) { + &help(); + exit(0); } my $parent_pid = $$; -my @subsys_array = ('mdc','rich','rpc','start','tof','wall','hub'); +my @subsys_array = ( 'mdc', 'rich', 'rpc', 'start', 'tof', 'wall', 'hub' ); -my $expect_script = "/tmp/remote_exec.exp"; -my $var_dir = "/var/diskless/etrax_fs"; -my $log_dir = "/tmp/log"; +my $expect_script = "/tmp/remote_exec.exp"; +my $var_dir = "/var/diskless/etrax_fs"; +my $log_dir = "/tmp/log"; -my $cmd_server = "./bin/command_server"; +my $cmd_server = "./bin/command_server"; my $cmd_server_port = 4712; my $cmd_server_prtcl = 'tcp'; my $cmd_server_answer = ""; -my %addr_db_conf; # Hash with all addresses, serials, uids from DBs +my %addr_db_conf; # Hash with all addresses, serials, uids from DBs my $addr_db_conf_href = \%addr_db_conf; -my @startup; # Array with all startup configuration +my @startup; # Array with all startup configuration my $startup_aref = \@startup; -my %trb_hash; # Hash with TRBs for different subsystems +my %trb_hash; # Hash with TRBs for different subsystems my $trb_href = \%trb_hash; -my %EB_Args; # Hash with EB args +my %EB_Args; # Hash with EB args my $EB_Args_href = \%EB_Args; -my @rdo; # Array with etrax names which run readout +my @rdo; # Array with etrax names which run readout my $rdo_aref = \@rdo; -my @usedMacros = (); # Array of used macro names to identify names with typos +my @usedMacros = (); # Array of used macro names to identify names with typos -my %data2ora_hash; # Hash with data to be stored in Oracle +my %data2ora_hash; # Hash with data to be stored in Oracle my $data2ora_href = \%data2ora_hash; -my @subEvtIds; # Array with subevent Ids -my $subEvtIds_aref = \@subEvtIds; +my @subEvtIds; # Array with subevent Ids +my $subEvtIds_aref = \@subEvtIds; -my %addressRange; # Hash with ranges of TRBNet addresses for each type of board +my %addressRange; # Hash with ranges of TRBNet addresses for each type of board my $addressRange_href = \%addressRange; -if( 0 != &checkArgs() ){ - print "Exit.\n"; - exit(1); +if ( 0 != &checkArgs() ) { + print "Exit.\n"; + exit(1); } #- Get local time in seconds since Epoch @@ -104,28 +106,27 @@ my $seconds1 = time; my $child_pid = &forkStatusServer(); -&prepareForStartup(); #0.05s -&cleanup(); #0.02s -&readScript($opt_file, 'local'); #1.3s -&checkUnusedMacros(); #0s +&prepareForStartup(); #0.05s +&cleanup(); #0.02s +&readScript( $opt_file, 'local' ); #1.3s +&checkUnusedMacros(); #0s #print Dumper $startup_aref; #print Dumper $trb_href; #print Dumper $addr_db_conf_href->{'0x3230_3'}; -&checkConnection() if($opt_check); #2.6s +&checkConnection() if ($opt_check); #2.6s -&closeEBs() if($opt_eb eq "on"); +&closeEBs() if ( $opt_eb eq "on" ); &execViaCmdServer(); -&startEBs() if($opt_eb eq "on"); +&startEBs() if ( $opt_eb eq "on" ); exit(0); ################### END OF MAIN #################### -sub help() -{ - print "\n"; - print << 'EOF'; +sub help() { + print "\n"; + print << 'EOF'; startup.pl This script starts readout via Command_Server running @@ -133,7 +134,7 @@ startup.pl to collect the data. Usage: - + Command line: startup.pl [-h|--help] : Show this help. [-f|--file ] : Path to main config file. @@ -157,71 +158,66 @@ Examples: EOF } -sub checkArgs() -{ - my $retval = 0; - - if($opt_rdo){ - print "Option -r is not implemented yet.\n"; - $retval = 1; - } - if( ! (-e $opt_file) ){ - print "File $opt_file does not exist.\n"; - $retval = 1; - } - - return $retval; +sub checkArgs() { + my $retval = 0; + + if ($opt_rdo) { + print "Option -r is not implemented yet.\n"; + $retval = 1; + } + if ( !( -e $opt_file ) ) { + print "File $opt_file does not exist.\n"; + $retval = 1; + } + return $retval; } -sub prepareForStartup() -{ +sub prepareForStartup() { - my $var_log_dir = $var_dir . "/tmp/log"; - &makeDir($var_log_dir); + my $var_log_dir = $var_dir . "/tmp/log"; + &makeDir($var_log_dir); - my $mode_dir = $log_dir . "/mode"; - &makeDir($mode_dir); + my $mode_dir = $log_dir . "/mode"; + &makeDir($mode_dir); - #- Write expect script - &writeExpect(); + #- Write expect script + &writeExpect(); } -sub makeDir() -{ - my ($dir) = @_; +sub makeDir() { + my ($dir) = @_; - #- Make all needed dirs/subdirs - my @log_dir_list = split('/', $dir); + #- Make all needed dirs/subdirs + my @log_dir_list = split( '/', $dir ); - my $dir2mk = ""; - foreach my $subdir (@log_dir_list){ - next unless( $subdir ); + my $dir2mk = ""; + foreach my $subdir (@log_dir_list) { + next unless ($subdir); - $dir2mk = $dir2mk . "/" . $subdir; - mkdir($dir2mk) or die $! unless( -d $dir2mk); - } + $dir2mk = $dir2mk . "/" . $subdir; + mkdir($dir2mk) or die $! unless ( -d $dir2mk ); + } } -sub cleanup() -{ - system("rm $log_dir/log*.txt 2>/dev/null 2>/dev/null") unless($opt_test); - system("rm $log_dir/board_ids_for_oracle*.txt 2>/dev/null 2>/dev/null") unless($opt_test); - system("rm $log_dir/mode/* 2>/dev/null 2>/dev/null") unless($opt_test); +sub cleanup() { + system("rm $log_dir/log*.txt 2>/dev/null 2>/dev/null") unless ($opt_test); + system("rm $log_dir/board_ids_for_oracle*.txt 2>/dev/null 2>/dev/null") unless ($opt_test); + system("rm $log_dir/mode/* 2>/dev/null 2>/dev/null") unless ($opt_test); } -sub writeExpect() -{ - # If command_server is not started on Etrax at boot time - # this expect script can be executed to start command_server. +sub writeExpect() { - #! Look if /tmp dir exists - my $tmp_dir = dirname("/tmp"); - if ( !(-d $tmp_dir) ){ - print "\nCannot access /tmp directory!\nExit.\n"; - exit(1); - } + # If command_server is not started on Etrax at boot time + # this expect script can be executed to start command_server. + + #! 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 = <$expect_script"); + my $fh = new FileHandle(">$expect_script"); - if(!$fh) { - my $txt = "\nError! Could not open file \"$expect_script\" for output. Exit.\n"; - print STDERR $txt; - print $txt; - die; - exit(128); - } + if ( !$fh ) { + my $txt = "\nError! Could not open file \"$expect_script\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + die; + exit(128); + } - print $fh $expect_script_my; - $fh->close(); + print $fh $expect_script_my; + $fh->close(); - #- open permissions - system("chmod 755 $expect_script") unless($opt_test); + #- open permissions + system("chmod 755 $expect_script") unless ($opt_test); } -sub getSubsysName() -{ - my ($script) = @_; +sub getSubsysName() { + my ($script) = @_; - my $subsys; + my $subsys; - if( $script =~ /..\/(\w+)\/(\w+).script/ ){ - $subsys = $1; + if ( $script =~ /..\/(\w+)\/(\w+).script/ ) { + $subsys = $1; - die "getSubsysName(): Undefined subsystem: \'$script\'! Exit.\n" unless( defined $subsys ); - } - else{ - $subsys = 'main'; - } + die "getSubsysName(): Undefined subsystem: \'$script\'! Exit.\n" unless ( defined $subsys ); + } + else { + $subsys = 'main'; + } - return $subsys; + return $subsys; } -sub preprocess() -{ - my ($preproc, $line) = @_; +sub preprocess() { + my ( $preproc, $line ) = @_; - my ($directive, $macro) = split(" ", $line); + my ( $directive, $macro ) = split( " ", $line ); - &preprocessCheck( $preproc, $directive ); + &preprocessCheck( $preproc, $directive ); - if( $directive eq "!ifdef" and (any {lc($_) eq lc($macro)} @opt_macro) ){ - $preproc->{'ifdef'} = 'on'; - $preproc->{'skeepLine'} = 0; + if ( $directive eq "!ifdef" and ( any { lc($_) eq lc($macro) } @opt_macro ) ) { + $preproc->{'ifdef'} = 'on'; + $preproc->{'skeepLine'} = 0; - #- Save found macro names - push(@usedMacros, $macro) unless(any {lc($_) eq lc($macro)} @usedMacros); + #- Save found macro names + push( @usedMacros, $macro ) unless ( any { lc($_) eq lc($macro) } @usedMacros ); - return 1; - } - elsif( $directive eq "!ifdef" ){ - #- No ifdef macros defined in cmd line => skeep next lines - $preproc->{'ifdef'} = 'on'; - $preproc->{'skeepLine'} = 1; + return 1; + } + elsif ( $directive eq "!ifdef" ) { - return 1; - } - elsif( $directive eq "!ifndef" && (any {lc($_) eq lc($macro)} @opt_macro) ){ - $preproc->{'ifndef'} = 'on'; - $preproc->{'skeepLine'} = 1; + #- No ifdef macros defined in cmd line => skeep next lines + $preproc->{'ifdef'} = 'on'; + $preproc->{'skeepLine'} = 1; - #- Save found macro names - push(@usedMacros, $macro) unless(any {lc($_) eq lc($macro)} @usedMacros); + return 1; + } + elsif ( $directive eq "!ifndef" && ( any { lc($_) eq lc($macro) } @opt_macro ) ) { + $preproc->{'ifndef'} = 'on'; + $preproc->{'skeepLine'} = 1; - return 1; - } - elsif( $directive eq "!ifndef" ){ - #- No ifndef macros defined in cmd line => include next lines - $preproc->{'ifndef'} = 'on'; - $preproc->{'skeepLine'} = 0; + #- Save found macro names + push( @usedMacros, $macro ) unless ( any { lc($_) eq lc($macro) } @usedMacros ); - return 1; - } - elsif( $directive eq "!endif" ){ - $preproc->{'ifndef'} = 'off'; - $preproc->{'ifdef'} = 'off'; - $preproc->{'skeepLine'} = 0; + return 1; + } + elsif ( $directive eq "!ifndef" ) { - return 1; - } + #- No ifndef macros defined in cmd line => include next lines + $preproc->{'ifndef'} = 'on'; + $preproc->{'skeepLine'} = 0; - return $preproc->{'skeepLine'}; + return 1; + } + elsif ( $directive eq "!endif" ) { + $preproc->{'ifndef'} = 'off'; + $preproc->{'ifdef'} = 'off'; + $preproc->{'skeepLine'} = 0; + + return 1; + } + + return $preproc->{'skeepLine'}; } -sub checkUnusedMacros() -{ - my @unusedMacros = (); - my $foundUnused = 0; +sub checkUnusedMacros() { + my @unusedMacros = (); + my $foundUnused = 0; - foreach my $macro (@opt_macro){ - unless((any {lc($_) eq lc($macro)} @usedMacros)){ - push(@unusedMacros, $macro); - $foundUnused = 1; - } + foreach my $macro (@opt_macro) { + unless ( ( any { lc($_) eq lc($macro) } @usedMacros ) ) { + push( @unusedMacros, $macro ); + $foundUnused = 1; } + } - if($foundUnused){ - print "\nUnused macro names:"; - - foreach my $macro (@unusedMacros){ - print " $macro"; - } - - print "\n"; + if ($foundUnused) { + print "\nUnused macro names:"; - &askUser(); + foreach my $macro (@unusedMacros) { + print " $macro"; } -} -sub preprocessInit() -{ - my %preproc = ( - 'ifdef' => 'off', - 'ifndef' => 'off', - 'skeepLine' => 0 - ); + print "\n"; - return \%preproc; + # &askUser(); + } } -sub preprocessCheck() -{ - my ($preproc, $directive) = @_; +sub preprocessInit() { + my %preproc = ( + 'ifdef' => 'off', + 'ifndef' => 'off', + 'skeepLine' => 0 + ); - if( $directive eq "!ifdef" || $directive eq "!ifndef" ){ - unless( ($preproc->{'ifdef'} eq 'off') && - ($preproc->{'ifndef'} eq 'off') ){ - print "Encapsulated \'ifdef\'/\'ifndef\' are not supported. Each \'ifdef\'/\'ifndef\' must be closed with \'endif\' before next \'ifdef\'/\'ifndef\' can be opened.\n"; - exit(1); - } - } - elsif( $directive eq "!endif" ){ - if( ($preproc->{'ifdef'} eq 'on' && $preproc->{'ifndef'} eq 'on') || - ($preproc->{'ifdef'} eq 'off' && $preproc->{'ifndef'} eq 'off') ){ - print "The sequence of directives looks fishy. Each \'ifdef\'/\'ifndef\' must be closed with \'endif\' before next \'ifdef\'/\'ifndef\' can be opened.\n"; - exit(1); - } - } - elsif( $directive =~ /!(\w+)/ ){ - print "Unknown directive $directive. Exit.\n"; - exit(1); - } + return \%preproc; } -sub readTRBSetup() -{ - my ($trb_db) = @_; +sub preprocessCheck() { + my ( $preproc, $directive ) = @_; + + if ( $directive eq "!ifdef" || $directive eq "!ifndef" ) { + unless ( ( $preproc->{'ifdef'} eq 'off' ) + && ( $preproc->{'ifndef'} eq 'off' ) ) + { + print +"Encapsulated \'ifdef\'/\'ifndef\' are not supported. Each \'ifdef\'/\'ifndef\' must be closed with \'endif\' before next \'ifdef\'/\'ifndef\' can be opened.\n"; + exit(1); + } + } + elsif ( $directive eq "!endif" ) { + if ( ( $preproc->{'ifdef'} eq 'on' && $preproc->{'ifndef'} eq 'on' ) + || ( $preproc->{'ifdef'} eq 'off' && $preproc->{'ifndef'} eq 'off' ) ) + { + print +"The sequence of directives looks fishy. Each \'ifdef\'/\'ifndef\' must be closed with \'endif\' before next \'ifdef\'/\'ifndef\' can be opened.\n"; + exit(1); + } + } + elsif ( $directive =~ /!(\w+)/ ) { + print "Unknown directive $directive. Exit.\n"; + exit(1); + } +} + +sub readTRBSetup() { + my ($trb_db) = @_; - my $fh = new FileHandle("$trb_db", "r"); + my $fh = new FileHandle( "$trb_db", "r" ); - &isItDefined($fh, $trb_db); + &isItDefined( $fh, $trb_db ); - #- Init preprocessor hash - my $preproc = &preprocessInit(); + #- Init preprocessor hash + my $preproc = &preprocessInit(); - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ - - #- Remove all comments - $_ =~ s{ # Substitue... + 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/); + #- Skip line if it contains only whitespaces + next unless (/\S/); - #- Check for preprocessor directives - next if( &preprocess($preproc, $_) ); + #- Check for preprocessor directives + next if ( &preprocess( $preproc, $_ ) ); - #- Extract command and parameters - my ($sys, $etrax, $rdo) = split(" ", $_); + #- Extract command and parameters + my ( $sys, $etrax, $rdo ) = split( " ", $_ ); - unless( defined $etrax ){ - print "Etrax is not defined in $trb_db for $sys! Exit\n"; - $fh->close; - exit(1); - } + unless ( defined $etrax ) { + print "Etrax is not defined in $trb_db for $sys! Exit\n"; + $fh->close; + exit(1); + } - #- Add to a main configuration hash - push( @{$trb_href->{$sys}}, $etrax ); + #- Add to a main configuration hash + push( @{ $trb_href->{$sys} }, $etrax ); - #- Add to a readout array for EB - if( defined $rdo && $rdo =~ /rdo/ ){ - push( @$rdo_aref, $etrax ); - } + #- Add to a readout array for EB + if ( defined $rdo && $rdo =~ /rdo/ ) { + push( @$rdo_aref, $etrax ); } - - $fh->close; + } + + $fh->close; } -sub readAddressRangeSetup() -{ - my ($addressRange_db) = @_; +sub readAddressRangeSetup() { + my ($addressRange_db) = @_; - my $fh = new FileHandle("$addressRange_db", "r"); + my $fh = new FileHandle( "$addressRange_db", "r" ); - &isItDefined($fh, $addressRange_db); + &isItDefined( $fh, $addressRange_db ); - #- Init preprocessor hash - my $preproc = &preprocessInit(); + #- Init preprocessor hash + my $preproc = &preprocessInit(); - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ - - #- Remove all comments - $_ =~ s{ # Substitue... + 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/); + #- Skip line if it contains only whitespaces + next unless (/\S/); - #- Check for preprocessor directives - next if( &preprocess($preproc, $_) ); + #- Check for preprocessor directives + next if ( &preprocess( $preproc, $_ ) ); - #- Extract command and parameters - my ($sys, $min, $max, $type) = split(" ", $_); + #- Extract command and parameters + my ( $sys, $min, $max, $type ) = split( " ", $_ ); - $min =~ s{ # Substitue... + $min =~ s{ # Substitue... 0x # ...hex zero - }{}gxms; # ...with nothing + }{}gxms; # ...with nothing - $max =~ s{ # Substitue... + $max =~ s{ # Substitue... 0x # ...hex zero - }{}gxms; # ...with nothing + }{}gxms; # ...with nothing + unless ( defined $sys + && defined $min + && defined $max + && defined $type ) + { + print "Something wrong with a format of $addressRange_db! Exit.\n"; + $fh->close; + exit(1); + } - unless( defined $sys && defined $min && - defined $max && defined $type){ - print "Something wrong with a format of $addressRange_db! Exit.\n"; - $fh->close; - exit(1); - } + $addressRange_href->{$sys}->{'MIN'} = $min; + $addressRange_href->{$sys}->{'MAX'} = $max; + $addressRange_href->{$sys}->{'TYPE'} = $type; + } - $addressRange_href->{$sys}->{'MIN'} = $min; - $addressRange_href->{$sys}->{'MAX'} = $max; - $addressRange_href->{$sys}->{'TYPE'} = $type; - } - - $fh->close; + $fh->close; } -sub readSubevtIdsSetup() -{ - my ($subevt_db) = @_; +sub readSubevtIdsSetup() { + my ($subevt_db) = @_; - my $fh = new FileHandle("$subevt_db", "r"); + my $fh = new FileHandle( "$subevt_db", "r" ); - &isItDefined($fh, $subevt_db); + &isItDefined( $fh, $subevt_db ); - #- Init preprocessor hash - my $preproc = &preprocessInit(); + #- Init preprocessor hash + my $preproc = &preprocessInit(); - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ - - #- Remove all comments - $_ =~ s{ # Substitue... + 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/); - - #- Check for preprocessor directives - next if( &preprocess($preproc, $_) ); + #- Skip line if it contains only whitespaces + next unless (/\S/); - #- Extract command and parameters - my $subevt; + #- Check for preprocessor directives + next if ( &preprocess( $preproc, $_ ) ); - if( $_ =~ /0x(\w+)/ ){ - $subevt = $1; - } - else{ - print "Something wrong with a format of $subevt_db! Exit\n"; - $fh->close; - exit(1); - } + #- Extract command and parameters + my $subevt; - #- Add to a config array - push( @$subEvtIds_aref, $subevt ); + if ( $_ =~ /0x(\w+)/ ) { + $subevt = $1; } - - $fh->close; + else { + print "Something wrong with a format of $subevt_db! Exit\n"; + $fh->close; + exit(1); + } + + #- Add to a config array + push( @$subEvtIds_aref, $subevt ); + } + + $fh->close; } -sub readScript() -{ - my ($script, $exec_sys) = @_; +sub readScript() { + my ( $script, $exec_sys ) = @_; + + #- Extract subsystem name + my $subsys = &getSubsysName($script); - #- Extract subsystem name - my $subsys = &getSubsysName($script); - #print "script: $script, subsys: $subsys\n"; + #print "script: $script, subsys: $subsys\n"; - my $fh = new FileHandle("$script", "r"); - &isItDefined($fh, $script); + my $fh = new FileHandle( "$script", "r" ); + &isItDefined( $fh, $script ); - #- Init preprocessor hash - my $preproc = &preprocessInit(); + #- Init preprocessor hash + my $preproc = &preprocessInit(); - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ - - #- Remove all comments - $_ =~ s{ # Substitue... + 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/); + #- Skip line if it contains only whitespaces + next unless (/\S/); - #- Check for preprocessor directives - next if( &preprocess($preproc, $_) ); + #- Check for preprocessor directives + next if ( &preprocess( $preproc, $_ ) ); - #- Extract command and parameters - my ($cmd, @param) = split(" ", $_); + #- Extract command and parameters + my ( $cmd, @param ) = split( " ", $_ ); - &add2startup( $subsys, $exec_sys, $cmd, \@param ); - } - - $fh->close; + &add2startup( $subsys, $exec_sys, $cmd, \@param ); + } + + $fh->close; } -sub add2startup(){ +sub add2startup() { - my ($subsys, $exec_sys, $cmd, $aref) = @_; + my ( $subsys, $exec_sys, $cmd, $aref ) = @_; - die "add2startup(): one or more arguments are not defined! Exit.\n" - unless( defined $subsys && defined $exec_sys && defined $cmd && defined $aref); - - if( $cmd =~ /exec_script\{(\w+)\}/ ){ - my $exec_sys = $1; + die "add2startup(): one or more arguments are not defined! Exit.\n" + unless ( defined $subsys && defined $exec_sys && defined $cmd && defined $aref ); - #- exec_script is followed only by one parameter [0]: script name - &readScript( $aref->[0], $exec_sys ); - } - elsif( $cmd =~ /exec_cmd\{(\w+)\}/){ - my $exec_sys = $1; + if ( $cmd =~ /exec_script\{(\w+)\}/ ) { + my $exec_sys = $1; - my $args = &getArgs4cmd($aref, $subsys); - &push2array( \@startup, $exec_sys, $args ); - } - elsif( $cmd eq 'exec_cmd'){ - - my $args = &getArgs4cmd($aref, $subsys); + #- exec_script is followed only by one parameter [0]: script name + &readScript( $aref->[0], $exec_sys ); + } + elsif ( $cmd =~ /exec_cmd\{(\w+)\}/ ) { + my $exec_sys = $1; - &push2array( \@startup, $exec_sys, $args ); - } - elsif( $cmd eq 'wait'){ + my $args = &getArgs4cmd( $aref, $subsys ); + &push2array( \@startup, $exec_sys, $args ); + } + elsif ( $cmd eq 'exec_cmd' ) { - #- At this point we will wait for the forked children - push( @startup, {$cmd => ['-']} ); - } - elsif( $cmd eq 'trbcmd'){ - my $args = &getArgs4cmd($aref, $subsys); - my $cmd_line = "$cmd $args"; - - &push2array( \@startup, $exec_sys, $cmd_line ); - } - elsif( $cmd eq 'set_addresses' ){ - my $serials = $aref->[0]; - my $addresses = $aref->[1]; - - my $conf = $subsys . "-" . $cmd . "-" . $serials . ".conf"; - my $args = &makeAddressesConf( $subsys, $serials, $addresses, $conf ); - my $bash_script = "trbdhcp -f $args"; - - &push2array( \@startup, $exec_sys, $bash_script ); - } - elsif( $cmd eq 'load_register' ){ - my $register = $aref->[0]; - - my $conf = $subsys . "-" . $cmd . "-" . $register . ".conf"; - my $args = &makeRegisterConf( $subsys, $register, $conf ); - my $bash_script = "trbcmd -f $args"; - - &push2array( \@startup, $exec_sys, $bash_script ); - } - elsif( $cmd eq 'daqop' ){ - my $args = &getArgs4cmd($aref, $subsys); - my $bash_script = "$cmd $args"; - - &push2array( \@startup, $exec_sys, $bash_script ); - } - elsif( $cmd eq 'read_trb_db' ){ - #- Read database file with TRB setup - my $trb_db = $aref->[0]; + my $args = &getArgs4cmd( $aref, $subsys ); - &readTRBSetup( $trb_db ); - } - elsif( $cmd eq 'read_addrange_db' ){ - #- Read database file with TRBNet address ranges - my $addrRanges_db = $aref->[0]; - - &readAddressRangeSetup($addrRanges_db); - } - elsif( $cmd eq 'read_subevtids_db' ){ - #- Read database file with subevent Ids - my $subevt_db = $aref->[0]; - - &readSubevtIdsSetup( $subevt_db ); - } - elsif( $cmd eq 'read_eb_conf' ){ - #- Read config file with EB settings - my $eb_conf = $aref->[0]; + &push2array( \@startup, $exec_sys, $args ); + } + elsif ( $cmd eq 'wait' ) { - read_config $eb_conf => %$EB_Args_href; - } - else{ - die "add2startup(): do not know what to do with command \'$cmd\' for subsystem \'$subsys\'! Exit.\n"; - } + #- At this point we will wait for the forked children + push( @startup, { $cmd => ['-'] } ); + } + elsif ( $cmd eq 'trbcmd' ) { + my $args = &getArgs4cmd( $aref, $subsys ); + my $cmd_line = "$cmd $args"; + + &push2array( \@startup, $exec_sys, $cmd_line ); + } + elsif ( $cmd eq 'set_addresses' ) { + my $serials = $aref->[0]; + my $addresses = $aref->[1]; + + my $conf = $subsys . "-" . $cmd . "-" . $serials . ".conf"; + my $args = &makeAddressesConf( $subsys, $serials, $addresses, $conf ); + my $bash_script = "trbdhcp -f $args"; + + &push2array( \@startup, $exec_sys, $bash_script ); + } + elsif ( $cmd eq 'load_register' ) { + my $register = $aref->[0]; + + my $conf = $subsys . "-" . $cmd . "-" . $register . ".conf"; + my $args = &makeRegisterConf( $subsys, $register, $conf ); + my $bash_script = "trbcmd -f $args"; + + &push2array( \@startup, $exec_sys, $bash_script ); + } + elsif ( $cmd eq 'daqop' ) { + my $args = &getArgs4cmd( $aref, $subsys ); + my $bash_script = "$cmd $args"; + + &push2array( \@startup, $exec_sys, $bash_script ); + } + elsif ( $cmd eq 'read_trb_db' ) { + + #- Read database file with TRB setup + my $trb_db = $aref->[0]; + + &readTRBSetup($trb_db); + } + elsif ( $cmd eq 'read_addrange_db' ) { + + #- Read database file with TRBNet address ranges + my $addrRanges_db = $aref->[0]; + + &readAddressRangeSetup($addrRanges_db); + } + elsif ( $cmd eq 'read_subevtids_db' ) { + + #- Read database file with subevent Ids + my $subevt_db = $aref->[0]; + + &readSubevtIdsSetup($subevt_db); + } + elsif ( $cmd eq 'read_eb_conf' ) { + + #- Read config file with EB settings + my $eb_conf = $aref->[0]; + + read_config $eb_conf => %$EB_Args_href; + } + else { + die "add2startup(): do not know what to do with command \'$cmd\' for subsystem \'$subsys\'! Exit.\n"; + } } -sub checkScript() -{ +sub checkScript() { } -sub getArgs4cmd() -{ - my ($aref, $subsys) = @_; +sub getArgs4cmd() { + my ( $aref, $subsys ) = @_; - my $args = ""; + my $args = ""; - if( $aref->[0] eq '-f' && defined $subsys ){ - my $conf = $aref->[1]; - system("cp ../$subsys/$conf $var_dir/tmp/.") unless($opt_test); - $args = "-f /home/hadaq/tmp/" . $conf; - } - else{ - for( my $i=0; $i < scalar (@{$aref}); $i++){ - $args = $args . " " . $aref->[$i]; - } + if ( $aref->[0] eq '-f' && defined $subsys ) { + my $conf = $aref->[1]; + system("cp ../$subsys/$conf $var_dir/tmp/.") unless ($opt_test); + $args = "-f /home/hadaq/tmp/" . $conf; + } + else { + for ( my $i = 0 ; $i < scalar( @{$aref} ) ; $i++ ) { + $args = $args . " " . $aref->[$i]; } + } - return $args; + return $args; } -sub isItDefined() -{ - my ($fh, $name) = @_; +sub isItDefined() { + my ( $fh, $name ) = @_; - if(!$fh) { - my $txt = "\nError! Could not open file \'$name\'. Exit.\n"; - print STDERR $txt; - print $txt; - die; - exit(128); - } + if ( !$fh ) { + my $txt = "\nError! Could not open file \'$name\'. Exit.\n"; + print STDERR $txt; + print $txt; + die; + exit(128); + } - return 0; + return 0; } -sub isVarDefined() -{ - my ($var, $name) = @_; +sub isVarDefined() { + my ( $var, $name ) = @_; - unless( defined $var ){ - print "$name is not defined! Exit.\n"; - exit(1); - } + unless ( defined $var ) { + print "$name is not defined! Exit.\n"; + exit(1); + } } -sub push2array() -{ - my ($aref, $exec_sys, $cmd) = @_; +sub push2array() { + my ( $aref, $exec_sys, $cmd ) = @_; - if( defined $aref->[-1] && defined $aref->[-1]->{$exec_sys} ){ - #- If last exec_sys equals current exec_sys - #- push current cmd to the same exec_sys - push( @{$aref->[-1]->{$exec_sys}}, $cmd ); - } - else{ - #- Unless create new entry in the main array - push( @$aref, {$exec_sys => [$cmd]} ); - } + if ( defined $aref->[-1] && defined $aref->[-1]->{$exec_sys} ) { + + #- If last exec_sys equals current exec_sys + #- push current cmd to the same exec_sys + push( @{ $aref->[-1]->{$exec_sys} }, $cmd ); + } + else { + #- Unless create new entry in the main array + push( @$aref, { $exec_sys => [$cmd] } ); + } } -sub execViaCmdServer() -{ - my (@process_list); - - my $i = 1; - - #- Loop over subsystems - foreach my $href ( @$startup_aref ){ -# print Time::HiRes::time()."\n" ; - - my ($exec_sys, $cmd_aref) = each ( %$href ); - - if($exec_sys eq 'con') { - foreach my $cmd ( @{$cmd_aref} ){ - system($cmd); - } - } - - if( $exec_sys eq 'wait' ){ - $| = 1; # turn off stdout buffering - print "wait...\r"; - #- Wait for the forked children - foreach my $cur_child_pid (@process_list) { - waitpid($cur_child_pid,0); - } - &scanLogs(); -# print Time::HiRes::time()."\n"; - next; - } +sub execViaCmdServer() { + my (@process_list); - print "exec: $exec_sys\n" unless( $exec_sys eq "local" || $exec_sys eq "con"); + my $i = 1; - #system("logger -p local1.info -t DAQ $exec_sys"); + #- Loop over subsystems + foreach my $href (@$startup_aref) { - #- Loop over TRBs for given exec_sys - if( $exec_sys =~ /etrax/ ){ - #- Name of etrax is explicitly written in exec_cmd{} - # in main startup script. - if($opt_etrax){ - my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . "_" . $opt_etrax . ".txt"; - &forkMe( $cmd_aref, \@process_list, $opt_etrax, $log); - } - else{ - my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . ".txt"; - &forkMe( $cmd_aref, \@process_list, $exec_sys, $log); - } - } - elsif( $exec_sys eq 'local' ){ - my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . ".txt"; - &forkMe( $cmd_aref, \@process_list, $exec_sys, $log); - } - elsif( $exec_sys eq 'nofork'){ - &execLocal($cmd_aref,$exec_sys); - } - else{ - #- Loop over TRBs for a given subsys - foreach my $trb ( @{$trb_href->{$exec_sys}} ){ - my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . "_" . $trb . ".txt"; - &forkMe( $cmd_aref, \@process_list, $trb, $log); - } - } + # print Time::HiRes::time()."\n" ; + + my ( $exec_sys, $cmd_aref ) = each(%$href); - $i++; #increment log file index + if ( $exec_sys eq 'con' ) { + foreach my $cmd ( @{$cmd_aref} ) { + system($cmd); + } } - #- Wait for children - foreach my $cur_child_pid (@process_list) { - waitpid($cur_child_pid,0); + if ( $exec_sys eq 'wait' ) { + $| = 1; # turn off stdout buffering + print "wait...\r"; + + #- Wait for the forked children + foreach my $cur_child_pid (@process_list) { + waitpid( $cur_child_pid, 0 ); + } + &scanLogs(); + + # print Time::HiRes::time()."\n"; + next; } -} -sub execLocal() -{ - my ($cmd_aref) = @_; + print "exec: $exec_sys\n" unless ( $exec_sys eq "local" || $exec_sys eq "con" ); - #- Loop over cmds to be executed on the local system - # without forking - foreach my $cmd ( @{$cmd_aref} ){ - $| = 1; # turn off stdout buffering + #system("logger -p local1.info -t DAQ $exec_sys"); - if($cmd =~ /check_compile_time/){ - &checkCompileTime($cmd) unless($opt_test); - } + #- Loop over TRBs for given exec_sys + if ( $exec_sys =~ /etrax/ ) { + + #- Name of etrax is explicitly written in exec_cmd{} + # in main startup script. + if ($opt_etrax) { + my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . "_" . $opt_etrax . ".txt"; + &forkMe( $cmd_aref, \@process_list, $opt_etrax, $log ); + } + else { + my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . ".txt"; + &forkMe( $cmd_aref, \@process_list, $exec_sys, $log ); + } + } + elsif ( $exec_sys eq 'local' ) { + my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . ".txt"; + &forkMe( $cmd_aref, \@process_list, $exec_sys, $log ); } + elsif ( $exec_sys eq 'nofork' ) { + &execLocal( $cmd_aref, $exec_sys ); + } + else { + #- Loop over TRBs for a given subsys + foreach my $trb ( @{ $trb_href->{$exec_sys} } ) { + my $log = $log_dir . "/" . "log" . $i . "_" . $exec_sys . "_" . $trb . ".txt"; + &forkMe( $cmd_aref, \@process_list, $trb, $log ); + } + } + + $i++; #increment log file index + } + + #- Wait for children + foreach my $cur_child_pid (@process_list) { + waitpid( $cur_child_pid, 0 ); + } } -sub forkMe() -{ - my ($cmd_aref, $proc_list, $etrax, $log) = @_; - - my $child = fork(); +sub execLocal() { + my ($cmd_aref) = @_; + + #- Loop over cmds to be executed on the local system + # without forking + foreach my $cmd ( @{$cmd_aref} ) { + $| = 1; # turn off stdout buffering - if( $child ){ # parent - push( @$proc_list, $child ); -# print "$child: ".$cmd_aref->[0]."\n"; + if ( $cmd =~ /check_compile_time/ ) { + &checkCompileTime($cmd) unless ($opt_test); } - elsif( $child == 0 ) { # child - exit(0) if($opt_test); - - if( $etrax eq "local" ){ - - #- Loop over cmds to be executed on the local system - foreach my $cmd ( @{$cmd_aref} ){ - $| = 1; # turn off stdout buffering - print "sleep...\r" if( $cmd =~ /sleep/ ); - - if($cmd =~ /daq2oracle/){ - &data2ora() unless($opt_test); - } - else{ - - #- Redirect STDOUT but not for 'echo' - unless($cmd =~ /echo/){ - open(STDOUT, ">>$log") || die "Cannot redirect STDOUT"; - open(STDERR, ">>&STDOUT") || die "Cannot dup STDERR"; - select STDERR; $| = 1; # make unbuffered - select STDOUT; $| = 1; # make unbuffered - } - - unless($opt_test){ - print "===> $cmd\n" unless($cmd =~ /echo/); - system("$cmd"); - print "> returned value of command $?\n" unless($cmd =~ /echo/); - } - - unless($cmd =~ /echo/){ - close(STDOUT); - close(STDERR); - } - } - } + } +} + +sub forkMe() { + my ( $cmd_aref, $proc_list, $etrax, $log ) = @_; + + my $child = fork(); + + if ($child) { # parent + push( @$proc_list, $child ); + + # print "$child: ".$cmd_aref->[0]."\n"; + } + elsif ( $child == 0 ) { # child + exit(0) if ($opt_test); + + if ( $etrax eq "local" ) { + + #- Loop over cmds to be executed on the local system + foreach my $cmd ( @{$cmd_aref} ) { + $| = 1; # turn off stdout buffering + print "sleep...\r" if ( $cmd =~ /sleep/ ); + + if ( $cmd =~ /daq2oracle/ ) { + &data2ora() unless ($opt_test); } - else{ - #- Connect to commandServer to exec commands on the remote systems - if( &connectCmdServer($cmd_aref, $etrax, $cmd_server_port, $cmd_server_prtcl, $log) ){ - #print "Something went wrong on commandServer side.\n"; - } + else { + + #- Redirect STDOUT but not for 'echo' + unless ( $cmd =~ /echo/ ) { + open( STDOUT, ">>$log" ) || die "Cannot redirect STDOUT"; + open( STDERR, ">>&STDOUT" ) || die "Cannot dup STDERR"; + select STDERR; + $| = 1; # make unbuffered + select STDOUT; + $| = 1; # make unbuffered + } + + unless ($opt_test) { + print "===> $cmd\n" unless ( $cmd =~ /echo/ ); + system("$cmd"); + print "> returned value of command $?\n" unless ( $cmd =~ /echo/ ); + } + + unless ( $cmd =~ /echo/ ) { + close(STDOUT); + close(STDERR); + } } - - exit(0); # exit child + } } - else{ - print "Could not fork: $!\n"; - exit(1); + else { + #- Connect to commandServer to exec commands on the remote systems + if ( &connectCmdServer( $cmd_aref, $etrax, $cmd_server_port, $cmd_server_prtcl, $log ) ) { + + #print "Something went wrong on commandServer side.\n"; + } } + + exit(0); # exit child + } + else { + print "Could not fork: $!\n"; + exit(1); + } } -sub connectCmdServer() -{ - my ($cmd, $remote_host, $remote_port, $protocol, $log) = @_; +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. + # '$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" ); + &isVarDefined( $cmd, "connectCmdServer(): cmd" ); + &isVarDefined( $remote_host, "connectCmdServer(): remote_host" ); - my $fh = new FileHandle(">$log"); + my $fh = new FileHandle(">$log"); - if(!$fh) { - my $txt = "\nError! Could not open file \"$log\" for output. Exit.\n"; - print STDERR $txt; - print $txt; - die; - exit(128); - } + if ( !$fh ) { + my $txt = "\nError! Could not open file \"$log\" for output. Exit.\n"; + print STDERR $txt; + print $txt; + die; + exit(128); + } - my $answer; - my $retval = 1; + 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"; + 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>; + unless ( defined $answer ) { + $socket->autoflush(1); + print $socket "iamfromhadesdaq\n"; + $answer = <$socket>; - &print2file($fh, $answer); + &print2file( $fh, $answer ); - my $reftype = reftype \$cmd; + my $reftype = reftype \$cmd; - if( $reftype =~ /REF/ ){ - #- Loop over commands to be executed on etrax - foreach my $command ( @{$cmd} ){ - - $command = &cmdParam( $command, $remote_host ); + if ( $reftype =~ /REF/ ) { - print $socket "$command\n"; - &print2file( $fh, "===> $command\n" ); - - while ( <$socket> ) { - &print2file( $fh, $_ ); + #- Loop over commands to be executed on etrax + foreach my $command ( @{$cmd} ) { - if( $_ =~ /- END OF OUTPUT -/ ){ - last; - } - } - } - } - else{ - print $socket "$cmd\n"; - &print2file( $fh, "===> $cmd\n" ); - - while ( <$socket> ) { - &print2file( $fh, $_ ); - - if( $_ =~ /- END OF OUTPUT -/ ){ - last; - } - } - } + $command = &cmdParam( $command, $remote_host ); - close($socket); - } + print $socket "$command\n"; + &print2file( $fh, "===> $command\n" ); - if( $answer =~ /Connection accepted/ ){ - $retval = 0; + while (<$socket>) { + &print2file( $fh, $_ ); + + if ( $_ =~ /- END OF OUTPUT -/ ) { + last; + } + } + } } - else{ - &print2file( $fh, $answer ); + else { + print $socket "$cmd\n"; + &print2file( $fh, "===> $cmd\n" ); + + while (<$socket>) { + &print2file( $fh, $_ ); + + if ( $_ =~ /- END OF OUTPUT -/ ) { + last; + } + } } - - $fh->close(); - - return $retval; + + close($socket); + } + + if ( $answer =~ /Connection accepted/ ) { + $retval = 0; + } + else { + &print2file( $fh, $answer ); + } + + $fh->close(); + + return $retval; } -sub cpThresholds() -{ - my ($timestamp) = @_; - - my $thresh_dir = "/data/lxhadesdaq/daq/thresh"; - my %ora_thresh; - my $ora_thresh_href = \%ora_thresh; +sub cpThresholds() { + my ($timestamp) = @_; + + my $thresh_dir = "/data/lxhadesdaq/daq/thresh"; + my %ora_thresh; + my $ora_thresh_href = \%ora_thresh; - foreach my $my_href ( @{$startup_aref} ){ + foreach my $my_href ( @{$startup_aref} ) { - my %my_hash = %$my_href; + my %my_hash = %$my_href; - my ($exec_sys, $cmd_aref) = each ( %my_hash ); - - next unless( defined $exec_sys ); + my ( $exec_sys, $cmd_aref ) = each(%my_hash); - next if( $exec_sys eq 'wait' ); + next unless ( defined $exec_sys ); - foreach my $cmd ( @{$cmd_aref} ){ - if( $cmd =~ /spi_trb/ ){ - $cmd =~ s/^\s+//; # remove leading whitespace + next if ( $exec_sys eq 'wait' ); - my ($spi, $thresh) = split(" ", $cmd); - my $thresh_name_new = $thresh_dir . "/thresh_" . $timestamp . "_" . $exec_sys; + foreach my $cmd ( @{$cmd_aref} ) { + if ( $cmd =~ /spi_trb/ ) { + $cmd =~ s/^\s+//; # remove leading whitespace - $ora_thresh_href->{$exec_sys} = $thresh_name_new; + my ( $spi, $thresh ) = split( " ", $cmd ); + my $thresh_name_new = $thresh_dir . "/thresh_" . $timestamp . "_" . $exec_sys; - my $THRPATH = "/var/diskless/etrax_fs"; - - $thresh =~ s{ # Substitue... + $ora_thresh_href->{$exec_sys} = $thresh_name_new; + + my $THRPATH = "/var/diskless/etrax_fs"; + + $thresh =~ s{ # Substitue... \/home\/hadaq # ...an Etrax path } {$THRPATH}gxms; # ...with lxhadesdaq path - if( $thresh =~ /\$\{TRBNUM\}/ ){ - foreach my $trb ( @{$trb_href->{$exec_sys}} ){ - my $trbnum = 0; #default - if( $trb =~ /etraxp?(\d{3})/ || $trb =~ /trb?\d(\d{2})/){ - $trbnum = $1; - } - else{ - croak "cmdParam: unexpected etrax name: $trb. Exit.\n"; - } - - #- replace TRBNUM - $thresh =~ s{ # Substitue ... + if ( $thresh =~ /\$\{TRBNUM\}/ ) { + foreach my $trb ( @{ $trb_href->{$exec_sys} } ) { + my $trbnum = 0; #default + if ( $trb =~ /etraxp?(\d{3})/ || $trb =~ /trb?\d(\d{2})/ ) { + $trbnum = $1; + } + else { + croak "cmdParam: unexpected etrax name: $trb. Exit.\n"; + } + + #- replace TRBNUM + $thresh =~ s{ # Substitue ... \$\{TRBNUM\} # ... a parameter } - {$trbnum}gxms; # ... with a TRB number + {$trbnum}gxms; # ... with a TRB number - my $thresh_name_trb = $thresh_name_new . "_" . $trbnum; + my $thresh_name_trb = $thresh_name_new . "_" . $trbnum; - system("cp $thresh $thresh_name_trb"); - } - } - else{ - system("cp $thresh $thresh_name_new"); - } - } + system("cp $thresh $thresh_name_trb"); + } + } + else { + system("cp $thresh $thresh_name_new"); } + } } + } - #- Build a line for Oracle DB - my $line = ""; + #- Build a line for Oracle DB + my $line = ""; - foreach my $exec_sys (sort keys %{$ora_thresh_href}){ - my $thresh_name = $ora_thresh_href->{$exec_sys}; - $line = $line . " " . $exec_sys . " lxhadesdaq:" . $thresh_name . "%"; - } + foreach my $exec_sys ( sort keys %{$ora_thresh_href} ) { + my $thresh_name = $ora_thresh_href->{$exec_sys}; + $line = $line . " " . $exec_sys . " lxhadesdaq:" . $thresh_name . "%"; + } - unless( $line eq "" ){ - $line = "loaded_thresholds " . $timestamp . " Loaded thresholds:% " . $line . "\n"; - } - else{ - print "WARNING: could not identify file names for loaded thresholds!\n" - } + unless ( $line eq "" ) { + $line = "loaded_thresholds " . $timestamp . " Loaded thresholds:% " . $line . "\n"; + } + else { + print "WARNING: could not identify file names for loaded thresholds!\n"; + } - return $line; + return $line; } -sub print2file() -{ - my ($fh, $toprint) = @_; +sub print2file() { + my ( $fh, $toprint ) = @_; - if( defined $toprint ){ - print $fh $toprint; - - if( $opt_verb || $toprint =~ /ERROR/){ - print "$toprint\n"; - } + if ( defined $toprint ) { + print $fh $toprint; + + if ( $opt_verb || $toprint =~ /ERROR/ ) { + print "$toprint\n"; } + } } -sub cmdParam(){ - my ($cmd, $etrax) = @_; +sub cmdParam() { + my ( $cmd, $etrax ) = @_; - croak "cmdParam: undefined etrax name. Exit.\n" unless( defined $etrax ); + croak "cmdParam: undefined etrax name. Exit.\n" unless ( defined $etrax ); - my $trbnum = 0; #default - if( $etrax =~ /etraxp?(\d{3})/ || $etrax =~ /trb?\d(\d{2})/ || $etrax =~ /hades?\w(\d{2})/){ - $trbnum = $1; - } - else{ - croak "cmdParam: unexpected etrax name: $etrax. Exit.\n"; - } + my $trbnum = 0; #default + if ( $etrax =~ /etraxp?(\d{3})/ || $etrax =~ /trb?\d(\d{2})/ || $etrax =~ /hades?\w(\d{2})/ ) { + $trbnum = $1; + } + else { + croak "cmdParam: unexpected etrax name: $etrax. Exit.\n"; + } - my $eb_port = $EB_Args_href->{'Main'}->{'PORT_BASE'} + $trbnum; - my $eb_ip = $EB_Args_href->{'Main'}->{'EB_IP'}; - - #- replace TRBNUM - $cmd =~ s{ # Substitue... + my $eb_port = $EB_Args_href->{'Main'}->{'PORT_BASE'} + $trbnum; + my $eb_ip = $EB_Args_href->{'Main'}->{'EB_IP'}; + + #- replace TRBNUM + $cmd =~ s{ # Substitue... \$\{TRBNUM\} # ...a parameter } - {$trbnum}gxms; # Raplace it with a TRB number - - #- replace EBIP - $cmd =~ s{ # Substitue... + {$trbnum}gxms; # Raplace it with a TRB number + + #- replace EBIP + $cmd =~ s{ # Substitue... \$\{EBIP\} # ...a parameter } - {$eb_ip}gxms; # Raplace it with a EB IP + {$eb_ip}gxms; # Raplace it with a EB IP - #- replace EBPORT - $cmd =~ s{ # Substitue... + #- replace EBPORT + $cmd =~ s{ # Substitue... \$\{EBPORT\} # ...a parameter } - {$eb_port}gxms; # Raplace it with a EB PORT - - $cmd = "source /home/hadaq/.bashrc; " . $cmd if($etrax =~ /hades?\w(\d{2})/); + {$eb_port}gxms; # Raplace it with a EB PORT + + $cmd = "source /home/hadaq/.bashrc; " . $cmd if ( $etrax =~ /hades?\w(\d{2})/ ); - return $cmd; + return $cmd; } -sub makeRegisterConf() -{ - my ($subsys, $register, $outConf) = @_; +sub makeRegisterConf() { + my ( $subsys, $register, $outConf ) = @_; - $register = "../" . $subsys . "/" . $register; + $register = "../" . $subsys . "/" . $register; - my %reg_hash; - my $reg_href = \%reg_hash; + my %reg_hash; + my $reg_href = \%reg_hash; - my $fh = new FileHandle("$register", "r"); - &isItDefined($fh, $register); + my $fh = new FileHandle( "$register", "r" ); + &isItDefined( $fh, $register ); - my $reg_table = 0; - my $val_table = 0; - my $ver_table = 0; - my $ver_tdcmask = 0; - my %mb_type; #Motherboard type - my $mb_type = \%mb_type; + my $reg_table = 0; + my $val_table = 0; + my $ver_table = 0; + my $ver_tdcmask = 0; + my %mb_type; #Motherboard type + my $mb_type = \%mb_type; - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ + while (<$fh>) { - #- Remove all comments - $_ =~ s{ # Substitue... + #- 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/); - - #- Find which table we will read now - if(/^(\s+)?!Register\stable/){ - $reg_table = 1; - $val_table = 0; - $ver_table = 0; - $ver_tdcmask = 0; - next; - } - elsif(/^(\s+)?!Value\stable/){ - $reg_table = 0; - $val_table = 1; - $ver_table = 0; - $ver_tdcmask = 0; - next; - } - elsif(/^(\s+)?!Version\stable/){ - $reg_table = 0; - $val_table = 0; - $ver_table = 1; - $ver_tdcmask = 0; - next; - } - elsif(/^(\s+)?!Version\stdcmask/){ - $reg_table = 0; - $val_table = 0; - $ver_table = 0; - $ver_tdcmask = 1; - next; - } - - if($reg_table){ - my ($type, @reg) = split(" ", $_); - my $reg = \@reg; - $mb_type->{$type} = $reg; - } - elsif($val_table){ - # We assume here that reg_table was before val_table - # thus mb_type hash is already filled at this point. + {$SPACE}gxms; # Raplace it with a single space - my ($addr, $type, @val) = split(" ", $_); + #- Skip line if it contains only whitespaces + next unless (/\S/); + + #- Find which table we will read now + if (/^(\s+)?!Register\stable/) { + $reg_table = 1; + $val_table = 0; + $ver_table = 0; + $ver_tdcmask = 0; + next; + } + elsif (/^(\s+)?!Value\stable/) { + $reg_table = 0; + $val_table = 1; + $ver_table = 0; + $ver_tdcmask = 0; + next; + } + elsif (/^(\s+)?!Version\stable/) { + $reg_table = 0; + $val_table = 0; + $ver_table = 1; + $ver_tdcmask = 0; + next; + } + elsif (/^(\s+)?!Version\stdcmask/) { + $reg_table = 0; + $val_table = 0; + $ver_table = 0; + $ver_tdcmask = 1; + next; + } + + if ($reg_table) { + my ( $type, @reg ) = split( " ", $_ ); + my $reg = \@reg; + $mb_type->{$type} = $reg; + } + elsif ($val_table) { + + # We assume here that reg_table was before val_table + # thus mb_type hash is already filled at this point. + + my ( $addr, $type, @val ) = split( " ", $_ ); + + if ( !defined $mb_type->{$type} ) { + print "Error: Board type '$type' specified in 'Value table' in $register\n"; + print "is most likely not defined in 'Register table'! Exit.\n"; + $fh->close; + exit(1); + } - if( ! defined $mb_type->{$type} ){ - print "Error: Board type '$type' specified in 'Value table' in $register\n"; - print "is most likely not defined in 'Register table'! Exit.\n"; - $fh->close; - exit(1); - } + my $arr_size = scalar @{ $mb_type->{$type} }; - my $arr_size = scalar @{ $mb_type->{$type} }; - - for(my $i=0; $i<$arr_size; $i++){ - my $reg = @{$mb_type->{$type}}[$i]; - my $val = $val[$i]; + for ( my $i = 0 ; $i < $arr_size ; $i++ ) { + my $reg = @{ $mb_type->{$type} }[$i]; + my $val = $val[$i]; - push(@{$reg_hash{$addr}}, {$reg => $val}); - } - } - elsif($ver_table){ - $data2ora_href->{"MDC"}->{"THRESH_VERS"} = $_ if( $subsys eq "mdc"); - $data2ora_href->{"RICH"}->{"THRESH_VERS"} = $_ if( $subsys eq "rich"); - } - elsif($ver_tdcmask){ - $data2ora_href->{"MDC"}->{"TDCMASK_VERS"} = $_ if( $subsys eq "mdc"); - } + push( @{ $reg_hash{$addr} }, { $reg => $val } ); + } + } + elsif ($ver_table) { + $data2ora_href->{"MDC"}->{"THRESH_VERS"} = $_ if ( $subsys eq "mdc" ); + $data2ora_href->{"RICH"}->{"THRESH_VERS"} = $_ if ( $subsys eq "rich" ); + } + elsif ($ver_tdcmask) { + $data2ora_href->{"MDC"}->{"TDCMASK_VERS"} = $_ if ( $subsys eq "mdc" ); } + } - $fh->close; + $fh->close; - #--------------- Write config file - my $outConf_register = $var_dir . "/tmp/" . $outConf; - my $ret_register = "/home/hadaq/tmp/" . $outConf; + #--------------- Write config file + my $outConf_register = $var_dir . "/tmp/" . $outConf; + my $ret_register = "/home/hadaq/tmp/" . $outConf; - $fh = new FileHandle(">$outConf_register") || die "could not open $outConf_register"; + $fh = new FileHandle(">$outConf_register") || die "could not open $outConf_register"; - foreach my $addr ( sort keys %{$reg_href} ){ - foreach my $ref (@{$reg_href->{$addr}}){ - my ($reg, $thr) = each( %{$ref} ); - - print $fh "w $addr $reg $thr\n"; - } + foreach my $addr ( sort keys %{$reg_href} ) { + foreach my $ref ( @{ $reg_href->{$addr} } ) { + my ( $reg, $thr ) = each( %{$ref} ); + + print $fh "w $addr $reg $thr\n"; } + } - $fh->close; - - return $ret_register; + $fh->close; + + return $ret_register; } -sub makeAddressesConf() -{ - my ($subsys, $serials, $addresses, $outConf) = @_; +sub makeAddressesConf() { + my ( $subsys, $serials, $addresses, $outConf ) = @_; - $serials = "../" . $subsys . "/" . $serials; - $addresses = "../" . $subsys . "/" . $addresses; + $serials = "../" . $subsys . "/" . $serials; + $addresses = "../" . $subsys . "/" . $addresses; - my %trbdhcp_hash; - my $trbdhcp_href = \%trbdhcp_hash; + my %trbdhcp_hash; + my $trbdhcp_href = \%trbdhcp_hash; - #------------ Read addresses into trbdhcp hash - my $fh = new FileHandle("$addresses", "r"); - &isItDefined($fh, $addresses); + #------------ Read addresses into trbdhcp hash + my $fh = new FileHandle( "$addresses", "r" ); + &isItDefined( $fh, $addresses ); - my $SPACE = ""; + my $SPACE = ""; - while(<$fh>){ + while (<$fh>) { - #- Remove all comments - $_ =~ s{ # Substitue... + #- 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/); + #- Skip line if it contains only whitespaces + next unless (/\S/); - my ($addr, $serial, $endpoint, $design, $trbNr) = split(" ", $_); + my ( $addr, $serial, $endpoint, $design, $trbNr ) = split( " ", $_ ); - #- All fields must be defined - next unless( defined $design && defined $addr && - defined $serial && defined $endpoint); + #- All fields must be defined + next unless ( defined $design + && defined $addr + && defined $serial + && defined $endpoint ); - #- Skip all lines with serial number zero - next if( $serial eq '0' ); + #- Skip all lines with serial number zero + next if ( $serial eq '0' ); - #- Define uniqueu key - my $key = $addr . "_" . $endpoint; + #- Define uniqueu key + my $key = $addr . "_" . $endpoint; - $trbdhcp_href->{$key}->{'addr'} = lc($addr); - $trbdhcp_href->{$key}->{'design'} = $design; - $trbdhcp_href->{$key}->{'endpoint'} = $endpoint; - $trbdhcp_href->{$key}->{'serial'} = $serial; - $trbdhcp_href->{$key}->{'trb'} = $trbNr; + $trbdhcp_href->{$key}->{'addr'} = lc($addr); + $trbdhcp_href->{$key}->{'design'} = $design; + $trbdhcp_href->{$key}->{'endpoint'} = $endpoint; + $trbdhcp_href->{$key}->{'serial'} = $serial; + $trbdhcp_href->{$key}->{'trb'} = $trbNr; - } + } + + $fh->close; - $fh->close; + #------------ Read serials into trbdhcp hash + $fh = new FileHandle( "$serials", "r" ); + &isItDefined( $fh, $serials ); - #------------ Read serials into trbdhcp hash - $fh = new FileHandle("$serials", "r"); - &isItDefined($fh, $serials); + while (<$fh>) { - while(<$fh>){ - - #- Remove all comments - $_ =~ s{ # Substitue... + #- 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/); + #- Skip line if it contains only whitespaces + next unless (/\S/); - my ($serial, $uid) = split(" ", $_); + my ( $serial, $uid ) = split( " ", $_ ); - next unless( defined $serial && defined $uid ); + next unless ( defined $serial && defined $uid ); - #- Skip all lines with serial number zero - next if( $serial eq '0' ); + #- Skip all lines with serial number zero + next if ( $serial eq '0' ); - foreach my $key ( keys %{$trbdhcp_href} ){ + foreach my $key ( keys %{$trbdhcp_href} ) { - next unless( $serial eq $trbdhcp_href->{$key}->{'serial'} ); - $trbdhcp_href->{$key}->{'uid'} = lc($uid); - } + next unless ( $serial eq $trbdhcp_href->{$key}->{'serial'} ); + $trbdhcp_href->{$key}->{'uid'} = lc($uid); } + } - $fh->close; + $fh->close; - #------------ Write config file for 'trbdhcp' - my $outConf_trbdhcp = $var_dir . "/tmp/" . $outConf; - my $ret_trbdhcp = "/home/hadaq/tmp/" . $outConf; - $fh = new FileHandle(">$outConf_trbdhcp"); + #------------ Write config file for 'trbdhcp' + my $outConf_trbdhcp = $var_dir . "/tmp/" . $outConf; + my $ret_trbdhcp = "/home/hadaq/tmp/" . $outConf; + $fh = new FileHandle(">$outConf_trbdhcp"); - foreach my $key (sort keys %$trbdhcp_href) { - my $addr = $trbdhcp_href->{$key}->{'addr'}; - my $uid = $trbdhcp_href->{$key}->{'uid'}; - my $endpoint = $trbdhcp_href->{$key}->{'endpoint'}; - - next if( ! defined $addr || ! defined $uid || ! defined $endpoint); + foreach my $key ( sort keys %$trbdhcp_href ) { + my $addr = $trbdhcp_href->{$key}->{'addr'}; + my $uid = $trbdhcp_href->{$key}->{'uid'}; + my $endpoint = $trbdhcp_href->{$key}->{'endpoint'}; - print $fh "$addr $uid $endpoint\n"; - } + next if ( !defined $addr || !defined $uid || !defined $endpoint ); + + print $fh "$addr $uid $endpoint\n"; + } - $fh->close; + $fh->close; - #--- Add this hash to a global hash - %addr_db_conf = (%addr_db_conf, %$trbdhcp_href); + #--- Add this hash to a global hash + %addr_db_conf = ( %addr_db_conf, %$trbdhcp_href ); - return $ret_trbdhcp; + return $ret_trbdhcp; } -sub checkCompileTime() -{ - my ($cmd) = @_; +sub checkCompileTime() { + my ($cmd) = @_; - my $sys; - my $compile_time; + my $sys; + my $compile_time; - if($cmd =~ /check_compile_time\s+(\w+)\s+0x(\w+)/){ - $sys = lc($1); - $compile_time = hex($2); - } + if ( $cmd =~ /check_compile_time\s+(\w+)\s+0x(\w+)/ ) { + $sys = lc($1); + $compile_time = hex($2); + } - unless( defined $sys || defined $compile_time ){ - die "check_compile_time command must contain system and compile time as arguments! Exit.\n"; - } + unless ( defined $sys || defined $compile_time ) { + die "check_compile_time command must contain system and compile time as arguments! Exit.\n"; + } - my $read_cmd = ""; - if(lc($sys) eq "oep"){ - $read_cmd = "trbcmd r 0xfffd 0x40"; - } - else{ - print "Reading compile times failed: unsupported sys type $sys\n"; - return 0; - } + my $read_cmd = ""; + if ( lc($sys) eq "oep" ) { + $read_cmd = "trbcmd r 0xfffd 0x40"; + } + else { + print "Reading compile times failed: unsupported sys type $sys\n"; + return 0; + } - my @out = `$read_cmd`; + my @out = `$read_cmd`; - my $oldCompileTime = 0; + my $oldCompileTime = 0; - foreach my $line (@out){ + foreach my $line (@out) { - next if($line =~ /Read compile time/ ); + next if ( $line =~ /Read compile time/ ); - if( $line =~ /failed/ ){ - print "ERROR: when reading compile times of $sys: $line\n"; - &askUser(); - } + if ( $line =~ /failed/ ) { + print "ERROR: when reading compile times of $sys: $line\n"; + &askUser(); + } - my $local_time; - my $local_addr; + my $local_time; + my $local_addr; - if( $line =~ /0x(\w+)\s+0x(\w+)/ ){ - $local_addr = lc($1); - $local_time = hex($2); - } + if ( $line =~ /0x(\w+)\s+0x(\w+)/ ) { + $local_addr = lc($1); + $local_time = hex($2); + } - unless( defined $local_addr || defined $local_time ){ - print "ERROR: unexpected output: $line\n from command: $read_cmd\n"; - &askUser(); - } + unless ( defined $local_addr || defined $local_time ) { + print "ERROR: unexpected output: $line\n from command: $read_cmd\n"; + &askUser(); + } - if( defined $local_time && defined $local_addr){ - if( $local_time < $compile_time ){ - $oldCompileTime = 1; - print "Compile time for $sys $local_addr is too old!\n"; - } - } + if ( defined $local_time && defined $local_addr ) { + if ( $local_time < $compile_time ) { + $oldCompileTime = 1; + print "Compile time for $sys $local_addr is too old!\n"; + } } + } - &askUser() if($oldCompileTime); + &askUser() if ($oldCompileTime); } -sub askUser() -{ - my $answer = &promptUser("Continue?", "Enter to continue, Ctrl+C to stop"); - if( $answer eq "no" || $answer eq "n" ){ - print "Exit.\n"; - exit(0); - } - else{ - print "Continue...\n"; - } +sub askUser() { + my $answer = &promptUser( "Continue?", "Enter to continue, Ctrl+C to stop" ); + if ( $answer eq "no" || $answer eq "n" ) { + print "Exit.\n"; + exit(0); + } + else { + print "Continue...\n"; + } } -sub checkConnection() -{ +sub checkConnection() { - #----------- Check connection to hosts ------------- - print "Check connection to hosts...\n"; + #----------- Check connection to hosts ------------- + print "Check connection to hosts...\n"; - my @dead_hosts = (); - my @alive_hosts = (); - &pingHosts(\@alive_hosts, \@dead_hosts); + my @dead_hosts = (); + my @alive_hosts = (); + &pingHosts( \@alive_hosts, \@dead_hosts ); - if( @dead_hosts ){ - print "Cannot connect to the following hosts:\n"; - - foreach my $host (@dead_hosts){ + if (@dead_hosts) { + print "Cannot connect to the following hosts:\n"; - my $msg = "undef"; - if($host =~ /etraxp?(\d{3})/){ - my $serial = $1; + foreach my $host (@dead_hosts) { - if(&checkShowerNORPC($host)){ - $msg = "addr: - type: -"; - } - else{ - $msg = &serial2addrAndSysType($serial, "TRB"); - } - } - - print "$host $msg\n"; - system("logger -p local1.info -t DAQ STARTUP \\ Cannot connect to $host $msg"); + my $msg = "undef"; + if ( $host =~ /etraxp?(\d{3})/ ) { + my $serial = $1; + + if ( &checkShowerNORPC($host) ) { + $msg = "addr: - type: -"; } - - &askUser(); - } - else{ - print "Connection to hosts is OK.\n"; + else { + $msg = &serial2addrAndSysType( $serial, "TRB" ); + } + } + + print "$host $msg\n"; + system("logger -p local1.info -t DAQ STARTUP \\ Cannot connect to $host $msg"); } - #---------- Check connection to command servers ------------- -# print "Check connection to command servers...\n"; + &askUser(); + } + else { + print "Connection to hosts is OK.\n"; + } -# my @dead_cservers = (); + #---------- Check connection to command servers ------------- + # print "Check connection to command servers...\n"; -# &checkCmdServers(\@alive_hosts, \@dead_cservers); + # my @dead_cservers = (); - if( @dead_cservers ){ - print "Cannot connect to command servers for the hosts:\n"; - - foreach my $host (@dead_cservers){ - print "$host\n"; - system("logger -p local1.info -t DAQ STARTUP \\ Cannot connect to command server at $host"); - } + # &checkCmdServers(\@alive_hosts, \@dead_cservers); - print "I will try to restart the command servers\n"; + if (@dead_cservers) { + print "Cannot connect to command servers for the hosts:\n"; - &restartCmdServers(\@dead_cservers); + foreach my $host (@dead_cservers) { + print "$host\n"; + system("logger -p local1.info -t DAQ STARTUP \\ Cannot connect to command server at $host"); + } - @dead_cservers = (); - - &pingHosts(\@alive_hosts, \@dead_cservers); - - if( @dead_cservers ){ - print "Still cannot connect to command servers for the hosts:\n"; - - foreach my $host (@dead_cservers){ - print "$host\n"; - } + print "I will try to restart the command servers\n"; - print "Try to start \'command_server -p 4712 &\' on these hosts by hand.\n"; -# print "Exit.\n"; -# exit(0); - } - else{ - print "Missing command_servers have been started! Continue...\n"; - sleep(2); - } + &restartCmdServers( \@dead_cservers ); + + @dead_cservers = (); + + &pingHosts( \@alive_hosts, \@dead_cservers ); + + if (@dead_cservers) { + print "Still cannot connect to command servers for the hosts:\n"; + + foreach my $host (@dead_cservers) { + print "$host\n"; + } + print "Try to start \'command_server -p 4712 &\' on these hosts by hand.\n"; + + # print "Exit.\n"; + # exit(0); } - else{ - print "Connection to command servers is OK.\n"; + else { + print "Missing command_servers have been started! Continue...\n"; + sleep(2); } - if( @dead_hosts ){ - &rmDeadHosts(\@dead_hosts); - } + + } + else { + print "Connection to command servers is OK.\n"; + } + if (@dead_hosts) { + &rmDeadHosts( \@dead_hosts ); + } } -sub rmDeadHosts() -{ - my ($dead_hosts_aref) = @_; +sub rmDeadHosts() { + my ($dead_hosts_aref) = @_; - #my $copy = clone($some_ref); - - foreach my $sys (%$trb_href){ + #my $copy = clone($some_ref); - next unless($trb_href->{$sys} && @{$trb_href->{$sys}} && $#{$trb_href->{$sys}} > 0 ); + foreach my $sys (%$trb_href) { - foreach my $host (@$dead_hosts_aref){ - @{$trb_href->{$sys}} = grep { !($_ eq $host) } @{$trb_href->{$sys}}; - } + next unless ( $trb_href->{$sys} && @{ $trb_href->{$sys} } && $#{ $trb_href->{$sys} } > 0 ); + + foreach my $host (@$dead_hosts_aref) { + @{ $trb_href->{$sys} } = grep { !( $_ eq $host ) } @{ $trb_href->{$sys} }; } + } } - - sub promptUser { -#----------------------------( promptUser )----------------------------- -# -# FUNCTION: promptUser -# -# PURPOSE: Prompt the user for some type of input, and return the -# input back to the calling program. -# -# ARGS: $promptString - what you want to prompt the user with -# $defaultValue - (optional) a default value for the prompt -# -# EXAMPLES: -# $username = &promptUser("Enter the username "); -# $password = &promptUser("Enter the password "); -# $homeDir = &promptUser("Enter the home directory ", "/home/$username"); -# print "$username, $password, $homeDir\n"; -# -#------------------------------------------------------------------------- - # two possible input arguments - $promptString, and $defaultValue - # make the input arguments local variables. - - my ($promptString,$defaultValue) = @_; - - # if there is a default value, use the first print statement; if - # no default is provided, print the second string. - - if ($defaultValue) { - print $promptString, "[", $defaultValue, "]: "; - } else { - print $promptString, ": "; - } - print "\n"; - - $| = 1; # force a flush after our print - my $input = ; # get the input from STDIN (presumably the keyboard) - - # remove the newline character from the end of the input the user gave us - - chomp($input); - - # if we had a $default value, and the user gave us input, then - # return the input; if we had a default, and they gave us no - # no input, return the $defaultValue. - # - # if we did not have a default value, then just return whatever - # the user gave us. if they just hit the key, - # the calling routine will have to deal with that. - - if ("$defaultValue") { - return $input ? $input : $defaultValue; # return $input if it has a value - } else { - return $input; - } + + #----------------------------( promptUser )----------------------------- + # + # FUNCTION: promptUser + # + # PURPOSE: Prompt the user for some type of input, and return the + # input back to the calling program. + # + # ARGS: $promptString - what you want to prompt the user with + # $defaultValue - (optional) a default value for the prompt + # + # EXAMPLES: + # $username = &promptUser("Enter the username "); + # $password = &promptUser("Enter the password "); + # $homeDir = &promptUser("Enter the home directory ", "/home/$username"); + # print "$username, $password, $homeDir\n"; + # + #------------------------------------------------------------------------- + # two possible input arguments - $promptString, and $defaultValue + # make the input arguments local variables. + + my ( $promptString, $defaultValue ) = @_; + + # if there is a default value, use the first print statement; if + # no default is provided, print the second string. + + if ($defaultValue) { + print $promptString, "[", $defaultValue, "]: "; + } + else { + print $promptString, ": "; + } + print "\n"; + + $| = 1; # force a flush after our print + my $input = ; # get the input from STDIN (presumably the keyboard) + + # remove the newline character from the end of the input the user gave us + + chomp($input); + + # if we had a $default value, and the user gave us input, then + # return the input; if we had a default, and they gave us no + # no input, return the $defaultValue. + # + # if we did not have a default value, then just return whatever + # the user gave us. if they just hit the key, + # the calling routine will have to deal with that. + + if ("$defaultValue") { + return $input ? $input : $defaultValue; # return $input if it has a value + } + else { + return $input; + } } -sub pingHosts() -{ - my ($alive_hosts_aref, $dead_hosts_aref) = @_; - my @thread_list = (); - my @host_tmp_list = (); +sub pingHosts() { + my ( $alive_hosts_aref, $dead_hosts_aref ) = @_; + my @thread_list = (); + my @host_tmp_list = (); - foreach my $sys (%$trb_href){ - foreach my $host ( @{$trb_href->{$sys}} ){ + foreach my $sys (%$trb_href) { + foreach my $host ( @{ $trb_href->{$sys} } ) { - next if(any {$host eq $_} @host_tmp_list); # Exclude hosts which were already checked - push(@thread_list, threads->new( \&pingHost, $host)); - push(@host_tmp_list, $host); - } + next if ( any { $host eq $_ } @host_tmp_list ); # Exclude hosts which were already checked + push( @thread_list, threads->new( \&pingHost, $host ) ); + push( @host_tmp_list, $host ); } + } - #- Join threads - my $retcode; + #- Join threads + my $retcode; - foreach my $t (@thread_list){ - $retcode = $t->join(); - - next if($retcode eq -1); + foreach my $t (@thread_list) { + $retcode = $t->join(); - my ($host, $hstat) = split(/:/, $retcode); + next if ( $retcode eq -1 ); - if( $hstat eq "alive" ){ - push( @$alive_hosts_aref, $host ); - } - elsif( $hstat eq "dead" ){ - push( @$dead_hosts_aref, $host ); - } - elsif( $hstat eq "cmdserverdead" ){ - push( @$alive_hosts_aref, $host ); - push( @dead_cservers, $host ); - } - else{ - print "ping $host returned unknown status: $hstat. Exit.\n"; - exit(0); - } + my ( $host, $hstat ) = split( /:/, $retcode ); + + if ( $hstat eq "alive" ) { + push( @$alive_hosts_aref, $host ); + } + elsif ( $hstat eq "dead" ) { + push( @$dead_hosts_aref, $host ); + } + elsif ( $hstat eq "cmdserverdead" ) { + push( @$alive_hosts_aref, $host ); + push( @dead_cservers, $host ); } + else { + print "ping $host returned unknown status: $hstat. Exit.\n"; + exit(0); + } + } } -sub pingHost() -{ - my ($host) = @_; - - my $retval = "undef"; -# print $host." ".Time::HiRes::time()."\n" ; - my $p = Net::Ping->new(); +sub pingHost() { + my ($host) = @_; - if( $p->ping($host,1) ){ - $retval = "$host:alive"; - } - else{ - $retval = "$host:dead"; - return $retval; - } - $p->close(); -# print $host." ".Time::HiRes::time()."\n" ; - #Jan 06.01.12 - my $sock = new IO::Socket::INET ( - PeerAddr => $host, - PeerPort => $cmd_server_port, - Proto => 'tcp'); - $retval = "$host:cmdserverdead" unless $sock; - close($sock) if( defined $sock ); - #Jan 06.01.12 -#print $host." ".Time::HiRes::time()."\n" ; + my $retval = "undef"; + + # print $host." ".Time::HiRes::time()."\n" ; + my $p = Net::Ping->new(); + + if ( $p->ping( $host, 1 ) ) { + $retval = "$host:alive"; + } + else { + $retval = "$host:dead"; return $retval; + } + $p->close(); + + # print $host." ".Time::HiRes::time()."\n" ; + #Jan 06.01.12 + my $sock = new IO::Socket::INET( + PeerAddr => $host, + PeerPort => $cmd_server_port, + Proto => 'tcp' + ); + $retval = "$host:cmdserverdead" unless $sock; + close($sock) if ( defined $sock ); + + #Jan 06.01.12 + #print $host." ".Time::HiRes::time()."\n" ; + return $retval; } # sub checkCmdServers() # { # my ($alive_hosts_aref, $dead_cservers_aref) = @_; -# +# # foreach my $host (@$alive_hosts_aref){ -# my $sock = new IO::Socket::INET ( -# PeerAddr => $host, -# PeerPort => $cmd_server_port, -# Proto => 'tcp'); -# push( @$dead_cservers_aref, $host ) unless $sock; +# my $sock = new IO::Socket::INET ( +# PeerAddr => $host, +# PeerPort => $cmd_server_port, +# Proto => 'tcp'); +# push( @$dead_cservers_aref, $host ) unless $sock; # close($sock) if( defined $sock ); # } # } -sub execViaExpect() -{ - my ($etrax, $path, $cmd, $args, $log) = @_; +sub execViaExpect() { + my ( $etrax, $path, $cmd, $args, $log ) = @_; - my $exe = "$expect_script $etrax $path $cmd $args > $log 2>&1"; - print "exe: $exe\n" if($opt_verb); - system($exe) unless($opt_test); + my $exe = "$expect_script $etrax $path $cmd $args > $log 2>&1"; + print "exe: $exe\n" if ($opt_verb); + system($exe) unless ($opt_test); } -sub restartCmdServers() -{ - my ($dead_cservers_aref) = @_; +sub restartCmdServers() { + my ($dead_cservers_aref) = @_; - my $path = "/home/hadaq/bin/"; + my $path = "/home/hadaq/bin/"; - foreach my $host (@$dead_cservers_aref){ - my $log = $log_dir . "/expect_" . $host . ".log"; - &execViaExpect( $host, $path, "command_server", "\'-p 4712 &\'", $log); - } + foreach my $host (@$dead_cservers_aref) { + my $log = $log_dir . "/expect_" . $host . ".log"; + &execViaExpect( $host, $path, "command_server", "\'-p 4712 &\'", $log ); + } } -sub data2ora() -{ +sub data2ora() { - #- Read unique IDs - my @id_list = `trbcmd i 0xffff`; + #- Read unique IDs + my @id_list = `trbcmd i 0xffff`; - foreach my $id_line (@id_list){ + foreach my $id_line (@id_list) { - if( $id_line =~ /failed/ ){ - print "ERROR: data2ora(): 'daqop read ids' failed! Exit.\n"; - exit(1); - } + if ( $id_line =~ /failed/ ) { + print "ERROR: data2ora(): 'daqop read ids' failed! Exit.\n"; + exit(1); + } - if( $id_line =~ /0x(\w+)\s+0x(\w+)\s+0x(\w+)/ ){ - my $addr = lc($1); - my $uid = lc($2); - my $fpga = $3; - - #- There are boards with several FPGAs - # These boards have identical Ids but several different - # trbnet addresses (three addresses for the board with three FPGAs) - # The smallest address is of importance for us because it is an address - # of FPGA which sends the data out (uplink). Thus the smallest - # address is the address of the data source. - if( defined $data2ora_href->{"BOARDID"}->{$uid} ){ - if( hex($addr) < hex($data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'}) ){ - $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'} = $addr; - } - } - else{ - $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'} = $addr; - } + if ( $id_line =~ /0x(\w+)\s+0x(\w+)\s+0x(\w+)/ ) { + my $addr = lc($1); + my $uid = lc($2); + my $fpga = $3; + + #- There are boards with several FPGAs + # These boards have identical Ids but several different + # trbnet addresses (three addresses for the board with three FPGAs) + # The smallest address is of importance for us because it is an address + # of FPGA which sends the data out (uplink). Thus the smallest + # address is the address of the data source. + if ( defined $data2ora_href->{"BOARDID"}->{$uid} ) { + if ( hex($addr) < hex( $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'} ) ) { + $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'} = $addr; } + } + else { + $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'} = $addr; + } } + } - #-------- Write data to a file to be passed to Oracle + #-------- Write data to a file to be passed to Oracle - my $timestamp = &timeStamp(); - my $ora_file = "/home/hadaq/oper/daq2ora/daq2ora_" . $timestamp . ".txt"; - my $current_file = "/home/hadaq/oper/daq2ora/daq2ora_current.txt"; + my $timestamp = &timeStamp(); + my $ora_file = "/home/hadaq/oper/daq2ora/daq2ora_" . $timestamp . ".txt"; + my $current_file = "/home/hadaq/oper/daq2ora/daq2ora_current.txt"; - #- Read settings with resolution mode of TRBs - my $TDCsettings_href = &readTRBTDCsettings(); + #- Read settings with resolution mode of TRBs + my $TDCsettings_href = &readTRBTDCsettings(); - open( FILE, '>', $ora_file ) or die "Could not open $ora_file: $!" if($opt_ora eq "file"); + open( FILE, '>', $ora_file ) or die "Could not open $ora_file: $!" if ( $opt_ora eq "file" ); - #- Write threshold file names - my $line_thresh = &cpThresholds($timestamp); - if( $line_thresh =~ /loaded_thresholds/){ - #print FILE $line_thresh; - } + #- Write threshold file names + my $line_thresh = &cpThresholds($timestamp); + if ( $line_thresh =~ /loaded_thresholds/ ) { - foreach my $uid ( sort keys %{$data2ora_href->{"BOARDID"}} ){ - my $addr = $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'}; - my $subevtid; + #print FILE $line_thresh; + } - if( any {lc($_) eq lc($addr)} @subEvtIds ){ - $subevtid = lc($addr); - } - else{ - $subevtid = "NULL"; - } + foreach my $uid ( sort keys %{ $data2ora_href->{"BOARDID"} } ) { + my $addr = $data2ora_href->{"BOARDID"}->{$uid}->{'ADDR'}; + my $subevtid; - #- Get TRB resolution mode (returns 0 if the board is not TRB) - my $mode = &getTRBResolutionMode($TDCsettings_href, lc($addr)); - - my $outdata = sprintf("%19s %6s %6s %4s", $uid, $addr, $subevtid, $mode); - - print "data2ora: $outdata\n" if($opt_ora eq "file" && $opt_verb); - print FILE "$outdata\n" if($opt_ora eq "file"); - - #- If mode == 0x00 it not necessary to write these zeros to the register - # because '00' is the default value of the register. - unless( $mode eq "NULL" || $mode == 0 ){ - my $cmd = "/home/hadaq/scripts/set_modrc.sh 0x$mode 0x$addr 0xa0c2"; - #my $host = @{$trb_href->{"scs"}}[0]; # CTS Etrax name; - my $host = "hadesp31"; # pexor slow control interface; - my $log = $log_dir . "/mode/modrc_" . $host . ".log"; - &connectCmdServer($cmd, $host, $cmd_server_port, $cmd_server_prtcl, $log); - } + if ( any { lc($_) eq lc($addr) } @subEvtIds ) { + $subevtid = lc($addr); } - - if( defined $data2ora_href->{"MDC"}->{"THRESH_VERS"} ){ - my $var = $data2ora_href->{"MDC"}->{"THRESH_VERS"}; - print FILE "mdc_thresh_version $var\n" if($opt_ora eq "file"); + else { + $subevtid = "NULL"; } - if( defined $data2ora_href->{"MDC"}->{"TDCMASK_VERS"} ){ - my $var = $data2ora_href->{"MDC"}->{"TDCMASK_VERS"}; - print FILE "mdc_tdcmask_version $var\n" if($opt_ora eq "file"); - } + #- Get TRB resolution mode (returns 0 if the board is not TRB) + my $mode = &getTRBResolutionMode( $TDCsettings_href, lc($addr) ); - if( defined $data2ora_href->{"RICH"}->{"THRESH_VERS"} ){ - my $var = $data2ora_href->{"RICH"}->{"THRESH_VERS"}; - print FILE "rich_thresh_version $var\n" if($opt_ora eq "file"); - } + my $outdata = sprintf( "%19s %6s %6s %4s", $uid, $addr, $subevtid, $mode ); - close( FILE ) or die "Could not close $ora_file: $!" if($opt_ora eq "file"); + print "data2ora: $outdata\n" if ( $opt_ora eq "file" && $opt_verb ); + print FILE "$outdata\n" if ( $opt_ora eq "file" ); - system("cp $ora_file $current_file") if($opt_ora eq "file"); -} + #- If mode == 0x00 it not necessary to write these zeros to the register + # because '00' is the default value of the register. + unless ( $mode eq "NULL" || $mode == 0 ) { + my $cmd = "/home/hadaq/scripts/set_modrc.sh 0x$mode 0x$addr 0xa0c2"; -sub readTRBTDCsettings() -{ - #-------- Read TRB TDC settings - my $config_file = "/var/diskless/etrax_fs/trbtdctools/config/TRB_TDC_settings.conf"; + #my $host = @{$trb_href->{"scs"}}[0]; # CTS Etrax name; + my $host = "hadesp31"; # pexor slow control interface; + my $log = $log_dir . "/mode/modrc_" . $host . ".log"; + &connectCmdServer( $cmd, $host, $cmd_server_port, $cmd_server_prtcl, $log ); + } + } - my $TDCsettings_href; + if ( defined $data2ora_href->{"MDC"}->{"THRESH_VERS"} ) { + my $var = $data2ora_href->{"MDC"}->{"THRESH_VERS"}; + print FILE "mdc_thresh_version $var\n" if ( $opt_ora eq "file" ); + } - unless( $TDCsettings_href = do $config_file ){ - die "Couldn't parse $config_file: $@, stopped" if $@; - die "Couldn't do $config_file: $!, stopped" unless defined $TDCsettings_href; - die "Couldn't run $config_file, stopped" unless $TDCsettings_href; - } + if ( defined $data2ora_href->{"MDC"}->{"TDCMASK_VERS"} ) { + my $var = $data2ora_href->{"MDC"}->{"TDCMASK_VERS"}; + print FILE "mdc_tdcmask_version $var\n" if ( $opt_ora eq "file" ); + } + + if ( defined $data2ora_href->{"RICH"}->{"THRESH_VERS"} ) { + my $var = $data2ora_href->{"RICH"}->{"THRESH_VERS"}; + print FILE "rich_thresh_version $var\n" if ( $opt_ora eq "file" ); + } - return $TDCsettings_href; + close(FILE) or die "Could not close $ora_file: $!" if ( $opt_ora eq "file" ); + + system("cp $ora_file $current_file") if ( $opt_ora eq "file" ); } -sub getTRBResolutionMode() -{ - my ($TDCsettings_href, $addr) = @_; +sub readTRBTDCsettings() { - my $mode; + #-------- Read TRB TDC settings + my $config_file = "/var/diskless/etrax_fs/trbtdctools/config/TRB_TDC_settings.conf"; - my $board_type; - my $board_sysType; - &boardSysType(lc($addr), \$board_type, \$board_sysType); + my $TDCsettings_href; - if( $board_type eq "TRB" && $board_sysType ne "CTS" && (&excludeBoards($addr)) ){ - my $serial = &addr2serial(lc($addr)); - $mode = &resMode($TDCsettings_href, $serial); - } - else{ - $mode = "NULL"; - } + unless ( $TDCsettings_href = do $config_file ) { + die "Couldn't parse $config_file: $@, stopped" if $@; + die "Couldn't do $config_file: $!, stopped" unless defined $TDCsettings_href; + die "Couldn't run $config_file, stopped" unless $TDCsettings_href; + } - return $mode; + return $TDCsettings_href; } -sub resMode() -{ - my ($TDCsettings_href, $serial) = @_; +sub getTRBResolutionMode() { + my ( $TDCsettings_href, $addr ) = @_; - my $trbname = sprintf("TRB_%03d", $serial); + my $mode; - my $mrcc_a = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_A'}->{'mode_rc_compression'}; - my $mrc_a = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_A'}->{'mode_rc'}; - my $mrcc_b = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_B'}->{'mode_rc_compression'}; - my $mrc_b = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_B'}->{'mode_rc'}; - my $mrcc_c = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_C'}->{'mode_rc_compression'}; - my $mrc_c = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_C'}->{'mode_rc'}; - my $mrcc_d = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_D'}->{'mode_rc_compression'}; - my $mrc_d = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_D'}->{'mode_rc'}; + my $board_type; + my $board_sysType; + &boardSysType( lc($addr), \$board_type, \$board_sysType ); - my $mode_undefined = 0; + if ( $board_type eq "TRB" && $board_sysType ne "CTS" && ( &excludeBoards($addr) ) ) { + my $serial = &addr2serial( lc($addr) ); + $mode = &resMode( $TDCsettings_href, $serial ); + } + else { + $mode = "NULL"; + } - unless( defined $mrcc_a ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_A: mode_rc_compression is not defined! Exit.\n"; - } - unless( defined $mrc_a ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_A: mode_rc is not defined! Exit.\n"; - } - unless( defined $mrcc_b ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_B: mode_rc_compression is not defined! Exit.\n"; - } - unless( defined $mrc_b ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_B: mode_rc is not defined! Exit.\n"; - } - unless( defined $mrcc_c ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_C: mode_rc_compression is not defined! Exit.\n"; - } - unless( defined $mrc_c ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_C: mode_rc is not defined! Exit.\n"; - } - unless( defined $mrcc_d ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_D: mode_rc_compression is not defined! Exit.\n"; - } - unless( defined $mrc_d ){ - $mode_undefined = 1; - print "ERROR: $trbname, TDC_D: mode_rc is not defined! Exit.\n"; - } - - #- All four TDCs must have identical modes - unless( $mode_undefined ){ - unless( $mrcc_a == $mrcc_b && $mrcc_a == $mrcc_c && $mrcc_a == $mrcc_d && - $mrc_a == $mrc_b && $mrc_a == $mrc_c && $mrc_a == $mrc_d ){ - print "ERROR: $trbname, resolution modes must be identical for all four TDCs! Exit.\n"; - } - } - - if( $mode_undefined ){ - exit(1); - } - - # Description of the resolution modes: - # - # mrcc = mode_rc_compression - # mrc = mode_rc - # - # mrcc mrc mode - # 0 0 00 - high resolution mode (100ps binning) - # 1 1 01 - very high resolution mode (25ps binning) - # 0 1 02 - very high resolution mode calibration data - # (one hit produces 4 data words like in high resolution mode) - - my $mode; - - if( $mrcc_a eq "0" && $mrc_a eq "0" ){ - $mode = "00"; - } - elsif( $mrcc_a eq "1" && $mrc_a eq "1" ){ - $mode = "01"; - } - elsif( $mrcc_a eq "0" && $mrc_a eq "1" ){ - $mode = "02"; - } - else{ - print "ERROR: $trbname, resolution modes have wrong values! Exit.\n"; - } + return $mode; +} - return $mode; +sub resMode() { + my ( $TDCsettings_href, $serial ) = @_; + + my $trbname = sprintf( "TRB_%03d", $serial ); + + my $mrcc_a = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_A'}->{'mode_rc_compression'}; + my $mrc_a = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_A'}->{'mode_rc'}; + my $mrcc_b = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_B'}->{'mode_rc_compression'}; + my $mrc_b = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_B'}->{'mode_rc'}; + my $mrcc_c = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_C'}->{'mode_rc_compression'}; + my $mrc_c = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_C'}->{'mode_rc'}; + my $mrcc_d = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_D'}->{'mode_rc_compression'}; + my $mrc_d = $TDCsettings_href->{$trbname}->{'TDC'}->{'TDC_D'}->{'mode_rc'}; + + my $mode_undefined = 0; + + unless ( defined $mrcc_a ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_A: mode_rc_compression is not defined! Exit.\n"; + } + unless ( defined $mrc_a ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_A: mode_rc is not defined! Exit.\n"; + } + unless ( defined $mrcc_b ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_B: mode_rc_compression is not defined! Exit.\n"; + } + unless ( defined $mrc_b ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_B: mode_rc is not defined! Exit.\n"; + } + unless ( defined $mrcc_c ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_C: mode_rc_compression is not defined! Exit.\n"; + } + unless ( defined $mrc_c ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_C: mode_rc is not defined! Exit.\n"; + } + unless ( defined $mrcc_d ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_D: mode_rc_compression is not defined! Exit.\n"; + } + unless ( defined $mrc_d ) { + $mode_undefined = 1; + print "ERROR: $trbname, TDC_D: mode_rc is not defined! Exit.\n"; + } + + #- All four TDCs must have identical modes + unless ($mode_undefined) { + unless ( $mrcc_a == $mrcc_b + && $mrcc_a == $mrcc_c + && $mrcc_a == $mrcc_d + && $mrc_a == $mrc_b + && $mrc_a == $mrc_c + && $mrc_a == $mrc_d ) + { + print "ERROR: $trbname, resolution modes must be identical for all four TDCs! Exit.\n"; + } + } + + if ($mode_undefined) { + exit(1); + } + + # Description of the resolution modes: + # + # mrcc = mode_rc_compression + # mrc = mode_rc + # + # mrcc mrc mode + # 0 0 00 - high resolution mode (100ps binning) + # 1 1 01 - very high resolution mode (25ps binning) + # 0 1 02 - very high resolution mode calibration data + # (one hit produces 4 data words like in high resolution mode) + + my $mode; + + if ( $mrcc_a eq "0" && $mrc_a eq "0" ) { + $mode = "00"; + } + elsif ( $mrcc_a eq "1" && $mrc_a eq "1" ) { + $mode = "01"; + } + elsif ( $mrcc_a eq "0" && $mrc_a eq "1" ) { + $mode = "02"; + } + else { + print "ERROR: $trbname, resolution modes have wrong values! Exit.\n"; + } + + return $mode; } -sub addr2serial() -{ - my ($addr) = @_; +sub addr2serial() { + my ($addr) = @_; - my $serial; - - my $addr_hex = "0x" . lc($addr); + my $serial; - foreach my $key ( keys %$addr_db_conf_href ){ - if( $addr_db_conf_href->{$key}->{'addr'} eq $addr_hex ){ - unless( defined $addr_db_conf_href->{$key}->{'serial'} ){ - next; - } + my $addr_hex = "0x" . lc($addr); - $serial = $addr_db_conf_href->{$key}->{'serial'}; - last; - } - } + foreach my $key ( keys %$addr_db_conf_href ) { + if ( $addr_db_conf_href->{$key}->{'addr'} eq $addr_hex ) { + unless ( defined $addr_db_conf_href->{$key}->{'serial'} ) { + next; + } - unless( defined $serial ){ - print "ERROR: addr2serial(): unknown serial number for address $addr. Exit.\n"; - exit(1); + $serial = $addr_db_conf_href->{$key}->{'serial'}; + last; } + } + + unless ( defined $serial ) { + print "ERROR: addr2serial(): unknown serial number for address $addr. Exit.\n"; + exit(1); + } - return $serial; + return $serial; } -sub checkShowerNORPC() -{ - my ($trb) = @_; +sub checkShowerNORPC() { + my ($trb) = @_; - my $retVal = 0; + my $retVal = 0; - unless(defined $trb_href->{'rpc'}){ - if(any {$trb eq $_} @{$trb_href->{'shower'}}){ - $retVal = 1; - } + unless ( defined $trb_href->{'rpc'} ) { + if ( any { $trb eq $_ } @{ $trb_href->{'shower'} } ) { + $retVal = 1; } + } - return $retVal; + return $retVal; } -sub serial2addrAndSysType() -{ - my ($serial, $board_type) = @_; - - # There is no direct connection between serial number - # and TRB-Net address. One should provide board type - # in addition to serial number. +sub serial2addrAndSysType() { + my ( $serial, $board_type ) = @_; - my $addr; - my $bType; - my $bSysType; - - foreach my $key ( keys %$addr_db_conf_href ){ - next unless( defined $addr_db_conf_href->{$key}->{'serial'} ); - next unless( defined $addr_db_conf_href->{$key}->{'trb'} ); - - if( $addr_db_conf_href->{$key}->{'serial'} == $serial && - $addr_db_conf_href->{$key}->{'serial'} == $addr_db_conf_href->{$key}->{'trb'} ){ - unless( defined $addr_db_conf_href->{$key}->{'addr'} ){ - next; - } + # There is no direct connection between serial number + # and TRB-Net address. One should provide board type + # in addition to serial number. - $addr = $addr_db_conf_href->{$key}->{'addr'}; + my $addr; + my $bType; + my $bSysType; - &boardSysType($addr, \$bType, \$bSysType); + #print Dumper $addr_db_conf_href; + #exit; - next unless($bType eq $board_type); + foreach my $key ( keys %$addr_db_conf_href ) { + next unless ( defined $addr_db_conf_href->{$key}->{'serial'} ); + next unless ( defined $addr_db_conf_href->{$key}->{'trb'} ); - last; - } - } + # if ( $addr_db_conf_href->{$key}->{'serial'} == $serial + # && $addr_db_conf_href->{$key}->{'serial'} == $addr_db_conf_href->{$key}->{'trb'} ) + if ( $addr_db_conf_href->{$key}->{'trb'} == $serial ) { + unless ( defined $addr_db_conf_href->{$key}->{'addr'} ) { + next; + } - unless( defined $addr ){ - print "ERROR: serial2addr(): unknown address for serial number $serial.\n"; - #exit(1); - } - - unless( defined $bSysType ){ - print "ERROR: serial2addr(): unknown board system type for serial number $serial.\n"; - #exit(1); - } - - my $retval = ""; - if( defined $addr && defined $bSysType ){ - $retval = "addr: $addr type: $bSysType"; - } - - return $retval; -} + $addr = $addr_db_conf_href->{$key}->{'addr'}; -sub excludeBoards() -{ - my ($addr) = @_; + &boardSysType( $addr, \$bType, \$bSysType ); - # This subroutine excludes boards which have unused TDCs - # and those TDCs must not be configured. Moreover the corresponding - # register should not be overwritten with TDC resoltuion mode value. + next unless ( $bType eq $board_type ); - # Exclude all CTS and SCS boards - my $board_sys; - my $retval = 1; - - foreach my $sys ( keys %$addressRange_href ){ - my $addr_min = lc($addressRange_href->{$sys}->{'MIN'}); - my $addr_max = lc($addressRange_href->{$sys}->{'MAX'}); - - if( hex(lc($addr)) >= hex($addr_min) && hex(lc($addr)) <= hex($addr_max) ){ - $board_sys = $addressRange_href->{$sys}; - last; - } + last; } + } - unless( defined $board_sys ){ - print "TRB-Net address $addr is outside of the known address ranges! Exit.\n"; - exit(0); - } + unless ( defined $addr ) { + print "ERROR: serial2addr(): unknown address for serial number $serial.\n"; - if( $board_sys eq "CTS" || $board_sys eq "SCS" ){ - $retval = 0; - } + #exit(1); + } - return $retval; -} + unless ( defined $bSysType ) { + print "ERROR: serial2addr(): unknown board system type for serial number $serial.\n"; -sub boardSysType() -{ - my ($addr, $bType_ref, $bSysType_ref) = @_; - - foreach my $sys ( keys %$addressRange_href ){ - my $addr_min = lc($addressRange_href->{$sys}->{'MIN'}); - my $addr_max = lc($addressRange_href->{$sys}->{'MAX'}); + #exit(1); + } - if( hex(lc($addr)) >= hex($addr_min) && hex(lc($addr)) <= hex($addr_max) ){ - $$bType_ref = $addressRange_href->{$sys}->{'TYPE'}; - $$bSysType_ref = $sys; - last; - } - } - - unless( defined $$bType_ref ){ - print "ERROR: boardSysType(): unknown board type for address $addr.\n"; - $$bType_ref = "undef"; - } + my $retval = ""; + if ( defined $addr && defined $bSysType ) { + $retval = "addr: $addr type: $bSysType"; + } - unless( defined $$bSysType_ref ){ - print "ERROR: boardSysType(): unknown board system type for address $addr.\n"; - $$bSysType_ref = "undef"; - } + return $retval; } -sub boardType() -{ - my ($addr) = @_; +sub excludeBoards() { + my ($addr) = @_; - my $board_type; + # This subroutine excludes boards which have unused TDCs + # and those TDCs must not be configured. Moreover the corresponding + # register should not be overwritten with TDC resoltuion mode value. - foreach my $sys ( keys %$addressRange_href ){ - my $addr_min = lc($addressRange_href->{$sys}->{'MIN'}); - my $addr_max = lc($addressRange_href->{$sys}->{'MAX'}); + # Exclude all CTS and SCS boards + my $board_sys; + my $retval = 1; - if( hex(lc($addr)) >= hex($addr_min) && hex(lc($addr)) <= hex($addr_max) ){ - $board_type = $addressRange_href->{$sys}->{'TYPE'}; - last; - } - } + foreach my $sys ( keys %$addressRange_href ) { + my $addr_min = lc( $addressRange_href->{$sys}->{'MIN'} ); + my $addr_max = lc( $addressRange_href->{$sys}->{'MAX'} ); - unless( defined $board_type ){ - print "ERROR: boardType(): unknown board type for address $addr. Exit.\n"; - exit(1); + if ( hex( lc($addr) ) >= hex($addr_min) && hex( lc($addr) ) <= hex($addr_max) ) { + $board_sys = $addressRange_href->{$sys}; + last; } + } - return $board_type; -} + unless ( defined $board_sys ) { + print "TRB-Net address $addr is outside of the known address ranges! Exit.\n"; + exit(0); + } -sub timeStamp() -{ - my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($seconds1); - my $timestamp = sprintf("%4d-%02d-%02d_%02d.%02d.%02d", - $year+1900, $mon+1, $mday, $hour, $min, $sec); + if ( $board_sys eq "CTS" || $board_sys eq "SCS" ) { + $retval = 0; + } - return $timestamp; + return $retval; } -sub scanLogs() -{ - #- Check the log files which were created - # after DAQ restart (after $seconds) +sub boardSysType() { + my ( $addr, $bType_ref, $bSysType_ref ) = @_; - opendir(DIR, $log_dir) or die "Could not open $log_dir: $!";; - my @logfile_list = grep(/^log/, readdir(DIR)); - closedir(DIR); + foreach my $sys ( keys %$addressRange_href ) { + my $addr_min = lc( $addressRange_href->{$sys}->{'MIN'} ); + my $addr_max = lc( $addressRange_href->{$sys}->{'MAX'} ); - #- Sort files by modification date - @logfile_list = sort { -M "$log_dir/$a" <=> -M "$log_dir/$b" } (@logfile_list); + if ( hex( lc($addr) ) >= hex($addr_min) && hex( lc($addr) ) <= hex($addr_max) ) { + $$bType_ref = $addressRange_href->{$sys}->{'TYPE'}; + $$bSysType_ref = $sys; + last; + } + } - my $errorFound = 0; + unless ( defined $$bType_ref ) { + print "ERROR: boardSysType(): unknown board type for address $addr.\n"; + $$bType_ref = "undef"; + } - foreach my $file (@logfile_list){ + unless ( defined $$bSysType_ref ) { + print "ERROR: boardSysType(): unknown board system type for address $addr.\n"; + $$bSysType_ref = "undef"; + } +} - #- Modification date in seconds since EPOCH - my $seconds2 = (stat "$log_dir/$file")[9]; +sub boardType() { + my ($addr) = @_; - if( $seconds2 > $seconds1 ){ - if(&scanLogFile("$log_dir/$file")){ - $errorFound = 1; - } - } - } + my $board_type; + + foreach my $sys ( keys %$addressRange_href ) { + my $addr_min = lc( $addressRange_href->{$sys}->{'MIN'} ); + my $addr_max = lc( $addressRange_href->{$sys}->{'MAX'} ); - if($errorFound){ - &askUser(); + if ( hex( lc($addr) ) >= hex($addr_min) && hex( lc($addr) ) <= hex($addr_max) ) { + $board_type = $addressRange_href->{$sys}->{'TYPE'}; + last; } + } + + unless ( defined $board_type ) { + print "ERROR: boardType(): unknown board type for address $addr. Exit.\n"; + exit(1); + } - #- Update time. - # We want to look only at the log files - # which were not checked before. - $seconds1 = time; + return $board_type; } -sub scanLogFile() -{ - my ($logFile) = @_; +sub timeStamp() { + my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime($seconds1); + my $timestamp = sprintf( "%4d-%02d-%02d_%02d.%02d.%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec ); - my $retval = 0; + return $timestamp; +} - open(DAT, $logFile) || die("Could not open $logFile!"); - my @log_data = ; - close(DAT); +sub scanLogs() { - if( any {$_ =~ /TX Busy/} @log_data ){ - print "Found \'TX Busy\' in $logFile. Press Ctrl-C and try again!\n"; - system("logger -p local1.info -t DAQ STARTUP \\ Found \'TX Busy\' in $logFile"); - $retval = 1; - } + #- Check the log files which were created + # after DAQ restart (after $seconds) - if( any {$_ =~ /Verification Failure/} @log_data ){ - print "Found \'Verification Failure\' in $logFile. Problem with jam-programming?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ Found \'Verification Failure\' in $logFile"); - $retval = 1; - } + opendir( DIR, $log_dir ) or die "Could not open $log_dir: $!"; + my @logfile_list = grep( /^log/, readdir(DIR) ); + closedir(DIR); - if( any {$_ =~ /Fifo not empty/} @log_data ){ - print "Found \'Fifo not empty\' in $logFile. Problem with TRB-Net?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'Fifo not empty\' in $logFile"); - $retval = 1; - } + #- Sort files by modification date + @logfile_list = sort { -M "$log_dir/$a" <=> -M "$log_dir/$b" } (@logfile_list); - if( any {$_ =~ /command not found/} @log_data ){ - print "Found \'command not found\' in $logFile. Problem with environment settings?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'command not found\' in $logFile"); - $retval = 1; - } + my $errorFound = 0; - if( any {$_ =~ /file not found/} @log_data ){ - print "Found \'file not found\' in $logFile. Problem with environment settings?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'file not found\' in $logFile"); - $retval = 1; - } + foreach my $file (@logfile_list) { - if( any {$_ =~ /No such file or directory/} @log_data ){ - print "Found \'No such file or directory\' in $logFile. Problem with missing file?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'No such file or directory\' in $logFile"); - $retval = 1; - } + #- Modification date in seconds since EPOCH + my $seconds2 = ( stat "$log_dir/$file" )[9]; - if( any {$_ =~ /Permission denied/} @log_data ){ - print "Found \'Permission denied\' in $logFile. Problem with permission settings?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'Permission denied\' in $logFile"); - $retval = 1; + if ( $seconds2 > $seconds1 ) { + if ( &scanLogFile("$log_dir/$file") ) { + $errorFound = 1; + } } - if( any {$_ =~ /RPC/} @log_data ){ - print "Found \'Remote Procedure Call (RPC) Error\' in $logFile. Problem with trbnet deamon?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'Remote Procedure Call (RPC) Error\' in $logFile"); - $retval = 1; - } - if( any {$_ =~ /(DMA|SEMAPHORE|PEXOR)/i} @log_data ){ - print "Found \'DMA/Semaphore/Pexor Error\' in $logFile. Problem with PEXOR?\n"; - system("logger -p local1.info -t DAQ STARTUP \\ \'Logfile shows DMA/Semaphore/Pexor Error\' in $logFile"); - $retval = 1; - } + } - return $retval; + if ($errorFound) { + &askUser(); + } + + #- Update time. + # We want to look only at the log files + # which were not checked before. + $seconds1 = time; } -sub forkStatusServer() -{ - my $child = fork(); +sub scanLogFile() { + my ($logFile) = @_; + + my $retval = 0; + + open( DAT, $logFile ) || die("Could not open $logFile!"); + my @log_data = ; + close(DAT); + + if ( any { $_ =~ /TX Busy/ } @log_data ) { + print "Found \'TX Busy\' in $logFile. Press Ctrl-C and try again!\n"; + system("logger -p local1.info -t DAQ STARTUP \\ Found \'TX Busy\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /Verification Failure/ } @log_data ) { + print "Found \'Verification Failure\' in $logFile. Problem with jam-programming?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ Found \'Verification Failure\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /Fifo not empty/ } @log_data ) { + print "Found \'Fifo not empty\' in $logFile. Problem with TRB-Net?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'Fifo not empty\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /command not found/ } @log_data ) { + print "Found \'command not found\' in $logFile. Problem with environment settings?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'command not found\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /file not found/ } @log_data ) { + print "Found \'file not found\' in $logFile. Problem with environment settings?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'file not found\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /No such file or directory/ } @log_data ) { + print "Found \'No such file or directory\' in $logFile. Problem with missing file?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'No such file or directory\' in $logFile"); + $retval = 1; + } + + if ( any { $_ =~ /Permission denied/ } @log_data ) { + print "Found \'Permission denied\' in $logFile. Problem with permission settings?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'Permission denied\' in $logFile"); + $retval = 1; + } + if ( any { $_ =~ /RPC/ } @log_data ) { + print "Found \'Remote Procedure Call (RPC) Error\' in $logFile. Problem with trbnet deamon?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'Remote Procedure Call (RPC) Error\' in $logFile"); + $retval = 1; + } + if ( any { $_ =~ /(DMA|SEMAPHORE|PEXOR)/i } @log_data ) { + print "Found \'DMA/Semaphore/Pexor Error\' in $logFile. Problem with PEXOR?\n"; + system("logger -p local1.info -t DAQ STARTUP \\ \'Logfile shows DMA/Semaphore/Pexor Error\' in $logFile"); + $retval = 1; + } + + return $retval; +} - if( $child ){ # parent - } - elsif( $child == 0 ) { # child - &statusServer(); - exit(0); # exit child - } - else{ - print "Could not fork statusServer: $!\n"; - exit(1); - } +sub forkStatusServer() { + my $child = fork(); + + if ($child) { # parent + } + elsif ( $child == 0 ) { # child + &statusServer(); + exit(0); # exit child + } + else { + print "Could not fork statusServer: $!\n"; + exit(1); + } - return $child; + return $child; } -sub statusServer() -{ - - #- socket for broadcast - my $sock_udp = IO::Socket::INET->new(PeerPort => 1960, - PeerAddr => "192.168.103.255", - Proto => 'udp', - LocalAddr => "192.168.100.50", - Broadcast => 1, - Reuse => 1) - or return;#or die "Can't bind : $@\n"; - - #- Inform all clients that DAQ is being restarted - $sock_udp->send("STARTING") or die("Socket send error $!"); - close($sock_udp); - - #- Start TCP server -my $sock; -# my $sock = new IO::Socket::INET( LocalAddr => "192.168.100.50", -# LocalPort => 1972, -# Proto => 'tcp', -# Listen => SOMAXCONN, -# Reuse => 1); +sub statusServer() { - $sock or return; #die "Cannot bind socket :$!"; + #- socket for broadcast + my $sock_udp = IO::Socket::INET->new( + PeerPort => 1960, + PeerAddr => "192.168.103.255", + Proto => 'udp', + LocalAddr => "192.168.100.50", + Broadcast => 1, + Reuse => 1 + ) or return; #or die "Can't bind : $@\n"; - STDOUT->autoflush(1); + #- Inform all clients that DAQ is being restarted + $sock_udp->send("STARTING") or die("Socket send error $!"); + close($sock_udp); - my($new_sock, $buf); + #- Start TCP server + my $sock; - my $selector = new IO::Select( $sock ); + # my $sock = new IO::Socket::INET( LocalAddr => "192.168.100.50", + # LocalPort => 1972, + # Proto => 'tcp', + # Listen => SOMAXCONN, + # Reuse => 1); - while(1) { + $sock or return; #die "Cannot bind socket :$!"; - # wait 3 seconds for connections - while (my @file_handles = $selector->can_read( 3 )) { + STDOUT->autoflush(1); - foreach my $file_handle (@file_handles) { + my ( $new_sock, $buf ); - if($file_handle == $sock) { + my $selector = new IO::Select($sock); - # create a new socket for this transaction - unless (defined( $new_sock = $sock->accept() )) - { - print "statusServer: ERROR - Cannot open socket to send status!\n"; - return; - } + while (1) { - while (defined($buf = <$new_sock>)) { - #print "client asked: $buf"; - if($buf =~ /MON_HUB: STILL STARTING\?/){ - $new_sock->send("STARTING\n") or die("Socket send error $!"); - } + # wait 3 seconds for connections + while ( my @file_handles = $selector->can_read(3) ) { - unless( kill(0, $parent_pid) ){ - print "Exit status server thread.\n"; - close( $new_sock ); - close( $sock ); - exit(0); - } - } + foreach my $file_handle (@file_handles) { - close( $new_sock ); - } + if ( $file_handle == $sock ) { + + # create a new socket for this transaction + unless ( defined( $new_sock = $sock->accept() ) ) { + print "statusServer: ERROR - Cannot open socket to send status!\n"; + return; + } + + while ( defined( $buf = <$new_sock> ) ) { + + #print "client asked: $buf"; + if ( $buf =~ /MON_HUB: STILL STARTING\?/ ) { + $new_sock->send("STARTING\n") or die("Socket send error $!"); } - unless( kill(0, $parent_pid) ){ - print "Exit status server thread.\n"; - close( $sock ); - exit(0); - } - } + unless ( kill( 0, $parent_pid ) ) { + print "Exit status server thread.\n"; + close($new_sock); + close($sock); + exit(0); + } + } - unless( kill(0, $parent_pid) ){ - print "Exit status server thread.\n"; - close( $sock ); - exit(0); + close($new_sock); } + } + + unless ( kill( 0, $parent_pid ) ) { + print "Exit status server thread.\n"; + close($sock); + exit(0); + } + } + + unless ( kill( 0, $parent_pid ) ) { + print "Exit status server thread.\n"; + close($sock); + exit(0); } + } } -sub closeEBs() -{ - print "Kill EBs..."; - system("cd ../evtbuild/; ./start_eb_gbe.pl -e stop -n 1-16"); - print "\n"; +sub closeEBs() { + print "Kill EBs..."; + system("cd ../evtbuild/; ./start_eb_gbe.pl -e stop -n 1-16"); + print "\n"; } -sub startEBs() -{ - print "Start EBs...\n"; - system("cd ../evtbuild/; ./start_eb_gbe.sh"); - print "\n"; +sub startEBs() { + print "Start EBs...\n"; + system("cd ../evtbuild/; ./start_eb_gbe.sh"); + print "\n"; } -- 2.43.0