File: | lib/Net/MQTT/Message.pm |
Coverage: | 98.1% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 3 3 3 | 1283656 25 251 | use strict; | ||||
2 | 3 3 3 | 43 19 505 | use warnings; | ||||
3 | package Net::MQTT::Message; | ||||||
4 | |||||||
5 | # ABSTRACT: Perl module to represent MQTT messages | ||||||
6 | |||||||
7 - 25 | =head1 SYNOPSIS use Net::MQTT::Constants; use Net::MQTT::Message; use IO::Socket::INET; my $socket = IO::Socket::INET->new(PeerAddr => '127.0.0.1:1883'); my $mqtt = Net::MQTT::Message->new(message_type => MQTT_CONNECT); print $socket $mqtt->bytes; my $tcp_payload = pack 'H*', '300d000774657374696e6774657374'; $mqtt = Net::MQTT::Message->new_from_bytes($tcp_payload); print 'Received: ', $mqtt->string, "\n"; =head1 DESCRIPTION This module encapsulates a single MQTT message. It uses subclasses to represent specific message types. =cut | ||||||
26 | |||||||
27 | 3 3 3 | 45 16 96 | use Net::MQTT::Constants qw/:all/; | ||||
28 | 3 3 3 | 1627 39476 101 | use Module::Pluggable search_path => __PACKAGE__, require => 1; | ||||
29 | |||||||
30 | our %types; | ||||||
31 | foreach (plugins()) { | ||||||
32 | my $m = $_.'::message_type'; | ||||||
33 | next unless (defined &{$m}); # avoid super classes | ||||||
34 | my $t = $_->message_type; | ||||||
35 | if (exists $types{$t}) { | ||||||
36 | die 'Duplicate message_type number ', $t, ":\n", | ||||||
37 | ' ', $_, " and\n", | ||||||
38 | ' ', $types{$t}, "\n"; | ||||||
39 | } | ||||||
40 | $types{$t} = $_; | ||||||
41 | } | ||||||
42 | |||||||
43 | =method C<new( %parameters )> | ||||||
44 | |||||||
45 | Constructs an L<Net::MQTT::Message> object based on the given | ||||||
46 | parameters. The common parameter keys are: | ||||||
47 | |||||||
48 - 80 | =over =item C<message_type> The message type field of the MQTT message. This should be an integer between 0 and 15 inclusive. The module L<Net::MQTT::Constants> provides constants that can be used for this value. This parameter is required. =item C<dup> The duplicate flag field of the MQTT message. This should be either 1 or 0. The default is 0. =item C<qos> The QoS field of the MQTT message. This should be an integer between 0 and 3 inclusive. The default is as specified in the spec or 0 ("at most once") otherwise. The module L<Net::MQTT::Constants> provides constants that can be used for this value. =item C<retain> The retain flag field of the MQTT message. This should be either 1 or 0. The default is 0. =back The remaining keys are dependent on the specific message type. The documentation for the subclasses for each message type list methods with the same name as the required keys. =cut | ||||||
81 | |||||||
82 | sub new { | ||||||
83 | 43 | 32138 | my ($pkg, %p) = @_; | ||||
84 | 43 | 782 | my $type_pkg = | ||||
85 | exists $types{$p{message_type}} ? $types{$p{message_type}} : $pkg; | ||||||
86 | 43 | 2439 | bless { %p }, $type_pkg; | ||||
87 | } | ||||||
88 | |||||||
89 | =method C<new_from_bytes( $packed_bytes, [ $splice ] )> | ||||||
90 | |||||||
91 | Attempts to constructs an L<Net::MQTT::Message> object based on | ||||||
92 | the given packed byte string. If there are insufficient bytes, then | ||||||
93 | undef is returned. If the splice parameter is provided and true, then | ||||||
94 | the processed bytes are removed from the scalar referenced by the | ||||||
95 | $packed_bytes parameter. | ||||||
96 | |||||||
97 | =cut | ||||||
98 | |||||||
99 | sub new_from_bytes { | ||||||
100 | 26 | 70941 | my ($pkg, $bytes, $splice) = @_; | ||||
101 | 26 | 192 | my %p; | ||||
102 | 26 | 383 | return if (length $bytes < 2); | ||||
103 | 25 | 186 | my $offset = 0; | ||||
104 | 25 | 810 | my $b = decode_byte($bytes, \$offset); | ||||
105 | 25 | 299 | $p{message_type} = ($b&0xf0) >> 4; | ||||
106 | 25 | 218 | $p{dup} = ($b&0x8)>>3; | ||||
107 | 25 | 303 | $p{qos} = ($b&0x6)>>1; | ||||
108 | 25 | 203 | $p{retain} = ($b&0x1); | ||||
109 | 25 | 154 | my $length; | ||||
110 | 25 | 201 | eval { | ||||
111 | 25 | 746 | $length = decode_remaining_length($bytes, \$offset); | ||||
112 | }; | ||||||
113 | 25 | 6906 | return if ($@); | ||||
114 | 23 | 239 | if (length $bytes < $offset+$length) { | ||||
115 | return | ||||||
116 | 2 | 70 | } | ||||
117 | 21 | 273 | substr $_[1], 0, $offset+$length, '' if ($splice); | ||||
118 | 21 | 254 | $p{remaining} = substr $bytes, $offset, $length; | ||||
119 | 21 | 375 | my $self = $pkg->new(%p); | ||||
120 | 21 | 685 | $self->_parse_remaining(); | ||||
121 | 21 | 652 | $self; | ||||
122 | } | ||||||
123 | |||||||
124 | 6 | 46 | sub _parse_remaining { | ||||
125 | } | ||||||
126 | |||||||
127 | =method C<message_type()> | ||||||
128 | |||||||
129 | Returns the message type field of the MQTT message. The module | ||||||
130 | L<Net::MQTT::Constants> provides a function, C<message_type_string>, | ||||||
131 | that can be used to convert this value to a human readable string. | ||||||
132 | |||||||
133 | =cut | ||||||
134 | |||||||
135 | 4 | 88 | sub message_type { shift->{message_type} } | ||||
136 | |||||||
137 | =method C<dup()> | ||||||
138 | |||||||
139 | The duplicate flag field of the MQTT message. | ||||||
140 | |||||||
141 | =cut | ||||||
142 | |||||||
143 | 84 | 2521 | sub dup { shift->{dup} || 0 } | ||||
144 | |||||||
145 | =method C<qos()> | ||||||
146 | |||||||
147 | The QoS field of the MQTT message. The module | ||||||
148 | L<Net::MQTT::Constants> provides a function, C<qos_string>, that | ||||||
149 | can be used to convert this value to a human readable string. | ||||||
150 | |||||||
151 | =cut | ||||||
152 | |||||||
153 | sub qos { | ||||||
154 | 94 | 711 | my $self = shift; | ||||
155 | 94 | 2246 | defined $self->{qos} ? $self->{qos} : $self->_default_qos | ||||
156 | } | ||||||
157 | |||||||
158 | sub _default_qos { | ||||||
159 | 36 | 866 | MQTT_QOS_AT_MOST_ONCE | ||||
160 | } | ||||||
161 | |||||||
162 | =method C<retain()> | ||||||
163 | |||||||
164 | The retain field of the MQTT message. | ||||||
165 | |||||||
166 | =cut | ||||||
167 | |||||||
168 | 84 | 1968 | sub retain { shift->{retain} || 0 } | ||||
169 | |||||||
170 | =method C<remaining()> | ||||||
171 | |||||||
172 | This contains a packed string of bytes with any of the payload of the | ||||||
173 | MQTT message that was not parsed by these modules. This should not | ||||||
174 | be required for packets that strictly follow the standard. | ||||||
175 | |||||||
176 | =cut | ||||||
177 | |||||||
178 | 50 | 1984 | sub remaining { shift->{remaining} || '' } | ||||
179 | |||||||
180 | sub _remaining_string { | ||||||
181 | 38 | 321 | my ($self, $prefix) = @_; | ||||
182 | 38 | 482 | dump_string($self->remaining, $prefix); | ||||
183 | } | ||||||
184 | |||||||
185 | 12 | 128 | sub _remaining_bytes { shift->remaining } | ||||
186 | |||||||
187 | =method C<string([ $prefix ])> | ||||||
188 | |||||||
189 | Returns a summary of the message as a string suitable for logging. | ||||||
190 | If provided, each line will be prefixed by the optional prefix. | ||||||
191 | |||||||
192 | =cut | ||||||
193 | |||||||
194 | sub string { | ||||||
195 | 42 | 5986 | my ($self, $prefix) = @_; | ||||
196 | 42 | 539 | $prefix = '' unless (defined $prefix); | ||||
197 | 42 | 238 | my @attr; | ||||
198 | 42 | 597 | push @attr, qos_string($self->qos); | ||||
199 | 42 | 502 | foreach (qw/dup retain/) { | ||||
200 | 84 | 1236 | my $bool = $self->$_; | ||||
201 | 84 | 912 | push @attr, $_ if ($bool); | ||||
202 | } | ||||||
203 | 42 | 1087 | my $r = $self->_remaining_string($prefix); | ||||
204 | 42 | 1237 | $prefix.message_type_string($self->message_type). | ||||
205 | '/'.(join ',', @attr).($r ? ' '.$r : '') | ||||||
206 | } | ||||||
207 | |||||||
208 | =method C<bytes()> | ||||||
209 | |||||||
210 | Returns the bytes of the message suitable for writing to a socket. | ||||||
211 | |||||||
212 | =cut | ||||||
213 | |||||||
214 | sub bytes { | ||||||
215 | 42 | 427 | my ($self) = shift; | ||||
216 | 42 | 337 | my $o = ''; | ||||
217 | 42 | 1233 | my $b = | ||||
218 | ($self->message_type << 4) | ($self->dup << 3) | | ||||||
219 | ($self->qos << 1) | $self->retain; | ||||||
220 | 42 | 1286 | $o .= encode_byte($b); | ||||
221 | 42 | 1167 | my $remaining = $self->_remaining_bytes; | ||||
222 | 42 | 1236 | $o .= encode_remaining_length(length $remaining); | ||||
223 | 42 | 331 | $o .= $remaining; | ||||
224 | 42 | 1391 | $o; | ||||
225 | } | ||||||
226 | |||||||
227 | =method C<attributes()> | ||||||
228 | |||||||
229 | Returns list of attributes for this message type. | ||||||
230 | |||||||
231 | =cut | ||||||
232 | |||||||
233 | sub attributes { | ||||||
234 | 0 | qw/message_type qos dup retain/ | |||||
235 | } | ||||||
236 | |||||||
237 | 1; |