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