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