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