new script to control MDC power board

diff --git a/atmega32u4/dcdc_mdc/mdc_powerboard.pl b/atmega32u4/dcdc_mdc/mdc_powerboard.pl
new file mode 100755 (executable)
index 0000000..04a59e0
--- /dev/null
+++ b/atmega32u4/dcdc_mdc/mdc_powerboard.pl
@@ -0,0 +1,157 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use IO::Socket;
+use IO::Handle;
+use Fcntl;
+
+use Data::Dumper;
+use Time::HiRes qw( usleep);
+use Getopt::Long;
+
+my $device = "";
+my $help = 0;
+my $SEL_board;
+my $SEL_output;
+my $SEL_channel;
+my $SEL_register;
+my $SEL_value;
+my $SEL_rw = 0;
+
+my $registers = {
+  'switch' => 0,
+  'adjust' => 1,
+  'Vin' => 2,
+  'Cin' => 3,
+  'temp' => 4,
+  'info' => 5,
+  'Ioffset' => 6,
+  'Vout' => 7
+  };
+
+Getopt::Long::Configure(qw(gnu_getopt pass_through));
+GetOptions(
+           'help|h' => \$help,
+           'device|d=s' => \$device,
+           'board|b=i' => \$SEL_board,
+           'output|o=i' => \$SEL_output,
+           'channel|c=i' => \$SEL_channel,
+           'register|r=s' => \$SEL_register,
+           'value|v=i' => \$SEL_value,          
+          ) ;
+
+          
+if ($help || (defined $ARGV[0] && $ARGV[0] =~ /help/)) {
+    print "dcdc.pl -d DEVICE -b BOARD [-c CHANNEL] [-o OUTPUT] -r REGISTER [-v VALUE]\n";
+
+    print "DEVICE:    Network address of device\n";
+    print "BOARD:     Board number in chain (0..3)\n";
+    print "CHANNEL:   Channel number (0..3)\n";
+    print "OUTPUT:    Output number in channel (0..1)\n";
+    print "REGISTER:  Register to access (number or name)\n";
+    print "VALUE:     A 16 Bit value, 1-4 hex digits. If set, a write operation is performed, otherwise a read is done\n";
+    print "\n";
+    print "Register Names: switch, adjust, Vin, Cin, temp, info, Ioffset, Vout\n";
+    exit;
+}
+
+$SEL_rw = 1 if defined $SEL_value;
+
+$SEL_value //= 0;
+$SEL_value &= 0xffff;
+
+$SEL_board //= 0;
+$SEL_board &= 0xff;
+
+$SEL_output = 0  unless $SEL_output =~ /^\d$/;
+die "Group number too high (0..3)"   if $SEL_output > 3;
+
+$SEL_channel = 0  unless defined $SEL_channel && $SEL_channel =~ /^\d$/;
+die "Channel number too high (0..1)" if $SEL_channel > 1;
+
+if(defined $registers->{$SEL_register}) {$SEL_register = $registers->{$SEL_register};}
+$SEL_register //= -1;
+die "Undefined register" unless ($SEL_register >= 0 && $SEL_register <= 7);
+
+my $port = IO::Socket::INET->new(PeerAddr => $device, PeerPort => 2323, Proto => "tcp", Type => SOCK_STREAM, Timeout => 1) 
+              or die "Can't bind to $device: $@\n";
+
+my $cmd = sprintf("%s%02x%01x%01x%01x%04x",$SEL_rw?'W':'R',$SEL_board,$SEL_output,$SEL_channel,$SEL_register,$SEL_value&0xFFFF);
+print $cmd."\n";
+PrintAnswerNice(Cmd($cmd)); #Answer without \n
+
+sub Cmd {
+  my ($c) = @_;
+  $c .= "\n";
+  print $port  "$c";
+  my $x = "";
+  for my $i (0..10) {
+    $x .=  <$port>;
+    if($x && ($x =~ /\n/ || $x =~ /\r/) ) {
+      chomp $x;
+      return $x;
+      }
+    usleep(1000);
+    }
+  return;
+  }
+  
+sub PrintAnswerNice {
+  my ($s) = @_;
+  my $FSR = 0.002; #Full Sclae Range is set to +-4.096V; LSB Size is 2mV
+  if (substr($s,0,1) ne 'A') {die 'not a correct Answer from DCDC board'}
+  my $command = hex(substr($s,5,1));
+  my $ch   = hex(substr($s,4,1));
+  my $outp = hex(substr($s,3,1));
+  my $uC   = hex(substr($s,1,2));
+  my $answ = hex(substr($s,6));
+  print $s."\n";
+  print "-----------------------------------------------\n";
+  print "Board:   ".$uC."\t";
+  print "Output:  ".$outp."\t";
+  print "Channel: ".$ch."\n";
+  print "-----------------------------------------------\n";
+  if ($SEL_rw == 1 && $answ == 0x00d1) {
+    print "Done.\n";
+    return;
+    }
+  if ($command == 0) { # Switch
+    print "Output active.\n" if $answ == 1;
+    print "Output off.\n" if $answ == 0;
+    }    
+    
+  if ($command == 1) { # resistor adjustment values
+    print "Level selected: ";
+    print (($answ>> 0)&0xF)."\n";
+    }
+  if ($command == 2) { # Voltage
+    $answ = $answ >> 4;
+    my $calc = (($answ&0x7FF)-(($answ>>11)&0x1)*2048)*$FSR*11;# *11 to calculate real input value from voltage divider
+    printf "measured Voltage @ Input :  %.3f Volt   (RAW: 0x%x)\n", ($calc) , ($answ);
+    }
+  if ($command == 3) { # Current
+    $answ = $answ >> 4;
+    my $calc = (($answ&0x7FF)-(($answ>>11)&0x1)*2048)*$FSR*2; # 500mV/A -> Thats why multiplied by 2
+    printf "measured Current @ Input :  %.3f Ampere   (RAW: 0x%x)\n", ($calc) , ($answ);
+    }
+  if ($command == 4) { # Temperature
+    $answ = $answ >> 4;
+    my $calc = (($answ&0x7FF)-(($answ>>11)&0x1)*2048)*0.125;
+    printf "measured temperature : %.2f°C   (RAW: 0x%x)\n", ($calc) , ($answ);
+    }
+  if ($command == 5) { #Infos
+    print "Firmware   : ".($answ>>4)."\n";
+    print "SEL status : ".(($answ>>1) & 0x1)."\n";
+    print "LED status : ".($answ & 0x1)."\n";
+    }
+  if ($command == 6) { #Current Offset
+    $answ = $answ >> 4;
+    my $calc = (($answ&0x7F)-(($answ>>7)&0x1)*128)*$FSR*2; # 500mV/A -> Thats why multiplied by 2
+    printf "set Current offset :  %.3f Ampere   (RAW: 0x%x)\n", ($calc) , ($answ);
+    }
+  
+  
+  print "\n";
+
+}