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