git.rot13.org Git - b3603-psu/blob - psu.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use Device::SerialPort;
   5 use Data::Dump qw(dump);
   6
   7 my $port = '/dev/ttyUSB1';
   8 $port = '/dev/serial/by-id/usb-Prolific_Technology_Inc._USB-Serial_Controller-if00-port0';
   9
  10 my $debug = $ENV{DEBUG} || 0;
  11
  12 my $ob = new Device::SerialPort ($port)
  13                  || die "Can't open $port: $!\n";
  14
  15 $ob->baudrate(38400)    || die "fail setting baudrate";
  16 $ob->parity("none")     || die "fail setting parity";
  17 $ob->databits(8)        || die "fail setting databits";
  18 $ob->stopbits(1)        || die "fail setting stopbits";
  19 $ob->handshake("none")  || die "fail setting handshake";
  20 $ob->debug($debug);
  21
  22 my $InBytes = 255;
  23
  24 my @commands = qw(
  25 system
  26 status
  27 config
  28 );
  29
  30 $ob->write( shift(@commands) . "\n" );
  31
  32 my $got = '';
  33 my $s;
  34
  35 my $show_response = $debug;
  36
  37 while ( 1 ) {
  38         my ($count_in, $string_in) = $ob->read($InBytes);
  39         print "<< $count_in << ",dump($string_in),"\n" if $debug && $count_in > 0;
  40         $got .= $string_in;
  41         if ( $got =~ m/(OK|E!)\r\n/ ) {
  42                 warn "# got = ",dump( $got ) if $show_response;
  43                 $show_response = $debug;
  44                 my $new;
  45                 foreach ( split(/[\r\n]+/,$got) ) {
  46                         my ($k,$v) = split(/:\s+/,$_,2);
  47                         if ( ! defined $v ) {
  48                                 warn "SKIP: [$_]\n" if $debug;
  49                         } else {
  50                                 $new->{$k} = $v if ! defined $s->{$k} || $s->{$k} ne $v;
  51                                 $s->{$k} = $v;
  52                         }
  53                 }
  54                 warn "# new = ",dump( $new ) if $debug;
  55
  56                 print join("", map {
  57                         my $n = $_;
  58                         if ( my $v = $s->{$n} ) {
  59                                 $v =~ s/(\d+) (\d+)$/$1/; # strip adc
  60                                 "$n $v" . ( exists $new->{$n} ? '*' : ' ' );
  61                         } else { '?' };
  62                 } qw(
  63 VIN
  64 VSET
  65 VOUT
  66 CSET
  67 COUT
  68 OUTPUT
  69 CONSTANT
  70                 ) ), "\n";
  71
  72
  73                 $got = '';
  74                 if ( @commands ) {
  75                         $ob->write( shift(@commands) . "\n" );
  76                 } else {
  77                         alarm(1);
  78                         my $c;
  79                         eval {
  80                                 local $SIG{ALRM} = sub { die };
  81                                 $c = <STDIN>;
  82                                 chomp $c;
  83                                 alarm(0);
  84                                 if ( length($c) == 0 ) {
  85                                         print ">> ";
  86                                         $c = <STDIN>;
  87                                         chomp $c;
  88                                 }
  89                                 $show_response = 1;
  90                         };
  91
  92
  93                         if ( $c eq '?' ) {
  94                                 print dump($s);
  95                                 $c = '';
  96                         }
  97
  98                         # always emit something to keep update working
  99                         $c ||= "status";
 100                         warn ">> ",dump($c) if $debug;
 101                         $ob->write( "$c\n" );
 102                 }
 103         }
 104 }
 105