| File: | lib/Net/MQTT/Constants.pm |
| Coverage: | 98.2% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 3 3 3 | 3.95847846209746e+15 22 235 | use strict; | ||||
| 2 | 3 3 3 | 38 14 517 | use warnings; | ||||
| 3 | package Net::MQTT::Constants; | ||||||
| 4 | |||||||
| 5 | # ABSTRACT: Module to export constants for MQTT protocol | ||||||
| 6 | |||||||
| 7 - 15 | =head1 SYNOPSIS use Net::MQTT::Constants; =head1 DESCRIPTION Module to export constants for MQTT protocol. =cut | ||||||
| 16 | |||||||
| 17 | 3 3 3 | 40 19 1062 | use Carp qw/croak/; | ||||
| 18 | |||||||
| 19 | my %constants = | ||||||
| 20 | ( | ||||||
| 21 | MQTT_CONNECT => 0x1, | ||||||
| 22 | MQTT_CONNACK => 0x2, | ||||||
| 23 | MQTT_PUBLISH => 0x3, | ||||||
| 24 | MQTT_PUBACK => 0x4, | ||||||
| 25 | MQTT_PUBREC => 0x5, | ||||||
| 26 | MQTT_PUBREL => 0x6, | ||||||
| 27 | MQTT_PUBCOMP => 0x7, | ||||||
| 28 | MQTT_SUBSCRIBE => 0x8, | ||||||
| 29 | MQTT_SUBACK => 0x9, | ||||||
| 30 | MQTT_UNSUBSCRIBE => 0xa, | ||||||
| 31 | MQTT_UNSUBACK => 0xb, | ||||||
| 32 | MQTT_PINGREQ => 0xc, | ||||||
| 33 | MQTT_PINGRESP => 0xd, | ||||||
| 34 | MQTT_DISCONNECT => 0xe, | ||||||
| 35 | |||||||
| 36 | MQTT_QOS_AT_MOST_ONCE => 0x0, | ||||||
| 37 | MQTT_QOS_AT_LEAST_ONCE => 0x1, | ||||||
| 38 | MQTT_QOS_EXACTLY_ONCE => 0x2, | ||||||
| 39 | |||||||
| 40 | MQTT_CONNECT_ACCEPTED => 0, | ||||||
| 41 | MQTT_CONNECT_REFUSED_UNACCEPTABLE_PROTOCOL_VERSION => 1, | ||||||
| 42 | MQTT_CONNECT_REFUSED_IDENTIFIER_REJECTED => 2, | ||||||
| 43 | MQTT_CONNECT_REFUSED_SERVER_UNAVAILABLE => 3, | ||||||
| 44 | MQTT_CONNECT_REFUSED_BAD_USER_NAME_OR_PASSWORD => 4, | ||||||
| 45 | MQTT_CONNECT_REFUSED_NOT_AUTHORIZED => 5, | ||||||
| 46 | ); | ||||||
| 47 | |||||||
| 48 | sub import { | ||||||
| 49 | 3 3 3 | 42 27 6760 | no strict qw/refs/; ## no critic | ||||
| 50 | 42 | 461 | my $pkg = caller(0); | ||||
| 51 | 42 | 829 | foreach (keys %constants) { | ||||
| 52 | 966 | 4783 | my $v = $constants{$_}; | ||||
| 53 | 966 966 0 | 19126 15405 0 | *{$pkg.'::'.$_} = sub () { $v }; | ||||
| 54 | } | ||||||
| 55 | 42 | 473 | foreach (qw/decode_byte encode_byte | ||||
| 56 | decode_short encode_short | ||||||
| 57 | decode_string encode_string | ||||||
| 58 | decode_remaining_length encode_remaining_length | ||||||
| 59 | qos_string | ||||||
| 60 | message_type_string | ||||||
| 61 | dump_string | ||||||
| 62 | connect_return_code_string | ||||||
| 63 | /) { | ||||||
| 64 | 504 504 504 | 1918 34291 4017 | *{$pkg.'::'.$_} = \&{$_}; | ||||
| 65 | } | ||||||
| 66 | } | ||||||
| 67 | |||||||
| 68 - 76 | =head1 C<FUNCTIONS> =head2 C<decode_remaining_length( $data, \$offset )> Calculates the C<remaining length> from the bytes in C<$data> starting at the offset read from the scalar reference. The offset reference is subsequently incremented by the number of bytes processed. =cut | ||||||
| 77 | |||||||
| 78 | sub decode_remaining_length { | ||||||
| 79 | 25 | 247 | my ($data, $offset) = @_; | ||||
| 80 | 25 | 157 | my $multiplier = 1; | ||||
| 81 | 25 | 140 | my $v = 0; | ||||
| 82 | 25 | 133 | my $d; | ||||
| 83 | 25 | 164 | do { | ||||
| 84 | 30 | 236 | $d = decode_byte($data, $offset); | ||||
| 85 | 28 | 232 | $v += ($d&0x7f) * $multiplier; | ||||
| 86 | 28 | 350 | $multiplier *= 128; | ||||
| 87 | } while ($d&0x80); | ||||||
| 88 | 23 | 648 | $v | ||||
| 89 | } | ||||||
| 90 | |||||||
| 91 - 96 | =head2 C<encode_remaining_length( $length )> Calculates the C<remaining length> bytes from the length, C<$length>, and returns the packed bytes as a string. =cut | ||||||
| 97 | |||||||
| 98 | sub encode_remaining_length { | ||||||
| 99 | 42 | 313 | my $v = shift; | ||||
| 100 | 42 | 227 | my $o; | ||||
| 101 | 42 | 281 | my $d; | ||||
| 102 | 42 | 259 | do { | ||||
| 103 | 44 | 302 | $d = $v % 128; | ||||
| 104 | 44 | 368 | $v = int($v/128); | ||||
| 105 | 44 | 370 | if ($v) { | ||||
| 106 | 2 | 15 | $d |= 0x80; | ||||
| 107 | } | ||||||
| 108 | 44 | 340 | $o .= encode_byte($d); | ||||
| 109 | } while ($d&0x80); | ||||||
| 110 | 42 | 1166 | $o; | ||||
| 111 | } | ||||||
| 112 | |||||||
| 113 - 119 | =head2 C<decode_byte( $data, \$offset )> Returns a byte by unpacking it from C<$data> starting at the offset read from the scalar reference. The offset reference is subsequently incremented by the number of bytes processed. =cut | ||||||
| 120 | |||||||
| 121 | sub decode_byte { | ||||||
| 122 | 68 | 1686 | my ($data, $offset) = @_; | ||||
| 123 | 68 | 2348 | croak 'decode_byte: insufficient data' unless (length $data >= $$offset+1); | ||||
| 124 | 65 | 820 | my $res = unpack 'C', substr $data, $$offset, 1; | ||||
| 125 | 65 | 430 | $$offset++; | ||||
| 126 | 65 | 1264 | $res | ||||
| 127 | } | ||||||
| 128 | |||||||
| 129 - 133 | =head2 C<encode_byte( $byte )> Returns a packed byte. =cut | ||||||
| 134 | |||||||
| 135 | sub encode_byte { | ||||||
| 136 | 110 | 3384 | pack 'C', $_[0]; | ||||
| 137 | } | ||||||
| 138 | |||||||
| 139 - 145 | =head2 C<decode_short( $data, \$offset )> Returns a short (two bytes) by unpacking it from C<$data> starting at the offset read from the scalar reference. The offset reference is subsequently incremented by the number of bytes processed. =cut | ||||||
| 146 | |||||||
| 147 | sub decode_short { | ||||||
| 148 | 29 | 7651 | my ($data, $offset) = @_; | ||||
| 149 | 29 | 394 | croak 'decode_short: insufficient data' unless (length $data >= $$offset+2); | ||||
| 150 | 27 | 294 | my $res = unpack 'n', substr $data, $$offset, 2; | ||||
| 151 | 27 | 179 | $$offset += 2; | ||||
| 152 | 27 | 442 | $res; | ||||
| 153 | } | ||||||
| 154 | |||||||
| 155 - 159 | =head2 C<encode_short( $short )> Returns a packed short (two bytes). =cut | ||||||
| 160 | |||||||
| 161 | sub encode_short { | ||||||
| 162 | 24 | 756 | pack 'n', $_[0]; | ||||
| 163 | } | ||||||
| 164 | |||||||
| 165 - 172 | =head2 C<decode_string( $data, \$offset )> Returns a string (short length followed by length bytes) by unpacking it from C<$data> starting at the offset read from the scalar reference. The offset reference is subsequently incremented by the number of bytes processed. =cut | ||||||
| 173 | |||||||
| 174 | sub decode_string { | ||||||
| 175 | 16 | 4319 | my ($data, $offset) = @_; | ||||
| 176 | 16 | 128 | my $len = decode_short($data, $offset); | ||||
| 177 | 15 | 171 | croak 'decode_string: insufficient data' | ||||
| 178 | unless (length $data >= $$offset+$len); | ||||||
| 179 | 14 | 90 | my $res = substr $data, $$offset, $len; | ||||
| 180 | 14 | 75 | $$offset += $len; | ||||
| 181 | 14 | 397 | $res; | ||||
| 182 | } | ||||||
| 183 | |||||||
| 184 - 189 | =head2 C<encode_string( $string )> Returns a packed string (length as a short and then the bytes of the string). =cut | ||||||
| 190 | |||||||
| 191 | sub encode_string { | ||||||
| 192 | 28 | 901 | pack "n/a*", $_[0]; | ||||
| 193 | } | ||||||
| 194 | |||||||
| 195 - 199 | =head2 C<qos_string( $qos_value )> Returns a string describing the given QoS value. =cut | ||||||
| 200 | |||||||
| 201 | sub qos_string { | ||||||
| 202 | 48 | 1974 | [qw/at-most-once at-least-once exactly-once reserved/]->[$_[0]] | ||||
| 203 | } | ||||||
| 204 | |||||||
| 205 - 209 | =head2 C<message_type_string( $message_type_value )> Returns a string describing the given C<message_type> value. =cut | ||||||
| 210 | |||||||
| 211 | sub message_type_string { | ||||||
| 212 | 42 | 2613 | [qw/Reserved0 Connect ConnAck Publish PubAck PubRec PubRel PubComp | ||||
| 213 | Subscribe SubAck Unsubscribe UnsubAck PingReq PingResp Disconnect | ||||||
| 214 | Reserved15/]->[$_[0]]; | ||||||
| 215 | } | ||||||
| 216 | |||||||
| 217 - 222 | =head2 C<dump_string( $data )> Returns a string representation of arbitrary data - as a string if it contains only printable characters or as a hex dump otherwise. =cut | ||||||
| 223 | |||||||
| 224 | sub dump_string { | ||||||
| 225 | 42 | 779 | my $data = shift || ''; | ||||
| 226 | 42 | 763 | my $prefix = shift || ''; | ||||
| 227 | 42 | 251 | $prefix .= ' '; | ||||
| 228 | 42 | 209 | my @lines; | ||||
| 229 | 42 | 425 | while (length $data) { | ||||
| 230 | 26 | 203 | my $d = substr $data, 0, 16, ''; | ||||
| 231 | 26 | 274 | my $line = unpack 'H*', $d; | ||||
| 232 | 26 | 1982 | $line =~ s/([A-F0-9]{2})/$1 /ig; | ||||
| 233 | 26 | 300 | $d =~ s/[^ -~]/./g; | ||||
| 234 | 26 | 407 | $line = sprintf "%-48s %s", $line, $d; | ||||
| 235 | 26 | 320 | push @lines, $line | ||||
| 236 | } | ||||||
| 237 | 42 | 1578 | scalar @lines ? "\n".$prefix.(join "\n".$prefix, @lines) : '' | ||||
| 238 | } | ||||||
| 239 | |||||||
| 240 | |||||||
| 241 - 245 | =head2 C<connect_return_code_string( $return_code_value )> Returns a string describing the given C<connect_return_code> value. =cut | ||||||
| 246 | |||||||
| 247 | sub connect_return_code_string { | ||||||
| 248 | [ | ||||||
| 249 | 4 | 316 | 'Connection Accepted', | ||||
| 250 | 'Connection Refused: unacceptable protocol version', | ||||||
| 251 | 'Connection Refused: identifier rejected', | ||||||
| 252 | 'Connection Refused: server unavailable', | ||||||
| 253 | 'Connection Refused: bad user name or password', | ||||||
| 254 | 'Connection Refused: not authorized', | ||||||
| 255 | ]->[$_[0]] || 'Reserved' | ||||||
| 256 | } | ||||||