File Coverage: lib/AnyEvent/SerialPort.pm

# File Coverage

File: | lib/AnyEvent/SerialPort.pm
Coverage: | 96.8%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 | 1 1 1 |  |  | 1 |  | 1.35829301632581e+15 7 82 | use strict;
2 | 1 1 1 |  |  | 1 |  | 13 5 151 | use warnings;
3 |  |  |  |  |  |  | package AnyEvent::SerialPort;
4 |
5 | 1 1 1 |  |  | 1 |  | 12 5 179 | use base 'AnyEvent::Handle';
6 |
7 |  |  |  |  |  |  | use constant {
8 | 1 |  |  |  |  | 233 | DEBUG => $ENV{ANYEVENT_SERIALPORT_DEBUG},
9 | 1 1 |  |  | 1 |  | 50260 9 | };
10 |
11 | 1 1 1 |  |  | 1 |  | 15 5 200 | use Carp qw/croak carp/;
12 | 1 1 1 |  |  | 1 |  | 377 666 81 | use Device::SerialPort qw/:PARAM :STAT 0.07/;
13 | 1 1 1 |  |  | 1 |  | 14 5 955 | use Fcntl;
14 | 1 1 1 |  |  | 1 |  | 16 5 974 | use Symbol qw(gensym);
15 |
16 |  |  |  |  |  |  | # ABSTRACT: AnyEvent::Handle subclass for serial ports
17 |
18 - 52 |  |
    =head1 SYNOPSIS

      use AnyEvent;
      use AnyEvent::SerialPort;

      my $cv = AnyEvent->condvar;

      my $hdl;
      $hdl = AnyEvent::SerialPort->new(
               serial_port => '/dev/ttyUSB0',
               # other AnyEvent::Handle arguments here
             );

      # or to use something other than 9600 8n1 raw
      $hdl = AnyEvent::SerialPort->new
              (
               serial_port =>
                 [ '/dev/ttyUSB0',
                   [ baudrate => 4800 ],
                   # other [ "Device::SerialPort setter name" => \@arguments ] here
                 ],
               # other AnyEvent::Handle arguments here
             );

      # obtain the Device::SerialPort object
      my $port = $hdl->serial_port;

    =head1 DESCRIPTION

    This module is a subclass of L<AnyEvent::Handle> for serial ports.

    B<IMPORTANT:> This is a new API and is still subject to change.  Feedback
    and suggestions would be very welcome.

    =cut
53 |
54 |  |  |  |  |  |  | sub new {
55 | 4 |  |  | 4 |  | 16561 | my $pkg = shift;
56 | 4 |  |  |  |  | 65 | my %p = @_;
57 | 4 | 100 |  |  |  | 108 | croak "Parameter serial_port is required" unless (exists $p{serial_port});
58 |
59 |  |  |  |  |  |  | # allow just a device name - to use defaults or array reference with
60 |  |  |  |  |  |  | # device and settings
61 | 3 |  |  |  |  | 35 | my $dev = delete $p{serial_port};
62 | 3 |  |  |  |  | 21 | my @settings;
63 | 3 | 100 |  |  |  | 37 | if (ref $dev) {
64 | 1 |  |  |  |  | 14 | @settings = @$dev;
65 | 1 |  |  |  |  | 12 | $dev = shift @settings;
66 |  |  |  |  |  |  | }
67 |
68 | 3 |  |  |  |  | 116 | my $fh = gensym();
69 | 3 | 0 |  |  |  | 141 | my $s = tie *$fh, 'Device::SerialPort', $dev or
70 |  |  |  |  |  |  | croak "Could not tie serial port, $dev, to file handle: $!";
71 |
72 | 3 |  |  |  |  | 252 | foreach my $setting ([ baudrate => 9600 ],
73 |  |  |  |  |  |  | [ databits => 8 ],
74 |  |  |  |  |  |  | [ parity => 'none' ],
75 |  |  |  |  |  |  | [ stopbits => 1 ],
76 |  |  |  |  |  |  | [ datatype => 'raw' ],
77 |  |  |  |  |  |  | @settings
78 |  |  |  |  |  |  | ) {
79 | 16 |  |  |  |  | 641 | my ($setter, @v) = @$setting;
80 | 16 |  |  |  |  | 522 | $s->$setter(@v);
81 |  |  |  |  |  |  | }
82 | 3 |  |  |  |  | 218 | $s->write_settings();
83 | 3 | 100 |  |  |  | 354 | sysopen($fh, $dev, O_RDWR|O_NOCTTY|O_NDELAY) or
84 |  |  |  |  |  |  | croak "sysopen of '$dev' failed: $!";
85 | 2 |  |  |  |  | 204 | $fh->autoflush(1);
86 | 2 |  |  |  |  | 140 | my $self = $pkg->SUPER::new(fh => $fh, %p);
87 | 2 |  |  |  |  | 23936 | $self->{serial_port} = $s;
88 | 2 |  |  |  |  | 48 | $self;
89 |  |  |  |  |  |  | }
90 |
91 - 95 |  |
    =head2 C<serial_port()>

    Return the wrapped L<Device::SerialPort> object.

    =cut
96 |
97 |  |  |  |  |  |  | sub serial_port {
98 | 2 |  |  | 2 |  | 2247 | shift->{serial_port}
99 |  |  |  |  |  |  | }
100 |
101 |  |  |  |  |  |  | 1;