Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Condition the line, and add optional I/O dumping.

  • Loading branch information...
commit 5a9bdb86ad98b1007b6af81eb6897f271cfab79e 1 parent fb5180a
Rocco Caputo authored

Showing 1 changed file with 67 additions and 6 deletions. Show diff stats Hide diff stats

  1. +67 6 lib/Device/Firmdata/Role/IO/Serial.pm
73 lib/Device/Firmdata/Role/IO/Serial.pm
... ... @@ -1,6 +1,10 @@
1 1 package Device::Firmdata::Role::IO::Serial;
2 2
3 3 use Moose::Role;
  4 +use POSIX;
  5 +use Time::HiRes qw(time);
  6 +
  7 +use constant DEBUG => 0;
4 8
5 9 with 'Device::Firmdata::Role::IO';
6 10
@@ -14,7 +18,42 @@ sub build_fh {
14 18 my $fh;
15 19
16 20 die "Could not open $path for read/write" unless open($fh, '+>', $path);
17   -
  21 + binmode($fh);
  22 +
  23 + my $tio = POSIX::Termios->new();
  24 + $tio->getattr(fileno $fh);
  25 +
  26 + $tio->setlflag(0);
  27 +
  28 + my $cflag = $tio->getcflag();
  29 + $cflag = (
  30 + CLOCAL | # ignore modem status lines
  31 + CREAD | # enable receiver
  32 + HUPCL # hang up on last close
  33 + );
  34 + $cflag |= CS8; # 8 bits
  35 + $cflag &= ~PARENB; # turn off parity enable
  36 + $cflag &= ~CSTOPB; # turn off 2 stop bits (enable 1 stop)
  37 + $tio->setcflag($cflag);
  38 +
  39 + $tio->setiflag(
  40 + IGNBRK | # ignore break
  41 + IGNPAR | # ignore parity errors
  42 + INPCK # enable parity checking
  43 + );
  44 +
  45 + $tio->setoflag(0);
  46 +
  47 + # Non-blocking mode. Return whatever is there.
  48 + $tio->setcc(VMIN, 0);
  49 + $tio->setcc(VTIME, 0);
  50 +
  51 + $tio->setispeed(57600);
  52 + $tio->setospeed(57600);
  53 +
  54 + # Apply Termios to the device now.
  55 + $tio->setattr(fileno($fh), TCSANOW);
  56 +
18 57 return $fh;
19 58 }
20 59
@@ -22,11 +61,21 @@ sub read {
22 61 my ($self, $wantBytes) = @_;
23 62 my $bytesLeft = $wantBytes;
24 63 my $readBytes = 0;
25   - my $outputBuf;
26   -
  64 + my $outputBuf;
  65 +
  66 + my $fh = $self->fh();
  67 + my $tio = POSIX::Termios->new();
  68 + $tio->getattr(fileno $fh);
  69 +
27 70 while($bytesLeft > 0) {
28 71 my $readBuf;
29   - my $bytesRead = sysread($self->fh, $readBuf, $bytesLeft);
  72 +
  73 + # Blocking until there are enough bytes.
  74 + # Remove this for a non-blocking library.
  75 + $tio->setcc(VMIN, ($bytesLeft > 255) ? 255 : $bytesLeft);
  76 + $tio->setattr(fileno($fh), TCSANOW);
  77 +
  78 + my $bytesRead = sysread($fh, $readBuf, $bytesLeft);
30 79
31 80 if ($bytesRead == -1) {
32 81 die "Could not read from fh: $!";
@@ -40,7 +89,13 @@ sub read {
40 89 if ($bytesLeft < 0) {
41 90 die "read too much data";
42 91 }
43   -
  92 +
  93 + if (DEBUG) {
  94 + my $output_ascii = $outputBuf;
  95 + $output_ascii =~ s/([^ -~])/sprintf '\\x%02x', ord $1/eg;
  96 + warn sprintf "%.3f <-- %s\n", time(), $output_ascii;
  97 + }
  98 +
44 99 return $outputBuf;
45 100 }
46 101
@@ -48,7 +103,13 @@ sub write {
48 103 my ($self, $content) = @_;
49 104 my $length = length($content);
50 105 my $bytesLeft = length($content);
51   -
  106 +
  107 + if (DEBUG) {
  108 + my $output_ascii = $content;
  109 + $output_ascii =~ s/([^ -~])/sprintf '\\x%02x', ord $1/eg;
  110 + warn sprintf "%.3f --> %s\n", time(), $output_ascii;
  111 + }
  112 +
52 113 while($bytesLeft > 0) {
53 114 my $bytesSent = syswrite($self->fh, $content, $bytesLeft, $length - $bytesLeft);
54 115

0 comments on commit 5a9bdb8

Please sign in to comment.
Something went wrong with that request. Please try again.