File Coverage

blib/lib/AnyEvent/W800.pm
Criterion Covered Total %
statement 63 78 80.7
branch 5 8 62.5
condition n/a
subroutine 16 19 84.2
pod 3 3 100.0
total 87 108 80.5


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