File Coverage

File:lib/Net/MQTT/TopicStore.pm
Coverage:90.7%

linestmtbrancondsubpodtimecode
1
1
1
1
1.31949281916583e+15
8
78
use strict;
2
1
1
1
12
5
1208
use warnings;
3package 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
26sub 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
35Adds the topic pattern to the store.
36
37=cut
38
39sub 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
49Remove the topic pattern from the store.
50
51=cut
52
53sub delete {
54
0
0
  my ($self, $topic) = @_;
55
0
0
  delete $self->{topics}->{$topic};
56}
57
58=method C<values( $topic )>
59
60Returns all the topic patterns in the store that apply to the given topic.
61
62=cut
63
64sub 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
75sub _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
911;
92