| File: | lib/AnyEvent/SerialPort.pm |
| Coverage: | 96.8% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 1 1 1 | 1.35829301632581e+15 7 82 | use strict; | ||||
| 2 | 1 1 1 | 13 5 151 | use warnings; | ||||
| 3 | package AnyEvent::SerialPort; | ||||||
| 4 | |||||||
| 5 | 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 | 50260 9 | }; | ||||
| 10 | |||||||
| 11 | 1 1 1 | 15 5 200 | use Carp qw/croak carp/; | ||||
| 12 | 1 1 1 | 377 666 81 | use Device::SerialPort qw/:PARAM :STAT 0.07/; | ||||
| 13 | 1 1 1 | 14 5 955 | use Fcntl; | ||||
| 14 | 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 | 16561 | my $pkg = shift; | ||||
| 56 | 4 | 65 | my %p = @_; | ||||
| 57 | 4 | 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 | 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 | 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 | 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 | 2247 | shift->{serial_port} | ||||
| 99 | } | ||||||
| 100 | |||||||
| 101 | 1; | ||||||