From: Jan Michel <michel@physik.uni-frankfurt.de>
Date: Fri, 26 May 2023 13:34:26 +0000 (+0200)
Subject: add power functions to MDCPower instead of calls to mdc_powerboard.pl
X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=6d48414c3fa4a8630205cc82121bbc6eff126286;p=hades_mdc_settings.git

add power functions to MDCPower instead of calls to mdc_powerboard.pl
---

diff --git a/scripts/MDCPower.pm b/scripts/MDCPower.pm
index 17335c3..823fb60 100644
--- a/scripts/MDCPower.pm
+++ b/scripts/MDCPower.pm
@@ -7,8 +7,20 @@ use Data::Dumper;
 use Fcntl ':flock';
 use lib '.';
 use MDC;
+use IO::Socket;
+use IO::Handle;
+use Time::HiRes qw( usleep);
 
-
+my $powerboard_registers = {
+  'switch' => 0,
+  'adjust' => 1,
+  'vin' => 2,
+  'cin' => 3,   'curr' => 3,  'current' => 3,
+  'temp' => 4,
+  'info' => 5,
+  'ioffset' => 6,
+  'vout' => 7, 'volt' => 7, 'voltage' => 7
+  };
 
 
 ###############################################################################  
@@ -119,13 +131,98 @@ sub power_switch {
   
   my ($host,$board,$outp) = MDC::get_power_output($addr);
   return -1 unless defined $host && $board >= 0 && $outp >= 0;
-  
-
-  system("./mdc_powerboard.pl -d $host -b $board -o $outp -r switch -v 0") if($onoff == 0 || $onoff == 2);
+  my $ret = 0;
+  if($onoff == 0 || $onoff == 2) {
+    $ret = powerboard_command($host,$board,$outp,0,'switch',0);
+    print("Errorcode $ret\n") unless $ret == 1;
+    }
   sleep(1)  if($onoff == 2);
-  system("./mdc_powerboard.pl -d $host -b $board -o $outp -r switch -v 1") if($onoff == 1 || $onoff == 2);
+  if($onoff == 1 || $onoff == 2) {
+    $ret = powerboard_command($host,$board,$outp,0,'switch',1) ;
+    print("Errorcode $ret\n") unless $ret == 1;
+    }
+
   return 1;
   }
 
 
+  
+###############################################################################  
+#send a command to a powerboard 
+###############################################################################  
+sub powerboard_command {
+  my($host,$board,$output,$channel,$command,$value) = @_;
+  return -1 unless defined $host;
+  return -2 unless defined $board;
+  return -3 if ($board < -1 || $board > 3);
+  return -4 if ($output < 0 || $output > 3);
+  return -5 if ($channel < 0 || $channel > 1);
+  $command = $powerboard_registers->{lc($command)};
+  return -6 unless defined $command;
+  my $rw = (defined $value) ? 'W':'R';
+  $value //= 0;
+  
+  my $cmd = sprintf("%s%02x%01x%01x%01x%04x",$rw,$board&0xfF,$output,$channel,$command,$value&0xFFFF);
+  my $ret = powerboard_SendCmd($host,$cmd);
+  return -7 unless defined $ret;
+  return -8 unless length($ret)==10;
+  return -9 unless substr($ret,0,1) eq 'A';
+  
+  my $answ = hex(substr($ret,6));
+  
+  if($rw eq 'W' && $answ == 0x00d1) {
+    return 1;
+    }
+  elsif($rw == 1) {
+    return -10;
+    }
+  else {  
+    if($command == 0) { #Active
+      $ret = $answ & 1;
+      }  
+    if($command == 1) { #Level Select
+      $ret = $answ & 1;
+      }
+    if($command == 2) { #Input Voltage
+      $ret = ($answ&0xFFFF)*417/27*2.5/1000;
+      }
+    if($command == 3) { #Current
+      $ret = ($answ&0xFFF)/800.*2.5; # 800mV/A
+      }
+    if($command == 4 && $board == -1) { #Temperature PD
+      $ret = ($answ/100.);
+      }
+    if($command == 4 && $board >= 0) {  #Temperature
+      $ret = ((($answ&0x7FF)*2-250)/9.5)+25;
+      $ret = 255 if($ret <= 0) ;
+      }
+    if($command == 7) {
+      $ret = (($answ&0xFFFF)*2*2.5/1000);
+      }
+    }
+  return $ret;
+  }
+
+###############################################################################  
+#RX/TX subroutine. not to be called directly
+###############################################################################    
+sub powerboard_SendCmd {
+  my ($device,$c) = @_;
+  my $port = IO::Socket::INET->new(PeerAddr => $device, PeerPort => 2323, Proto => "tcp", Type => SOCK_STREAM, Timeout => 1, Blocking => 0) 
+              or return "Can't bind to $device: $@\n";  
+  $c .= "\n";
+  print $port  "$c";
+  my $x = "";
+  for my $i (0..20) {
+    $x .=  <$port>//'';
+    if($x && (substr($x,-1) eq "\n" || substr($x,-1) eq "\r" || length($x)>=10) ) {
+      chomp $x;
+      return $x;
+      }
+    usleep(10000);
+    }
+  return;
+  }
+   
+  
 1;