File Coverage

File:lib/Net/MQTT/Message.pm
Coverage:98.1%

linestmtbrancondsubpodtimecode
1
3
3
3
1283656
25
251
use strict;
2
3
3
3
43
19
505
use warnings;
3package 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
30our %types;
31foreach (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
45Constructs an L<Net::MQTT::Message> object based on the given
46parameters. 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
82sub 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
91Attempts to constructs an L<Net::MQTT::Message> object based on
92the given packed byte string. If there are insufficient bytes, then
93undef is returned. If the splice parameter is provided and true, then
94the processed bytes are removed from the scalar referenced by the
95$packed_bytes parameter.
96
97=cut
98
99sub 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
129Returns the message type field of the MQTT message. The module
130L<Net::MQTT::Constants> provides a function, C<message_type_string>,
131that 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
139The 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
147The QoS field of the MQTT message. The module
148L<Net::MQTT::Constants> provides a function, C<qos_string>, that
149can be used to convert this value to a human readable string.
150
151=cut
152
153sub qos {
154
94
711
  my $self = shift;
155
94
2246
  defined $self->{qos} ? $self->{qos} : $self->_default_qos
156}
157
158sub _default_qos {
159
36
866
  MQTT_QOS_AT_MOST_ONCE
160}
161
162=method C<retain()>
163
164The retain field of the MQTT message.
165
166=cut
167
168
84
1968
sub retain { shift->{retain} || 0 }
169
170=method C<remaining()>
171
172This contains a packed string of bytes with any of the payload of the
173MQTT message that was not parsed by these modules. This should not
174be required for packets that strictly follow the standard.
175
176=cut
177
178
50
1984
sub remaining { shift->{remaining} || '' }
179
180sub _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
189Returns a summary of the message as a string suitable for logging.
190If provided, each line will be prefixed by the optional prefix.
191
192=cut
193
194sub 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
210Returns the bytes of the message suitable for writing to a socket.
211
212=cut
213
214sub 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
229Returns list of attributes for this message type.
230
231=cut
232
233sub attributes {
234
0
  qw/message_type qos dup retain/
235}
236
2371;