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 | } |