File: | lib/Net/MQTT/TopicStore.pm |
Coverage: | 90.7% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 1 1 1 | 1.31949281916583e+15 8 78 | use strict; | ||||
2 | 1 1 1 | 12 5 1208 | use warnings; | ||||
3 | package Net::MQTT::TopicStore; | ||||||
4 | |||||||
5 | # ABSTRACT: Perl module to represent MQTT topic store | ||||||
6 | |||||||
7 - 24 | =head1 SYNOPSIS use Net::MQTT::TopicStore; my $topic_store = Net::MQTT::TopicStore->new(); $topic_store->add($topic_pattern1); $topic_store->add($topic_pattern2); my @topics = @{ $topic->get($topic) }; $topic_store->remove($topic_pattern2); =head1 DESCRIPTION This module encapsulates a single MQTT topic store. =method C<new( )> Constructs a L<Net::MQTT::TopicStore> object. =cut | ||||||
25 | |||||||
26 | sub new { | ||||||
27 | 9 | 642246 | my $pkg = shift; | ||||
28 | 9 | 201 | my $self = bless { topics => { } }, $pkg; | ||||
29 | 9 9 | 103 115 | $self->add($_) foreach (@_); | ||||
30 | 9 | 322 | $self | ||||
31 | } | ||||||
32 | |||||||
33 | =method C<add( $topic_pattern )> | ||||||
34 | |||||||
35 | Adds the topic pattern to the store. | ||||||
36 | |||||||
37 | =cut | ||||||
38 | |||||||
39 | sub add { | ||||||
40 | 10 | 95 | my ($self, $topic_pattern) = @_; | ||||
41 | 10 | 152 | unless (exists $self->{topics}->{$topic_pattern}) { | ||||
42 | 10 | 109 | $self->{topics}->{$topic_pattern} = _topic_to_regexp($topic_pattern); | ||||
43 | } | ||||||
44 | $topic_pattern | ||||||
45 | 10 | 164 | } | ||||
46 | |||||||
47 | =method C<delete( $topic_pattern )> | ||||||
48 | |||||||
49 | Remove the topic pattern from the store. | ||||||
50 | |||||||
51 | =cut | ||||||
52 | |||||||
53 | sub delete { | ||||||
54 | 0 | 0 | my ($self, $topic) = @_; | ||||
55 | 0 | 0 | delete $self->{topics}->{$topic}; | ||||
56 | } | ||||||
57 | |||||||
58 | =method C<values( $topic )> | ||||||
59 | |||||||
60 | Returns all the topic patterns in the store that apply to the given topic. | ||||||
61 | |||||||
62 | =cut | ||||||
63 | |||||||
64 | sub values { | ||||||
65 | 19 | 12912 | my ($self, $topic) = @_; | ||||
66 | 19 | 143 | my @res = (); | ||||
67 | 19 19 | 114 328 | foreach my $t (keys %{$self->{topics}}) { | ||||
68 | 20 | 178 | my $re = $self->{topics}->{$t}; | ||||
69 | 20 | 631 | next unless (defined $re ? $topic =~ $re : $topic eq $t); | ||||
70 | 13 | 167 | push @res, $t; | ||||
71 | } | ||||||
72 | 19 | 549 | return \@res; | ||||
73 | } | ||||||
74 | |||||||
75 | sub _topic_to_regexp { | ||||||
76 | 10 | 74 | my $topic = shift; | ||||
77 | 10 | 66 | my $c; | ||||
78 | 10 | 81 | $topic = quotemeta $topic; | ||||
79 | 10 | 140 | $c += ($topic =~ s!\\/\\\+!\\/[^/]*!g); | ||||
80 | 10 | 119 | $c += ($topic =~ s!\\/\\#$!(?:\$|/.*)!); | ||||
81 | 10 | 91 | $c += ($topic =~ s!^\\\+\\/![^/]*\\/!g); | ||||
82 | 10 | 86 | $c += ($topic =~ s!^\\\+$![^/]*!g); | ||||
83 | 10 | 79 | $c += ($topic =~ s!^\\#$!.*!); | ||||
84 | 10 | 134 | $topic .= '$' unless ($topic =~ m!\$$!); | ||||
85 | 10 | 100 | unless ($c) { | ||||
86 | 1 | 15 | return; | ||||
87 | } | ||||||
88 | 9 | 711 | qr/^$topic/ | ||||
89 | } | ||||||
90 | |||||||
91 | 1; | ||||||
92 |