File Coverage

lib/Biblio/RFID/Reader/Serial.pm
Criterion Covered Total %
statement 24 35 68.5
branch 3 12 25.0
condition n/a
subroutine 6 6 100.0
pod 2 2 100.0
total 35 55 63.6


line stmt bran cond sub pod time code
1             package Biblio::RFID::Reader::Serial;
2              
3 4     4   866 use warnings;
  4         7  
  4         108  
4 4     4   19 use strict;
  4         7  
  4         120  
5              
6 4     4   5144 use Device::SerialPort qw(:STAT);
  4         186905  
  4         15663  
7 4     4   60 use Data::Dump qw(dump);
  4         9  
  4         1822  
8              
9             =head1 NAME
10              
11             Biblio::RFID::Reader::Serial - base class for serial RFID readers
12              
13             =head1 METHODS
14              
15             =head2 new
16              
17             Open serial port (if needed) and init reader
18              
19             =cut
20              
21             sub new {
22 2     2 1 44 my $class = shift;
23 2         10 my $self = {@_};
24 2         9 bless $self, $class;
25              
26 2 50       17 $self->port && return $self;
27             }
28              
29              
30             =head2 port
31              
32             Tries to open usb serial ports C
33              
34             my $serial_obj = $self->port;
35              
36             To try just one device use C enviroment variable
37              
38             =cut
39              
40             our $serial_device;
41              
42             sub port {
43 2     2 1 6 my $self = shift;
44              
45 2 50       49 return $self->{port} if defined $self->{port};
46              
47 2         221 my $settings = $self->serial_settings;
48 1 50       128 my @devices = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB*';
49 1         10 warn "# port devices ",dump(@devices);
50              
51 1         4 foreach my $device ( @devices ) {
52              
53 0 0       0 next if $serial_device->{$device};
54              
55 0 0       0 if ( my $port = Device::SerialPort->new($device) ) {
56              
57 0         0 foreach my $opt ( qw/handshake baudrate databits parity stopbits/ ) {
58 0         0 $port->$opt( $settings->{$opt} );
59             }
60              
61 0         0 $self->{port} = $port;
62              
63 0         0 warn "# probe by init $device ",ref($self);
64 0 0       0 if ( $self->init ) {
65 0         0 warn "init OK ", ref($self), " $device settings ",dump $settings;
66 0         0 $serial_device->{$device} = $port;
67 0         0 last;
68             } else {
69 0         0 $self->{port} = 0;
70             }
71             }
72             }
73              
74 1         4 warn "# serial_device ",dump($serial_device);
75              
76 1         23 return $self->{port};
77             }
78              
79             1
80             __END__