File Coverage

blib/lib/Device/RFXCOM/TX.pm
Criterion Covered Total %
statement 74 79 93.6
branch 19 26 73.0
condition 1 2 50.0
subroutine 19 20 95.0
pod 8 8 100.0
total 121 135 89.6


line stmt bran cond sub pod time code
1 1     1   6982 use strict;
  1         2  
  1         31  
2 1     1   3 use warnings;
  1         2  
  1         52  
3             package Device::RFXCOM::TX;
4             $Device::RFXCOM::TX::VERSION = '1.163170';
5             # ABSTRACT: Module to support an RFXCOM RF transmitter
6              
7              
8 1     1   18 use 5.006;
  1         3  
9             use constant {
10             DEBUG => $ENV{DEVICE_RFXCOM_TX_DEBUG},
11             TESTING => $ENV{DEVICE_RFXCOM_TX_TESTING},
12 1     1   3 };
  1         2  
  1         83  
13 1     1   4 use base 'Device::RFXCOM::Base';
  1         2  
  1         445  
14 1     1   9 use Carp qw/croak carp/;
  1         2  
  1         76  
15 1     1   7 use IO::Handle;
  1         2  
  1         49  
16 1     1   6 use IO::Select;
  1         2  
  1         54  
17             use Module::Pluggable
18 1         10 search_path => 'Device::RFXCOM::Encoder',
19 1     1   898 instantiate => 'new';
  1         15234  
20              
21              
22             sub new {
23 4     4 1 17187 my $pkg = shift;
24 4         53 my $self = $pkg->SUPER::_new(device => '/dev/rfxcom-tx',
25             ack_timeout => 6,
26             receiver_connected => 0,
27             flamingo => 0,
28             harrison => 0,
29             koko => 0,
30             x10 => 1,
31             @_);
32 2         14 foreach my $plugin ($self->plugins()) {
33 4         40 my $p = lc ref $plugin;
34 4         22 $p =~ s/.*:://;
35 4         16 $self->{plugin_map}->{$p} = $plugin;
36 4         8 print STDERR "Initialized plugin for $p messages\n" if DEBUG;
37             }
38 2         12 $self;
39             }
40              
41              
42 2     2 1 15 sub receiver_connected { shift->{receiver_connected} }
43              
44              
45 2     2 1 18 sub flamingo { shift->{flamingo} }
46              
47              
48 2     2 1 14 sub harrison { shift->{harrison} }
49              
50              
51 2     2 1 12 sub koko { shift->{koko} }
52              
53              
54 2     2 1 12 sub x10 { shift->{x10} }
55              
56             sub _init {
57 2     2   5 my $self = shift;
58 2         23 $self->_write(hex => 'F030F030', desc => 'version check');
59 2 100       9 $self->_write(hex => 'F03CF03C', desc => 'enabling harrison')
60             if ($self->harrison);
61 2 100       9 $self->_write(hex => 'F03DF03D', desc => 'enabling klikon-klikoff')
62             if ($self->koko);
63 2 100       11 $self->_write(hex => 'F03EF03E', desc => 'enabling flamingo')
64             if ($self->flamingo);
65 2 100       9 $self->_write(hex => 'F03FF03F', desc => 'disabling x10') unless ($self->x10);
66 2         11 $self->_init_mode($self->{init_callback});
67 2         9 $self->{init} = 1;
68             }
69              
70             sub _init_mode {
71 2     2   6 my ($self, $cb) = @_;
72 2 100       9 my @args =
73             $self->receiver_connected ?
74             (hex => 'F033F033',
75             desc => 'variable length mode w/receiver connected') :
76             (hex => 'F037F037',
77             desc=> 'variable length mode w/o receiver connected');
78 2 50       16 push @args, callback => $cb if ($cb);
79 2         9 $self->_write(@args);
80             }
81              
82             sub _reset_device {
83 0     0   0 my $self = shift;
84 0         0 carp "No ack from transmitter!\n";
85 0         0 $self->init_device();
86 0         0 1;
87             }
88              
89              
90             sub transmit {
91 9     9 1 7524 my ($self, %p) = @_;
92 9   50     55 my $type = $p{type} || 'x10';
93 9 50       13 my @args = @{$p{args}||[]};
  9         82  
94 9 100       103 my $plugin = $self->{plugin_map}->{$type} or
95             croak $self, '->transmit: ', $type, ' encoding not supported';
96 8         50 my $encode = $plugin->encode($self, \%p);
97 8 100       36 if (ref $encode eq 'ARRAY') {
98 4         13 foreach my $e (@$encode) {
99 4         23 $self->_write(%$e, @args);
100             }
101 4         26 return scalar @$encode;
102             } else {
103 4         27 $self->_write(%$encode, @args);
104 4         26 return 1;
105             }
106             }
107              
108              
109             sub wait_for_ack {
110 16     16 1 21710 my ($self, $timeout) = @_;
111 16 50       68 $timeout = $self->{ack_timeout} unless (defined $timeout);
112 16         60 my $fh = $self->filehandle;
113 16         73 my $sel = IO::Select->new($fh);
114 16 50       840 $sel->can_read($timeout) or return;
115 16         629 my $buf;
116 16         134 my $bytes = sysread $fh, $buf, 2048;
117 16 50       48 unless ($bytes) {
118 0 0       0 croak defined $bytes ? 'closed' : 'error: '.$!;
119             }
120 16         61 $self->_write_now();
121 16         19 print STDERR "Received: ", (unpack 'H*', $buf), "\n" if DEBUG;
122 16         121 return $buf;
123             }
124              
125             1;
126              
127             __END__