File Coverage

blib/lib/AnyEvent/RFXCOM/RX.pm
Criterion Covered Total %
statement 72 83 86.7
branch 5 6 83.3
condition n/a
subroutine 17 20 85.0
pod 3 3 100.0
total 97 112 86.6


line stmt bran cond sub pod time code
1 1     1   7365 use strict;
  1         2  
  1         34  
2 1     1   5 use warnings;
  1         1  
  1         52  
3             package AnyEvent::RFXCOM::RX;
4             $AnyEvent::RFXCOM::RX::VERSION = '1.142240';
5             # ABSTRACT: AnyEvent module for an RFXCOM receiver
6              
7              
8 1     1   21 use 5.008;
  1         4  
  1         42  
9 1     1   5 use constant DEBUG => $ENV{ANYEVENT_RFXCOM_RX_DEBUG};
  1         11  
  1         73  
10 1     1   6 use base qw/AnyEvent::RFXCOM::Base Device::RFXCOM::RX/;
  1         1  
  1         556  
11 1     1   83609 use AnyEvent;
  1         2  
  1         32  
12 1     1   5 use Carp qw/croak/;
  1         2  
  1         57  
13 1     1   6 use Sub::Name;
  1         2  
  1         51  
14 1     1   7 use Scalar::Util qw/weaken/;
  1         1  
  1         12347  
15              
16              
17             sub new {
18 2     2 1 1790 my ($pkg, %p) = @_;
19 2 100       351 croak $pkg.'->new: callback parameter is required' unless ($p{callback});
20 1         15 my $self = $pkg->SUPER::new(%p);
21 1         147 $self;
22             }
23              
24             sub _handle_setup {
25 1     1   3 my $self = shift;
26 1         3 my $handle = $self->{handle};
27 1         3 my $weak_self = $self;
28 1         6 weaken $weak_self;
29             $handle->on_rtimeout(subname 'on_rtimeout_cb' => sub {
30 2     2   44206 my ($handle) = @_;
31 2         12 my $rbuf = \$handle->{rbuf};
32 2         6 print STDERR $handle, ": discarding '",
33             (unpack 'H*', $$rbuf), "'\n" if DEBUG;
34 2         7 $$rbuf = '';
35 2         19 $handle->rtimeout(0);
36 1         28 });
37             $handle->on_timeout(subname 'on_timeout_cb' => sub {
38 1     1   470111 my ($handle) = @_;
39 1         5 print STDERR $handle.": Clearing duplicate cache\n" if DEBUG;
40 1         7 $weak_self->{_cache} = {};
41 1         54 $handle->timeout(0);
42 1         20 });
43             $handle->on_read(subname 'on_read_cb' => sub {
44 1     1   1984 my ($hdl) = @_;
45             $hdl->push_read(ref $self => $self,
46             subname 'push_read_cb' => sub {
47 7         45 $weak_self->{callback}->(@_);
48 7         33494 $weak_self->_write_now();
49 7         111 return 1;
50 1         14 });
51 1         16 });
52 1         56 1;
53             }
54              
55             sub _open {
56 1     1   96702 my $self = shift;
57 1         38 $self->SUPER::_open($self->_open_condvar);
58 1         3 return 1;
59             }
60              
61             sub _open_serial_port {
62 0     0   0 my ($self, $cv) = @_;
63 0         0 my $fh = $self->SUPER::_open_serial_port;
64 0         0 $cv->send($fh);
65 0         0 return $cv;
66             }
67              
68             sub DESTROY {
69 0     0   0 $_[0]->cleanup;
70             }
71              
72              
73             sub cleanup {
74 0     0 1 0 my ($self, $error) = @_;
75 0         0 $self->SUPER::cleanup(@_);
76 0         0 undef $self->{discard_timer};
77 0         0 undef $self->{dup_timer};
78             }
79              
80              
81             sub anyevent_read_type {
82 1     1 1 21 my ($handle, $cb, $self) = @_;
83              
84 1         2 my $weak_self = $self;
85 1         4 weaken $weak_self;
86              
87             subname 'anyevent_read_type_reader' => sub {
88 5     5   372219 my ($handle) = @_;
89 5         20 my $rbuf = \$handle->{rbuf};
90 5         30 $handle->rtimeout($weak_self->{discard_timeout});
91 5         187 $handle->timeout($weak_self->{dup_timeout});
92 5         123 while (1) { # read all message from the buffer
93 12         19 print STDERR "Before: ", (unpack 'H*', $$rbuf||''), "\n" if DEBUG;
94 12         75 my $res = $weak_self->read_one($rbuf);
95 12 100       374 unless ($res) {
96 5 50       18 if (defined $res) {
97 0         0 print STDERR "Ignoring duplicate\n" if DEBUG;
98 0         0 next;
99             }
100 5         22 return;
101             }
102 7         9 print STDERR "After: ", (unpack 'H*', $$rbuf), "\n" if DEBUG;
103 7         27 $res = $cb->($res);
104             }
105             }
106 1         31 }
107              
108             1;
109              
110             __END__