few changes during beamtime

diff --git a/dmon/code/Perl2Epics.pm b/dmon/code/Perl2Epics.pm
index 98ab27f1b30ff44e45a29e33438974d368df71d3..9b354218f6db4a29c481c5bbd40d039ee488bb83 100644 (file)
--- a/dmon/code/Perl2Epics.pm
+++ b/dmon/code/Perl2Epics.pm
@@ -7,6 +7,7 @@ use Data::Dumper;
 #Add all possible paths here...
 use lib '/home/hadaq/EPICS/base-3.14.12.3/lib/perl';
 use lib '/mnt/home_cbm02/hadaq/EPICS/base-3.14.12.3/lib/perl';
+use lib '/home/hadaq/EPICS/EPICS-3.15.6/base/lib/perl';
 use CA;
 
 # Address list for Epics IOCs. Don't remove unused values

diff --git a/thresholds/thr2flash.pl b/thresholds/thr2flash.pl
index 46d28c8df0bf446078d244380eb7415dad4b488f..4277ae9bb0f66fd10d6949235d7e8200898a4caa 100755 (executable)
--- a/thresholds/thr2flash.pl
+++ b/thresholds/thr2flash.pl
@@ -13,20 +13,23 @@ if (!defined &trb_init_ports()) {
 
 my $dirich = trb_register_read(0xfe51,0x0);
 
-foreach my $b (keys $dirich) {
+my $cnt = 1;
+foreach my $b (keys %{$dirich}) {
   my $addr = sprintf("0x%x",$b);
   writeThr2Flash($addr);
+  $cnt++;
+#  sleep 5 unless ($cnt%20)
 }
 #print Dumper $dirich;
 
 
 sub writeThr2Flash {
-  my $addr = @_;
+  my $addr = shift @_;
   print $addr."...";
 
-  my $str =  qx(/home/hadaq/trbsoft/daqtools/tools/spi_slave.pl  -e=$addr -c=0 -flashcmd=8 -x=memtoflash --range '0x0..0xf');
+  system("/home/hadaq/trbsoft/daqtools/tools/spi_slave.pl  -e=$addr -c=0 -flashcmd=8 -x=memtoflash --range '0x0..0xf' &");
   #print $str."\n";
-  $str    =  qx(/home/hadaq/trbsoft/daqtools/tools/spi_slave.pl  -e=$addr -c=1 -flashcmd=8 -x=memtoflash --range '0x0..0xf');
+  system("/home/hadaq/trbsoft/daqtools/tools/spi_slave.pl  -e=$addr -c=1 -flashcmd=8 -x=memtoflash --range '0x0..0xf' &" );
   #print $str."\n";
   print "done!\n"; 
 }

diff --git a/tools/HPlot.pm b/tools/HPlot.pm
index 4f1087e4d7d6041559bb339856e2a681b7ebbe76..01565f17af2d4bf0f397e2dc49a8531ddabd00d0 100755 (executable)
--- a/tools/HPlot.pm
+++ b/tools/HPlot.pm
@@ -56,7 +56,7 @@ sub PlotInit {
 
   my $name      = $c->{name};
 
-  my $fn = "gnuplot";
+  my $fn = "gnuplot 2>1";
   #my $fh = new FileHandle ("|$fn") or  die "error: no gnuplot";
   open my $fh, "|$fn" or  die "error: no gnuplot";
   $fh->autoflush(1);

diff --git a/users/frankfurt_test/trb3scadc.pl b/users/frankfurt_test/trb3scadc.pl
index 2bf8a9c265a8f332b10f40c4c75fd7a15d82c869..e257196729638c53a3b7966494e605c64bca73f8 100755 (executable)
--- a/users/frankfurt_test/trb3scadc.pl
+++ b/users/frankfurt_test/trb3scadc.pl
@@ -20,7 +20,7 @@ my $t = [['mV (3.3)','mV (2.5)','mV (1.2)','mV (6)'],
          ['mV (3.3)','mV (2.5)','mV (1.2)','mV (1.1)'],
          ['mA (@1.1)','mA (@1.2)','mA (@2.5)','mA (@3.3)'],
          ['mV (5)','mV (1.1)','mV (2.5)','mV (3.3)']];
-my $channel = [7,7,7,6,5,7]; #SPI interface number
+my $channel = [7,7,7,6,6,7]; #SPI interface number -  777657 would be right 
 
 #1:4V, 2:2V, 3:1V
 my $resolution = [[2,1,2,1],  [2,2,2,1],  [2,2,2,4],      [2,2,2,2],       [3,3,2,2],        [1,2,1,2]];
@@ -34,6 +34,7 @@ print "\nRunning in mode ".$modedesc->[$mode]."\n\n";
 system("trbcmd w $board 0xd41a 25");
 
 my $cmd; my $s;
+trb_register_write($board,0xd417,0x40) if($mode == 4);
 
 $cmd = 0xc1830000 + ($resolution->[$mode][0] << 25);
 $s = Dmon::PadiwaSendCmd($cmd,$board,$channel->[$mode]);
@@ -62,6 +63,9 @@ usleep(5000);
 $s = Dmon::PadiwaSendCmd(0,$board,$channel->[$mode]);
 printf("0x%08x\t%.2f °C\n",$s->{$board},(($s->{$board}>>19)&0xfff)/16.);
 
+trb_register_write($board,0xd417,0x0) if($mode == 4);
+
+
 #back to normal SPI speed
 system("trbcmd w $board 0xd41a 7");
 print "\n";

diff --git a/users/giessen_lab/showMagParserValues.pl b/users/giessen_lab/showMagParserValues.pl
index 3c9dbb333a0fd6e063d4148ae5937d4d2b759408..6c949d30f4a4b0d91552eafc6bbe270f47cb34c7 100755 (executable)
--- a/users/giessen_lab/showMagParserValues.pl
+++ b/users/giessen_lab/showMagParserValues.pl
@@ -8,8 +8,8 @@ use constant true  => 1;
 ##########################################
 #variables
 ##########################################
-my $boardAddress = 0x0201;
-my $numberOfBoards = 1;
+my $boardAddress = 0x0110;
+my $numberOfBoards = 6;
 my $numberOfSensors = 4;
 my $secondsToWaitBeforeNextPrint = 3;
 my $writeToFile = false;

diff --git a/web/htdocs/tools/pwr/pwr.pl b/web/htdocs/tools/pwr/pwr.pl
index 3a8af83f7154211de901fd3def64ea90ec87624a..a95002e7b92a0b64cf0f68e4a70f519b0141256b 100755 (executable)
--- a/web/htdocs/tools/pwr/pwr.pl
+++ b/web/htdocs/tools/pwr/pwr.pl
@@ -71,10 +71,10 @@ else {
 if(defined $isRemote) {
   my $env = $ENV{'QUERY_STRING'};
 #   $env =~ s/%20/ /g;
-  $env =~ s/&/!/g;
+  $env =~ s/&/\\!/g;
   my $cmd = "bash -c \"ssh $isRemote 'QUERY_STRING=".$env." perl'\" <htdocs/tools/pwr/pwr_remote.pl";
-#   system("ssh $isRemote 'QUERY_STRING=".$env." perl -v' ");
-#   print $cmd."\n";
+  system("ssh $isRemote 'QUERY_STRING=".$env." perl -v' ");
+  print $cmd."\n";
   print qx($cmd);
   }
 else {

diff --git a/xml-db/get.pl b/xml-db/get.pl
index 0cdcebbbb5b96c8a52136916a766a315a65ea650..cc3bdb6c9332564fde9f80ab4d9032a5eee1e52d 100755 (executable)
--- a/xml-db/get.pl
+++ b/xml-db/get.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 use HADES::TrbNet;
-use Storable qw(lock_store lock_retrieve);
+use Storable qw(lock_store retrieve lock_retrieve);
 use feature "switch";
 use Time::HiRes qw( time usleep );
 
@@ -129,7 +129,7 @@ foreach my $req (@request) {
     die "Could not parse name $name \n";
   }
 
-  $db = lock_retrieve($file);
+  $db = retrieve($file);
   die "Unable to read cache file\n" unless defined $db;
   die "Your cached database is outdated. Update by running xml-db.pl"
     unless exists $db->{'§EntityType'};

diff --git a/xml-db/put.pl b/xml-db/put.pl
index b16e8ec7186aa4e6cbe282258bac181baa394f92..a6bd596f1542f23e531cbb365c8d870eb39d3baf 100755 (executable)
--- a/xml-db/put.pl
+++ b/xml-db/put.pl
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use HADES::TrbNet;
-use Storable qw(lock_retrieve);
+use Storable qw(retrieve);
 use Time::HiRes qw( usleep );
 use feature "switch";
 
@@ -106,7 +106,7 @@ foreach my $req (@request) {
   elsif ($name =~ m/^([a-zA-Z0-9]+)$/)       {$name = $1; $slice = 0;}
   else {die "Could not parse name $name \n";}
 
-  $db = lock_retrieve($file);
+  $db = retrieve($file);
   die "Unable to read cache file\n" unless defined $db;
 
   die "Name not found in entity file\n" unless(exists $db->{$name});