File Coverage

blib/lib/Net/MQTT/Constants.pm

Criterion	Covered	Total	%
statement	73	74	98.6
branch	12	12	100.0
condition	4	4	100.0
subroutine	17	18	94.4
pod	12	12	100.0
total	118	120	98.3

use strict;
use warnings;
package Net::MQTT::Constants;
$Net::MQTT::Constants::VERSION = '1.143250';
# ABSTRACT: Module to export constants for MQTT protocol


use Carp qw/croak/;

my %constants =
  (
   MQTT_CONNECT     => 0x1,
   MQTT_CONNACK     => 0x2,
   MQTT_PUBLISH     => 0x3,
   MQTT_PUBACK      => 0x4,
   MQTT_PUBREC      => 0x5,
   MQTT_PUBREL      => 0x6,
   MQTT_PUBCOMP     => 0x7,
   MQTT_SUBSCRIBE   => 0x8,
   MQTT_SUBACK      => 0x9,
   MQTT_UNSUBSCRIBE => 0xa,
   MQTT_UNSUBACK    => 0xb,
   MQTT_PINGREQ     => 0xc,
   MQTT_PINGRESP    => 0xd,
   MQTT_DISCONNECT  => 0xe,

   MQTT_QOS_AT_MOST_ONCE  => 0x0,
   MQTT_QOS_AT_LEAST_ONCE => 0x1,
   MQTT_QOS_EXACTLY_ONCE  => 0x2,

   MQTT_CONNECT_ACCEPTED                              => 0,
   MQTT_CONNECT_REFUSED_UNACCEPTABLE_PROTOCOL_VERSION => 1,
   MQTT_CONNECT_REFUSED_IDENTIFIER_REJECTED           => 2,
   MQTT_CONNECT_REFUSED_SERVER_UNAVAILABLE            => 3,
   MQTT_CONNECT_REFUSED_BAD_USER_NAME_OR_PASSWORD     => 4,
   MQTT_CONNECT_REFUSED_NOT_AUTHORIZED                => 5,
  );

sub import {
  no strict qw/refs/; ## no critic
  my $pkg = caller(0);
  foreach (keys %constants) {
    my $v = $constants{$_};
    *{$pkg.'::'.$_} = sub () { $v };
  }
  foreach (qw/decode_byte encode_byte
              decode_short encode_short
              decode_string encode_string
              decode_remaining_length encode_remaining_length
              qos_string
              message_type_string
              dump_string
              connect_return_code_string
             /) {
    *{$pkg.'::'.$_} = \&{$_};
  }
}


sub decode_remaining_length {
  my ($data, $offset) = @_;
  my $multiplier = 1;
  my $v = 0;
  my $d;
  do {
    $d = decode_byte($data, $offset);
    $v += ($d&0x7f) * $multiplier;
    $multiplier *= 128;
  } while ($d&0x80);
  $v
}


sub encode_remaining_length {
  my $v = shift;
  my $o;
  my $d;
  do {
    $d = $v % 128;
    $v = int($v/128);
    if ($v) {
      $d |= 0x80;
    }
    $o .= encode_byte($d);
  } while ($d&0x80);
  $o;
}


sub decode_byte {
  my ($data, $offset) = @_;
  croak 'decode_byte: insufficient data' unless (length $data >= $$offset+1);
  my $res = unpack 'C', substr $data, $$offset, 1;
  $$offset++;
  $res
}


sub encode_byte {
  pack 'C', $_[0];
}


sub decode_short {
  my ($data, $offset) = @_;
  croak 'decode_short: insufficient data' unless (length $data >= $$offset+2);
  my $res = unpack 'n', substr $data, $$offset, 2;
  $$offset += 2;
  $res;
}


sub encode_short {
  pack 'n', $_[0];
}


sub decode_string {
  my ($data, $offset) = @_;
  my $len = decode_short($data, $offset);
  croak 'decode_string: insufficient data'
    unless (length $data >= $$offset+$len);
  my $res = substr $data, $$offset, $len;
  $$offset += $len;
  $res;
}


sub encode_string {
  pack "n/a*", $_[0];
}


sub qos_string {
  [qw/at-most-once at-least-once exactly-once reserved/]->[$_[0]]
}


sub message_type_string {
  [qw/Reserved0 Connect ConnAck Publish PubAck PubRec PubRel PubComp
      Subscribe SubAck Unsubscribe UnsubAck PingReq PingResp Disconnect
      Reserved15/]->[$_[0]];
}


sub dump_string {
  my $data = shift || '';
  my $prefix = shift || '';
  $prefix .= '  ';
  my @lines;
  while (length $data) {
    my $d = substr $data, 0, 16, '';
    my $line = unpack 'H*', $d;
    $line =~ s/([A-F0-9]{2})/$1 /ig;
    $d =~ s/[^ -~]/./g;
    $line = sprintf "%-48s %s", $line, $d;
    push @lines, $line
  }
  scalar @lines ? "\n".$prefix.(join "\n".$prefix, @lines) : ''
}



sub connect_return_code_string {
  [
   'Connection Accepted',
   'Connection Refused: unacceptable protocol version',
   'Connection Refused: identifier rejected',
   'Connection Refused: server unavailable',
   'Connection Refused: bad user name or password',
   'Connection Refused: not authorized',
  ]->[$_[0]] || 'Reserved'
}

__END__