b3603: perl script to control psu over serial port
authorDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 25 Jun 2019 09:46:00 +0000 (11:46 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 2 Jul 2019 14:12:57 +0000 (16:12 +0200)
psu.pl [new file with mode: 0755]

diff --git a/psu.pl b/psu.pl
new file mode 100755 (executable)
index 0000000..0d087d7
--- /dev/null
+++ b/psu.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Device::SerialPort;
+use Data::Dump qw(dump);
+
+my $port = '/dev/ttyUSB1';
+$port = '/dev/serial/by-id/usb-Prolific_Technology_Inc._USB-Serial_Controller-if00-port0';
+
+my $ob = new Device::SerialPort ($port)
+                 || die "Can't open $port: $!\n";
+
+$ob->baudrate(38400)   || die "fail setting baudrate";
+$ob->parity("none")    || die "fail setting parity";
+$ob->databits(8)       || die "fail setting databits";
+$ob->stopbits(1)       || die "fail setting stopbits";
+$ob->handshake("none") || die "fail setting handshake";
+$ob->debug(1);
+
+my $InBytes = 255;
+
+my @commands = qw(
+system
+status
+config
+);
+
+$ob->write( shift(@commands) . "\n" );
+
+my $got = '';
+my $s;
+
+while ( 1 ) {
+       my ($count_in, $string_in) = $ob->read($InBytes);
+       print "<< $count_in << ",dump($string_in),"\n" if $count_in > 0;
+       $got .= $string_in;
+       if ( $got =~ m/(OK|E!)\r\n/ ) {
+               warn "# got = ",dump( $got );
+               foreach ( split(/[\r\n]+/,$got) ) {
+                       my ($k,$v) = split(/:\s+/,$_,2);
+                       $s->{$k} = $v;
+               }
+               warn "# s = ",dump( $s );
+               $got = '';
+               if ( @commands ) {
+                       $ob->write( shift(@commands) . "\n" );
+               } else {
+                       print ">> ";
+                       alarm(1);
+                       my $c;
+                       eval {
+                               local $SIG{ALRM} = sub { die };
+                               $c = <STDIN>;
+                       };
+                       $c ||= "status\n";
+                       $ob->write( $c );
+               }
+       }
+}
+