File Coverage

blib/lib/Device/CurrentCost/Message.pm

Criterion	Covered	Total	%
statement	115	115	100.0
branch	47	48	97.9
condition	2	2	100.0
subroutine	30	30	100.0
pod	21	21	100.0
total	215	216	99.5

use strict;
use warnings;
package Device::CurrentCost::Message;
$Device::CurrentCost::Message::VERSION = '1.142240';
# ABSTRACT: Perl modules for Current Cost energy monitor messages


use constant DEBUG => $ENV{DEVICE_CURRENT_COST_DEBUG};

use Carp qw/croak carp/;
use Device::CurrentCost::Constants;
use List::Util qw/min/;


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


sub device_type {
  my $self = shift;
  return $self->{device_type} if (exists $self->{device_type});
  $self->{device_type} =
    $self->message =~ m!! ? CURRENT_COST_CLASSIC : CURRENT_COST_ENVY;
}


sub device {
  my $self = shift;
  return $self->{device}->[0] if (exists $self->{device});
  $self->_find_device->[0]
}


sub device_version {
  my $self = shift;
  return $self->{device}->[1] if (exists $self->{device});
  $self->_find_device->[1]
}

sub _find_device {
  my $self = shift;
  my $name = $self->_parse_field('name');
  $self->{device} =
    defined $name ?
      [ $name, 'v'.$self->_parse_field('sver')] :
        [ split /-/, $self->_parse_field('src'), 2 ];
}


sub message { shift->{message} }

sub _parse_field {
  my ($self, $field, $default) = @_;
  return $self->{$field} if (exists $self->{$field});
  if ($self->message =~ m!<$field>(.*?)!s) {
    my $v = $1;
    $self->{$field} =
      ($v =~ m!<([^>]+)>(.*?)!s) ? { value => $2, units => $1 } : $v;
  } elsif (defined $default) {
    return $default;
  } else {
    return
  }
}


sub dsb { shift->_parse_field('dsb') }



sub days_since_boot { shift->dsb }


sub time {
  my $self = shift;
  my $time = $self->_parse_field('time');
  return $time if (defined $time);
  $self->{time} =
    $self->_parse_field('hr').':'.
      $self->_parse_field('min').':'.
        $self->_parse_field('sec')
}


sub time_in_seconds {
  my $self = shift;
  return $self->{time_in_seconds} if (exists $self->{time_in_seconds});
  my ($h, $m, $s) = split /:/, $self->time, 3;
  $self->{time_in_seconds} = $h*3600 + $m*60 + $s;
}


sub boot_time {
  my $self = shift;
  $self->days_since_boot * 86400 + $self->time_in_seconds
}


sub sensor { shift->_parse_field('sensor', 0) }


sub id { shift->_parse_field('id') }


sub type { shift->_parse_field('type') }


sub tmpr { shift->_parse_field('tmpr') }


sub temperature { shift->tmpr }


sub has_history { shift->message =~ // }


sub has_readings { shift->message =~ // }


sub units {
  my $self = shift;
  my $ch1 = $self->_parse_field('ch1') or return;
  $ch1->{units}
}


sub value {
  my ($self, $channel) = @_;
  $self->units || return; # return if no units can be found - historic only
  if ($channel) {
    return $self->_parse_field('ch'.$channel, { value => undef })->{value};
  }
  return $self->{total} if (exists $self->{total});
  foreach (1 .. 3) {
    $self->{total} += $self->value($_)||0;
  }
  $self->{total}
}


sub summary {
  my ($self, $prefix) = @_;
  $prefix = '' unless (defined $prefix);
  my $str = $prefix.'Device: '.$self->device.' '.$self->device_version."\n";
  $prefix .= '  ';
  if ($self->has_readings) {
    $str .= $prefix.'Sensor: '.$self->sensor;
    $str .= (' ['.$self->id.','.$self->type."]\n".
             $prefix.'Total: '.$self->value.' '.$self->units."\n");
    foreach my $phase (1..3) {
      my $v = $self->value($phase);
      next unless (defined $v);
      $str .= $prefix.'Phase '.$phase.': '.($v+0)." ".$self->units."\n";
    }
  }
  if ($self->has_history) {
    $str .= $prefix."History\n";
    my $hist = $self->history;
    foreach my $sensor (sort keys %$hist) {
      $str .= $prefix.'  Sensor '.$sensor."\n";
      foreach my $span (sort keys %{$hist->{$sensor}}) {
        foreach my $age (sort { $a <=> $b } keys %{$hist->{$sensor}->{$span}}) {
          $str .= $prefix.'    -'.$age.' '.$span.': '.
            (0+$hist->{$sensor}->{$span}->{$age})."\n";
        }
      }
    }
  }
  $str
}


sub history {
  my $self = shift;
  return $self->{history} if (exists $self->{history});
  my %hist = ();
  $self->{history} = \%hist;
  return $self->{history} unless ($self->has_history);
  my $xml = $self->message;
  if ($xml =~ //) {
    # envy
    foreach my $data (split qr!!, $xml) {
      my ($sensor) = ($data =~ /(\d+)
      my %rec = ();
      $hist{$sensor} = _parse_history($data);
    }
  } else {
    # classic
    $hist{$self->sensor} = _parse_history($xml);
  }
  \%hist;
}

sub _parse_history {
  my $string = shift;
  my %rec = ();
  foreach my $span (qw/hours days months years/) {
    my $first = substr $span, 0, 1;
    while ($string =~ m!<$first(\d+)>([^<]+)!mg) {
      $rec{$span}->{0+$1} = 0+$2;
    }
  }
  \%rec;
}

1;

=pod

=encoding UTF-8

=head1 NAME

Device::CurrentCost::Message - Perl modules for Current Cost energy monitor messages

=head1 VERSION

version 1.142240

=head1 SYNOPSIS

  use Device::CurrentCost::Message;
  my $msg = Device::CurrentCost::Message->new(message => '...');
  print 'Device: ', $msg->device, ' ', $msg->device_version, "\n";
  if ($msg->has_readings) {
    print 'Sensor: ', $msg->sensor, '.', $msg->id, ' (', $msg->type, ")\n";
    print 'Total: ', $msg->value, ' ', $msg->units, "\n";
    foreach my $phase (1..3) {
      print 'Phase ', $phase, ': ',
        $msg->value($phase)+0, " ", $msg->units, "\n";
    }
  }

  use Data::Dumper;
  print Data::Dumper->Dump([$msg->history]) if ($msg->has_history);

  # or
  print $msg->summary, "\n";

=head1 DESCRIPTION

=head1 METHODS

=head2 C

This constructor returns a new Current Cost message object.
The supported parameters are:

=over

=item message

The message data.  Usually a string like 'C<< ... >>'.
This parameter is required.

=back

=head2 C

Returns the type of the device that created the message.

=head2 C

Returns the name of the device that created the message.

=head2 C

Returns the version of the device that created the message.

=head2 C

Returns the raw data of the message.

=head2 C

Returns the days since boot field of the message.

=head2 C

Returns the days since boot field of the message.

=head2 C

Returns the time field of the message in C format.

=head2 C

Returns the time field of the message in seconds.

=head2 C

Returns the time since boot reported by the message in seconds.

=head2 C

Returns the sensor number field of the message.  A classic monitor
supports only one sensor so 0 is returned.

=head2 C

Returns the id field of the message.

=head2 C

Returns the sensor type field of the message.

=head2 C

Returns the tmpr/temperature field of the message.

=head2 C

Returns the temperature field of the message.

=head2 C

Returns true if the message contains history data.

=head2 C

Returns true if the message contains current data.

=head2 C

Returns the units of the current data readings in the message.

=head2 C

Returns the value of the current data reading for the given channel
(phase) in the message.  If no channel is given then the total of all
the current data readings for all channels is returned.

=head2 C

Returns the string summary of the data in the message.  Each line of the
string is prefixed by the given prefix or the empty string if the prefix
is not supplied.

=head2 C

Returns a data structure contain any history data from the message.

=head1 AUTHOR

Mark Hindess

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Mark Hindess.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__END__