File Coverage

blib/lib/AnyEvent/CurrentCost.pm

Criterion	Covered	Total	%
statement	70	70	100.0
branch	9	12	75.0
condition	2	3	66.6
subroutine	20	20	100.0
pod	4	4	100.0
total	105	109	96.3

use strict;
use warnings;
package AnyEvent::CurrentCost;
{
  $AnyEvent::CurrentCost::VERSION = '1.130190';
}

# ABSTRACT: AnyEvent module for reading from Current Cost energy meters


use constant DEBUG => $ENV{ANYEVENT_CURRENT_COST_DEBUG};
use base qw/Device::CurrentCost/;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::SerialPort;
use Carp qw/croak carp/;
use Sub::Name;


sub new {
  my ($pkg, %p) = @_;
  croak $pkg.q{->new: 'callback' parameter is required} unless ($p{callback});
  my $self = $pkg->SUPER::new(%p);
  $self;
}

sub DESTROY { shift->cleanup }


sub cleanup {
  my $self = shift;
  print STDERR "cleanup\n" if DEBUG;
  delete $self->{handle};
  close $self->filehandle if (defined $self->filehandle);
}

sub _error {
  my ($self, $fatal, $message) = @_;
  $self->cleanup($message);
  $self->{on_error}->($fatal, $message) if ($self->{on_error});
}


sub open {
  my $self = shift;
  my $fh = $self->filehandle;
  my $handle =
    $fh
      ? AnyEvent::Handle->new(fh => $fh)
        : AnyEvent::SerialPort->new(serial_port =>
                                    [ $self->device,
                                      [ baudrate => $self->baud ] ]);
  print STDERR ref $self, "->open: created ", $handle, "\n" if DEBUG;
  $self->{handle} = $handle;
  $handle->on_error(subname 'on_error' => sub {
                      my ($handle, $fatal, $msg) = @_;
                      print STDERR $handle.": error $msg\n" if DEBUG;
                      $handle->destroy;
                      $self->_error($fatal, 'Error: '.$msg);
                    });
  $handle->on_rtimeout(subname 'on_rtimeout' => sub {
                         my $rbuf = \$handle->{rbuf};
                         carp $handle, ": Discarding '", $$rbuf, "'\n";
                         $$rbuf = '';
                         $handle->rtimeout(undef);
                       });
  $handle->on_read(subname 'on_read_cb' => sub {
                     my ($hdl) = @_;
                     $hdl->push_read(ref $self => $self,
                                     subname 'push_read_cb' => sub {
                                       $self->{callback}->(@_);
                                       1;
                                     });
                   });
}

sub _time_now {
  AnyEvent->now;
}


sub anyevent_read_type {
  my ($handle, $cb, $self) = @_;
  subname 'anyevent_read_type_reader' => sub {
    my $rbuf = \$handle->{rbuf};
    while (1) { # read all message from the buffer
      print STDERR "Before: ", (unpack 'H*', $$rbuf||''), "\n" if DEBUG;
      my $res = $self->read_one($rbuf);
      return unless ($res);
      print STDERR "After: ", (unpack 'H*', $$rbuf), "\n" if DEBUG;
      $handle->rtimeout($self->{discard_timeout}) if ($$rbuf && length $$rbuf);
      $res = $cb->($res);
    }
  }
}

1;

__END__