File Coverage

blib/lib/Net/MQTT/Message.pm
Criterion Covered Total %
statement 62 62 100.0
branch 24 24 100.0
condition n/a
subroutine 17 17 100.0
pod 9 9 100.0
total 112 112 100.0


line stmt bran cond sub pod time code
1 3     3   3205 use strict;
  3         6  
  3         114  
2 3     3   15 use warnings;
  3         5  
  3         222  
3             package Net::MQTT::Message;
4             $Net::MQTT::Message::VERSION = '1.163170';
5             # ABSTRACT: Perl module to represent MQTT messages
6              
7              
8 3     3   19 use Net::MQTT::Constants qw/:all/;
  3         11  
  3         26  
9 3     3   1942 use Module::Pluggable search_path => __PACKAGE__, require => 1;
  3         34955  
  3         23  
10              
11             our %types;
12             foreach (plugins()) {
13             my $m = $_.'::message_type';
14             next unless (defined &{$m}); # avoid super classes
15             my $t = $_->message_type;
16             if (exists $types{$t}) {
17             die 'Duplicate message_type number ', $t, ":\n",
18             ' ', $_, " and\n",
19             ' ', $types{$t}, "\n";
20             }
21             $types{$t} = $_;
22             }
23              
24              
25             sub new {
26 43     43 1 10656 my ($pkg, %p) = @_;
27             my $type_pkg =
28 43 100       176 exists $types{$p{message_type}} ? $types{$p{message_type}} : $pkg;
29 43         252 bless { %p }, $type_pkg;
30             }
31              
32              
33             sub new_from_bytes {
34 26     26 1 21888 my ($pkg, $bytes, $splice) = @_;
35 26         44 my %p;
36 26 100       108 return if (length $bytes < 2);
37 25         36 my $offset = 0;
38 25         84 my $b = decode_byte($bytes, \$offset);
39 25         70 $p{message_type} = ($b&0xf0) >> 4;
40 25         42 $p{dup} = ($b&0x8)>>3;
41 25         44 $p{qos} = ($b&0x6)>>1;
42 25         41 $p{retain} = ($b&0x1);
43 25         27 my $length;
44 25         33 eval {
45 25         66 $length = decode_remaining_length($bytes, \$offset);
46             };
47 25 100       137 return if ($@);
48 23 100       56 if (length $bytes < $offset+$length) {
49             return
50 2         14 }
51 21 100       64 substr $_[1], 0, $offset+$length, '' if ($splice);
52 21         49 $p{remaining} = substr $bytes, $offset, $length;
53 21         77 my $self = $pkg->new(%p);
54 21         131 $self->_parse_remaining();
55 21         65 $self;
56             }
57              
58       6     sub _parse_remaining {
59             }
60              
61              
62 4     4 1 21 sub message_type { shift->{message_type} }
63              
64              
65 84 100   84 1 464 sub dup { shift->{dup} || 0 }
66              
67              
68             sub qos {
69 94     94 1 97 my $self = shift;
70 94 100       376 defined $self->{qos} ? $self->{qos} : $self->_default_qos
71             }
72              
73             sub _default_qos {
74 36     36   102 MQTT_QOS_AT_MOST_ONCE
75             }
76              
77              
78 84 100   84 1 288 sub retain { shift->{retain} || 0 }
79              
80              
81 50 100   50 1 225 sub remaining { shift->{remaining} || '' }
82              
83             sub _remaining_string {
84 38     38   59 my ($self, $prefix) = @_;
85 38         101 dump_string($self->remaining, $prefix);
86             }
87              
88 12     12   27 sub _remaining_bytes { shift->remaining }
89              
90              
91             sub string {
92 42     42 1 2015 my ($self, $prefix) = @_;
93 42 100       133 $prefix = '' unless (defined $prefix);
94 42         50 my @attr;
95 42         112 push @attr, qos_string($self->qos);
96 42         108 foreach (qw/dup retain/) {
97 84         220 my $bool = $self->$_;
98 84 100       217 push @attr, $_ if ($bool);
99             }
100 42         141 my $r = $self->_remaining_string($prefix);
101 42 100       178 $prefix.message_type_string($self->message_type).
102             '/'.(join ',', @attr).($r ? ' '.$r : '')
103             }
104              
105              
106             sub bytes {
107 42     42 1 85 my ($self) = shift;
108 42         48 my $o = '';
109 42         106 my $b =
110             ($self->message_type << 4) | ($self->dup << 3) |
111             ($self->qos << 1) | $self->retain;
112 42         116 $o .= encode_byte($b);
113 42         143 my $remaining = $self->_remaining_bytes;
114 42         124 $o .= encode_remaining_length(length $remaining);
115 42         61 $o .= $remaining;
116 42         157 $o;
117             }
118              
119             1;
120              
121             __END__