qcom-chat.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Device::SerialPort;
   6 use Data::Dump qw(dump);
   7
   8 my $device = $ENV{DEVICE} || '/dev/ttyUSB0';
   9
  10 my $port = Device::SerialPort->new( $device ) || die "$device: $!";
  11 $port->baudrate(115200) || die "fail $device baudrate";
  12 $port->parity("none") || die "fail $device parity";
  13 $port->databits(8)    || die "fail $device databits";
  14 $port->stopbits(1)    || die "fail $device stopbits";
  15 $port->handshake("rts")  || die "fail $device handshake";
  16
  17 $port->write_settings || die "no $device settings";
  18
  19 $port->user_msg(1);
  20 $port->error_msg(1);
  21 $port->debug(1);
  22
  23 $port->read_char_time(1000);  # 0.1 s char timeout
  24 $port->read_const_time(500); # 0.5 s read timeout
  25
  26 while ( my $drain = $port->input ) {
  27         warn "# drain $drain\n# /drain\n";
  28 }
  29
  30
  31 warn "## using $device\n";
  32
  33 sub c {
  34         my ($cmd,$message) = @_;
  35         print STDERR ">>> $cmd >>> $message\n";
  36         $port->write("$cmd\r");
  37 #       $port->write_done(1); # flush
  38         $port->write_drain;
  39         my $ret = $port->read(1);
  40         while ( my $c = $port->input ) {
  41                 print STDERR "<<< ",dump($ret . $c), $/;
  42                 $ret .= $c;
  43 #               last if $c =~ m/^OK\r/;
  44         }
  45         $ret =~ s/^[\r\n]+//;
  46         $ret =~ s/\r\nOK\r\n$// || warn "ERROR: missing OK";
  47         print "$cmd [$message] = $ret\n";
  48         return $ret;
  49 }
  50
  51 c 'ATE0' => 'echo off';
  52 #c 'ATZ' => 'reset';
  53 #
  54 c 'ATI'  => 'info';
  55
  56 c 'AT+CGMI'  => 'CGMI';
  57
  58 c 'AT+CGMM'  => 'CGMM';
  59
  60 c 'AT+CGMR'  => 'CGMR';
  61
  62 c 'AT+CIMI'  => 'IMSI';
  63
  64 c 'AT+CGSN'  => 'CGSN';
  65
  66 c 'AT^CVOICE?' => 'is voice enabled?';
  67
  68
  69 $port->close || die "can't close port $!";
  70
  71 warn "## $device closed\n";
  72