File Coverage

blib/lib/Bot/Backbone/SendPolicy/Aggregate.pm
Criterion Covered Total %
statement 20 20 100.0
branch 6 6 100.0
condition 6 8 75.0
subroutine 4 4 100.0
pod 1 1 100.0
total 37 39 94.8


line stmt bran cond sub pod time code
1             package Bot::Backbone::SendPolicy::Aggregate;
2             $Bot::Backbone::SendPolicy::Aggregate::VERSION = '0.161950';
3 4     4   41 use v5.10;
  4         10  
4 4     4   14 use Moose;
  4         6  
  4         25  
5              
6             with 'Bot::Backbone::SendPolicy';
7              
8             # ABSTRACT: Pull several send policies together
9              
10              
11             has config => (
12             is => 'ro',
13             isa => 'ArrayRef',
14             required => 1,
15             traits => [ 'Array' ],
16             handles => {
17             'config_pairs' => 'elements',
18             },
19             );
20              
21              
22             has policies => (
23             is => 'ro',
24             isa => 'ArrayRef',
25             required => 1,
26             lazy_build => 1,
27             traits => [ 'Array' ],
28             handles => {
29             'all_policies' => 'elements',
30             },
31             );
32              
33             sub _build_policies {
34 3     3   3 my $self = shift;
35              
36 3         3 my @policies;
37 3         113 for my $config_pair ($self->config_pairs) {
38 3         7 my ($class_name, $policy_config) = @$config_pair;
39 3         93 push @policies, $class_name->new(%$policy_config, bot => $self->bot);
40             }
41              
42 3         105 return \@policies;
43             }
44              
45              
46             sub allow_send {
47 897     897 1 1105 my ($self, $options) = @_;
48              
49 897         3046 my $final_result = { allow => 1, after => 0 };
50 897         39129 POLICY: for my $policy ($self->all_policies) {
51 897         4250 my $result = $policy->allow_send($options);
52              
53 897   66     3916 $final_result->{allow} &&= $result->{allow};
54             $final_result->{after} = $result->{after}
55 897 100 100     3984 if ($result->{after} // 0) > $final_result->{after};
56              
57 897 100       3789 last POLICY unless $final_result->{allow};
58             }
59              
60             # Don't need after if there's no delay or if allow is false
61             delete $final_result->{after} if $final_result->{after} <= 0
62 897 100 66     3396 or not $final_result->{allow};
63              
64 897         2239 return $final_result;
65             }
66              
67             __PACKAGE__->meta->make_immutable;
68              
69             __END__
70              
71             =pod
72              
73             =encoding UTF-8
74              
75             =head1 NAME
76              
77             Bot::Backbone::SendPolicy::Aggregate - Pull several send policies together
78              
79             =head1 VERSION
80              
81             version 0.161950
82              
83             =head1 DESCRIPTION
84              
85             You probably don't need to worry about this policy directly. Simply by defining a policy using the C<send_policy> helper loaded by L<Bot::Backbone>, you will end up using this to mix them together.
86              
87             Basically, this just provides tools for configuring multiple policies and makes sure that the most restrictive policies win.
88              
89             =head1 ATTRIBUTES
90              
91             =head2 config
92              
93             This is the send policy configuration to use.
94              
95             =head2 policies
96              
97             This is the list of L<Bot::Backbone::SendPolicy> objects to apply. These are built automatically based upon L</config>.
98              
99             =head1 METHODS
100              
101             =head2 allow_send
102              
103             Applies all the L</policies> to the message and returns the most restrictive send policy results.
104              
105             This does perform short circuiting
106              
107             =head1 AUTHOR
108              
109             Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2016 by Qubling Software LLC.
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =cut