File Coverage

blib/lib/Net/MQTT/Message.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	24	24	100.0
condition			n/a
subroutine	17	17	100.0
pod	9	9	100.0
total	113	113	100.0

use strict;
use warnings;
package Net::MQTT::Message;
$Net::MQTT::Message::VERSION = '1.143250';
# ABSTRACT: Perl module to represent MQTT messages


use Net::MQTT::Constants qw/:all/;
use Module::Pluggable search_path => __PACKAGE__, require => 1;

our %types;
foreach (plugins()) {
  my $m = $_.'::message_type';
  next unless (defined &{$m}); # avoid super classes
  my $t = $_->message_type;
  if (exists $types{$t}) {
    die 'Duplicate message_type number ', $t, ":\n",
      '  ', $_, " and\n",
        '  ', $types{$t}, "\n";
  }
  $types{$t} = $_;
}


sub new {
  my ($pkg, %p) = @_;
  my $type_pkg =
    exists $types{$p{message_type}} ? $types{$p{message_type}} : $pkg;
  bless { %p }, $type_pkg;
}


sub new_from_bytes {
  my ($pkg, $bytes, $splice) = @_;
  my %p;
  return if (length $bytes < 2);
  my $offset = 0;
  my $b = decode_byte($bytes, \$offset);
  $p{message_type} = ($b&0xf0) >> 4;
  $p{dup} = ($b&0x8)>>3;
  $p{qos} = ($b&0x6)>>1;
  $p{retain} = ($b&0x1);
  my $length;
  eval {
    $length = decode_remaining_length($bytes, \$offset);
  };
  return if ($@);
  if (length $bytes < $offset+$length) {
    return
  }
  substr $_[1], 0, $offset+$length, '' if ($splice);
  $p{remaining} = substr $bytes, $offset, $length;
  my $self = $pkg->new(%p);
  $self->_parse_remaining();
  $self;
}

sub _parse_remaining {
}


sub message_type { shift->{message_type} }


sub dup { shift->{dup} || 0 }


sub qos {
  my $self = shift;
  defined $self->{qos} ? $self->{qos} : $self->_default_qos
}

sub _default_qos {
  MQTT_QOS_AT_MOST_ONCE
}


sub retain { shift->{retain} || 0 }


sub remaining { shift->{remaining} || '' }

sub _remaining_string {
  my ($self, $prefix) = @_;
  dump_string($self->remaining, $prefix);
}

sub _remaining_bytes { shift->remaining }


sub string {
  my ($self, $prefix) = @_;
  $prefix = '' unless (defined $prefix);
  my @attr;
  push @attr, qos_string($self->qos);
  foreach (qw/dup retain/) {
    my $bool = $self->$_;
    push @attr, $_ if ($bool);
  }
  my $r = $self->_remaining_string($prefix);
  $prefix.message_type_string($self->message_type).
    '/'.(join ',', @attr).($r ? ' '.$r : '')
}


sub bytes {
  my ($self) = shift;
  my $o = '';
  my $b =
    ($self->message_type << 4) | ($self->dup << 3) |
      ($self->qos << 1) | $self->retain;
  $o .= encode_byte($b);
  my $remaining = $self->_remaining_bytes;
  $o .= encode_remaining_length(length $remaining);
  $o .= $remaining;
  $o;
}

1;

__END__