File Coverage

blib/lib/Message/Passing/Filter/Key.pm
Criterion Covered Total %
statement 18 18 100.0
branch 4 4 100.0
condition 9 11 81.8
subroutine 4 4 100.0
pod 1 1 100.0
total 36 38 94.7


line stmt bran cond sub pod time code
1             package Message::Passing::Filter::Key;
2 1     1   501 use Moo;
  1         2  
  1         5  
3 1     1   403 use MooX::Types::MooseLike::Base qw/ Str /;
  1         1  
  1         89  
4 1     1   6 use namespace::clean -except => 'meta';
  1         12  
  1         12  
5              
6             with 'Message::Passing::Role::Filter';
7              
8             has key => (
9             isa => Str,
10             is => 'ro',
11             required => 1,
12             );
13              
14             has match => (
15             isa => Str,
16             is => 'ro',
17             required => 1,
18             );
19              
20             has match_type => (
21             is => 'ro',
22             # isa => enum(['regex', 'eq']),
23             default => sub { 'eq' },
24             );
25              
26             has _re => (
27             is => 'ro',
28             lazy => 1,
29             default => sub {
30             my $self = shift;
31             my $match = $self->match;
32             if ($self->match_type eq 'regex') {
33             return qr/$match/;
34             }
35             else {
36             return qr/^\Q$match\E$/;
37             }
38             },
39             );
40              
41             sub filter {
42 6     6 1 9 my ($self, $message) = @_;
43 6         142 my $re = $self->_re;
44 6         53 my @key_parts = split /\./, $self->key;
45 6         9 my $m = $message;
46 6   100     11 do {
47 13         19 my $part = shift(@key_parts);
48 13 100 66     97 $m = (ref($m) eq 'HASH' && exists($m->{$part})) ? $m->{$part} : undef;
49             } while ($m && scalar(@key_parts));
50 6 100 66     69 return unless $m && !ref($m) && $m =~ /$re/;
      100        
51 2         9 return $message;
52             }
53              
54              
55             1;
56              
57             =head1 NAME
58              
59             Message::Passing::Filter::Key - Filter a subset of messages out.
60              
61             =head1 DESCRIPTION
62              
63             This filter just removes messages which do not have a key matching a certain value.
64              
65             =head1 ATTRIBUTES
66              
67             =head2 key
68              
69             The name of the key. You may use a C< foo.bar > syntax to indicate variables below the top level
70             of the hash (i.e. the example would look in C<< $msg->{foo}->{bar} >>.).
71              
72             =head2 match
73              
74             The value to match to determine if the message should be passed onto the next stage or filtered out.
75              
76             =head2 match_type
77              
78             The type of match to perform, valid values are 'regex' or 'eq', and the latter is the default.
79              
80             =head1 METHODS
81              
82             =head2 filter
83              
84             Does the actual filtering work.
85              
86             =head1 SPONSORSHIP
87              
88             This module exists due to the wonderful people at Suretec Systems Ltd.
89             who sponsored its development for its
90             VoIP division called SureVoIP for use with
91             the SureVoIP API -
92            
93              
94             =head1 AUTHOR, COPYRIGHT AND LICENSE
95              
96             See L.
97              
98             =cut