File Coverage

blib/lib/AnyEvent/RFXCOM/TX.pm

Criterion	Covered	Total	%
statement	73	81	90.1
branch	5	8	62.5
condition			n/a
subroutine	17	19	89.4
pod	2	2	100.0
total	97	110	88.1

use strict;
use warnings;
package AnyEvent::RFXCOM::TX;
$AnyEvent::RFXCOM::TX::VERSION = '1.142240';
# ABSTRACT: AnyEvent module for an RFXCOM transmitter


use 5.008;
use constant DEBUG => $ENV{ANYEVENT_RFXCOM_TX_DEBUG};
use base qw/AnyEvent::RFXCOM::Base Device::RFXCOM::TX/;
use AnyEvent;
use Carp qw/croak/;
use Sub::Name;
use Scalar::Util qw/weaken/;


sub _handle_setup {
  my $self = shift;
  my $handle = $self->{handle};
  my $weak_self = $self;
  weaken $weak_self;
  $handle->on_rtimeout(subname 'on_rtimeout_cb' => sub {
    my ($handle) = @_;
    print STDERR $handle.": no ack\n" if DEBUG;
    $handle->rtimeout(0);
    $weak_self->_init_mode();
  });
  $handle->on_drain(subname 'on_drain_cb' => sub {
    my ($handle) = @_;
    return unless (defined $handle);
    print STDERR $handle.": on drain\n" if DEBUG;
    $handle->rtimeout_reset();
    $handle->rtimeout($weak_self->{ack_timeout});
  });
  $handle->on_read(subname 'on_read_cb' => sub {
    my ($handle) = @_;
    $handle->rtimeout(0);
    my $rbuf = \$handle->{rbuf};
    my $data = $$rbuf;
    $$rbuf = '';
    $weak_self->{callback}->($data) if ($weak_self->{callback});
    print STDERR $handle.": read ", (unpack 'H*', $data), "\n" if DEBUG;
    my $wait_record = $weak_self->{_waiting};
    if ($wait_record) {
      my ($time, $rec) = @$wait_record;
      push @{$rec->{result}}, $data;
      my $cv = $rec->{cv};
      $cv->end if ($cv);
    }
    $weak_self->_write_now();
    return;
  });
  1;
}

sub transmit {
  my $self = shift;
  my $cv = AnyEvent->condvar;
  my $res = [];
  my $weak_cv = $cv;
  weaken $weak_cv;
  $cv->cb(subname 'transmit_cb' => sub { $weak_cv->send($res->[0]) });
  $self->SUPER::transmit(args => [ cv => $cv, result => $res ], @_);
  return $cv;
}

sub _open {
  my $self = shift;
  $self->SUPER::_open($self->_open_condvar);
  return 1;
}

sub _open_serial_port {
  my ($self, $cv) = @_;
  my $fh = $self->SUPER::_open_serial_port;
  $cv->send($fh);
  return $cv;
}

sub DESTROY {
  $_[0]->cleanup;
}


sub cleanup {
  my ($self, $error) = @_;
  $self->SUPER::cleanup(@_);
  undef $self->{discard_timer};
  undef $self->{dup_timer};
}

1;

__END__