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; |