File Coverage

blib/lib/AnyEvent/RFXCOM/Base.pm
Criterion Covered Total %
statement 60 71 84.5
branch 5 10 50.0
condition 0 3 0.0
subroutine 15 15 100.0
pod 1 1 100.0
total 81 100 81.0


line stmt bran cond sub pod time code
1 3     3   21 use strict;
  3         6  
  3         106  
2 3     3   16 use warnings;
  3         5  
  3         136  
3             package AnyEvent::RFXCOM::Base;
4             $AnyEvent::RFXCOM::Base::VERSION = '1.142240';
5             # ABSTRACT: module for AnyEvent RFXCOM base class
6              
7              
8 3     3   43 use 5.006;
  3         8  
  3         116  
9             use constant {
10 3         128 DEBUG => $ENV{ANYEVENT_RFXCOM_BASE_DEBUG},
11 3     3   15 };
  3         3  
12              
13 3     3   15 use AnyEvent::Handle;
  3         3  
  3         90  
14 3     3   14 use AnyEvent::Socket;
  3         6  
  3         428  
15 3     3   21 use Sub::Name;
  3         5  
  3         142  
16 3     3   16 use Scalar::Util qw/weaken/;
  3         6  
  3         2621  
17              
18             sub _open_condvar {
19 4     4   10 my $self = shift;
20 4         161 my $cv = AnyEvent->condvar;
21 4         74 my $weak_self = $self;
22 4         24 weaken $weak_self;
23              
24             $cv->cb(subname 'open_cb' => sub {
25 4     4   60 my $fh = $_[0]->recv;
26 4         37 print STDERR "start cb $fh @_\n" if DEBUG;
27 4         8 my $handle; $handle =
28             AnyEvent::Handle->new(
29             fh => $fh,
30             on_error => subname('on_error' => sub {
31 0         0 my ($handle, $fatal, $msg) = @_;
32 0         0 print STDERR $handle.": error $msg\n" if DEBUG;
33 0         0 $handle->destroy;
34 0 0 0     0 if ($fatal && defined $weak_self) {
35 0         0 $weak_self->cleanup($msg);
36             }
37             }),
38             on_eof => subname('on_eof' => sub {
39 0         0 my ($handle) = @_;
40 0         0 print STDERR $handle.": eof\n" if DEBUG;
41 0         0 $weak_self->cleanup('connection closed');
42 4         125 }),
43             );
44 4         452 $weak_self->{handle} = $handle;
45 4         27 $weak_self->_handle_setup();
46 4         17 delete $weak_self->{_waiting}; # uncork queued writes
47 4         56 $weak_self->_write_now();
48 4         96 });
49 4         47 $weak_self->{_waiting} = { desc => 'fake for async open' };
50 4         44 return $cv;
51             }
52              
53              
54             sub cleanup {
55 3     3 1 8 my $self = shift;
56 3         6 print STDERR $self."->cleanup\n" if DEBUG;
57 3 50       41 $self->{handle}->destroy if ($self->{handle});
58 3         1178 delete $self->{handle};
59             }
60              
61             sub _open_tcp_port {
62 4     4   45 my ($self, $cv) = @_;
63 4         11 my $dev = $self->{device};
64 4         5 print STDERR "Opening $dev as tcp socket\n" if DEBUG;
65 4         36 require AnyEvent::Socket; import AnyEvent::Socket;
  4         363  
66 4         18 my ($host, $port) = split /:/, $dev, 2;
67 4 50       21 $port = $self->{port} unless (defined $port);
68             $self->{sock} = tcp_connect $host, $port, subname 'tcp_connect_cb' => sub {
69             my $fh = shift
70 4 50   4   16067 or do {
71 0         0 my $err = (ref $self).": Can't connect to device $dev: $!";
72 0         0 $self->cleanup($err);
73 0         0 $cv->croak($err);
74             };
75              
76 4         9 warn "Connected\n" if DEBUG;
77 4         25 $cv->send($fh);
78 4         58 };
79 4         2095 return $cv;
80             }
81              
82             sub _real_write {
83 19     19   5259 my ($self, $rec) = @_;
84 19         33 print STDERR "Sending: ", $rec->{hex}, ' ', ($rec->{desc}||''), "\n" if DEBUG;
85 19         102 $self->{handle}->push_write($rec->{raw});
86 19 100       1270 $rec->{cv}->begin if ($rec->{cv});
87             }
88              
89             sub _time_now {
90 26     26   1298 AnyEvent->now;
91             }
92              
93             1;
94              
95             __END__