File Coverage

blib/lib/Bot/Backbone/Service/Role/Dispatch.pm
Criterion Covered Total %
statement 27 27 100.0
branch 10 12 83.3
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 46 48 95.8


line stmt bran cond sub pod time code
1             package Bot::Backbone::Service::Role::Dispatch;
2             $Bot::Backbone::Service::Role::Dispatch::VERSION = '0.160630';
3 4     4   7800 use v5.10;
  4         10  
4 4     4   13 use Moose::Role;
  4         6  
  4         25  
5              
6             with 'Bot::Backbone::Service::Role::SendPolicy';
7              
8 4     4   13953 use namespace::autoclean;
  4         5  
  4         33  
9              
10             # ABSTRACT: Role for services that can perform dispatch
11              
12              
13             has dispatcher_name => (
14                 is => 'rw',
15                 isa => 'Str',
16                 init_arg => 'dispatcher',
17                 predicate => 'has_dispatcher',
18             );
19              
20              
21             has dispatcher => (
22                 is => 'rw',
23                 isa => 'Bot::Backbone::Dispatcher',
24                 init_arg => undef,
25                 lazy_build => 1,
26                 predicate => 'has_setup_the_dispatcher',
27             );
28              
29             sub _build_dispatcher {
30 9     9   14     my $self = shift;
31              
32             # If a named dispatcher is given use that
33 9 100       318     if ($self->has_dispatcher) {
    100          
34 2         53         return $self->bot->meta->dispatchers->{ $self->dispatcher_name };
35                 }
36              
37             # If we have a dispatch builder
38                 elsif ($self->meta->has_dispatch_builder) {
39 3         75         $self->dispatcher_name('<service_dispatcher>');
40 3         7         return $self->meta->run_dispatch_builder;
41                 }
42              
43             # Use an empty dispatcher
44                 else {
45 4         108         $self->dispatcher_name('<empty>');
46 4         108         return Bot::Backbone::Dispatcher->new;
47                 }
48             }
49              
50              
51             has commands => (
52                 is => 'ro',
53                 isa => 'HashRef[Str]',
54                 predicate => 'has_custom_commands',
55                 traits => [ 'Hash' ],
56                 handles => {
57                     command_map => 'elements',
58                 },
59             );
60              
61              
62             sub _apply_command_rewrite {
63 1     1   1     my $self = shift;
64 1         32     my %commands = reverse $self->command_map;
65              
66 1         27     my $iterator = $self->dispatcher->predicate_iterator;
67 1         4     while (my $predicate = $iterator->next_predicate) {
68 4 100       39         if ($predicate->isa('Bot::Backbone::Dispatcher::Predicate::Command')) {
69 2 50       55             if ($commands{ $predicate->match }) {
70 2         52                 $predicate->match( $commands{ $predicate->match } );
71                         }
72                     }
73                 }
74             }
75              
76             sub BUILD {
77 9     9 1 3769     my $self = shift;
78              
79 9 100       290     $self->_apply_command_rewrite if $self->has_custom_commands;
80             }
81              
82              
83             sub dispatch_message {
84 34     34 1 77     my ($self, $message) = @_;
85              
86 34 50       1023     if ($self->has_dispatcher) {
87 34         859         $self->dispatcher->dispatch_message($self, $message);
88                 }
89             }
90              
91              
92             before initialize => sub {
93                 my $self = shift;
94                 $self->dispatcher;
95             };
96              
97             1;
98              
99             __END__
100            
101             =pod
102            
103             =encoding UTF-8
104            
105             =head1 NAME
106            
107             Bot::Backbone::Service::Role::Dispatch - Role for services that can perform dispatch
108            
109             =head1 VERSION
110            
111             version 0.160630
112            
113             =head1 DESCRIPTION
114            
115             Any service that can use a dispatcher employ this role to make that happen.
116            
117             =head1 ATTRIBUTES
118            
119             =head2 dispatcher_name
120            
121             dispatcher default => as {
122             ...
123             };
124            
125             service some_service => (
126             service => '=My::Service',
127             dispatcher => 'default',
128             );
129            
130             During construction, this is named C<dispatcher>. This is the name of the
131             dispatcher to load from the bot during initialization.
132            
133             =head2 dispatcher
134            
135             my $dispatcher = $service->dispatcher;
136            
137             Do not set this attribute. It will be loaded using the L</dispatcher_name>
138             automatically. It returns a L<Bot::Bakcbone::Dispatcher> object to use for
139             dispatch.
140            
141             A C<dispatch_message> method is also delegated to the dispatcher.
142            
143             =head2 commands
144            
145             This is an optional setting for any dispatched service. Sometimes it is nice to use the same service more than once in a given context, but that does not work well when the service uses a fixed set of commands. This allows the commands to be remapped. It may also be that a user simply doesn't like the names originally chosen and this lets them change the names of any command.
146            
147             This attribute takes a reference to a hash of strings which are used to remap the commands. The keys are the new commands to use and the values are the commands that should be replaced. A given command can only be renamed once.
148            
149             For example,
150            
151             service roll => (
152             service => 'OFun::Roll',
153             commands => {
154             '!rolldice' => '!roll',
155             '!flipcoin' => '!flip',
156             },
157             );
158            
159             Using the L<Bot::Backbone::Service::OFun::Roll> service, This would rename the C<!roll> command to C<!rolldice> and C<!flip> to C<!flipcoin>. In this case, using C<!roll> in a chat with the bot would no longer have any effect on the service named "roll", but C<!rolldice> would report the outcome of a dice roll.
160            
161             If this does not provide enough flexibility, you can always go the route of completely replacing a service dispatcher with a new one (and you may want to check out L<Bot::Backbone/respond_by_service_method> and L<Bot::Backbone/run_this_service_method> for help doing that from the bot configuration). You can also define custom code to use L<Bot::Backbone::Dispatcher/predicate_iterator> that walks the entire dispatcher tree and makes changes as needed, which is how this is implemented internally.
162            
163             =head1 METHODS
164            
165             =head2 BUILD
166            
167             Rewrites the dispatcher according to the commands renamed in L</commands>.
168            
169             =head2 dispatch_message
170            
171             $service->dispatch_message($message);
172            
173             If the service has a dispatcher configured, this will call the L<Bot::Backbone::Dispatcher/dispatch_message> method on the dispatcher.
174            
175             =head2 initialize
176            
177             Make sure the dispatcher is initialized by initialization.
178            
179             =head1 AUTHOR
180            
181             Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
182            
183             =head1 COPYRIGHT AND LICENSE
184            
185             This software is copyright (c) 2016 by Qubling Software LLC.
186            
187             This is free software; you can redistribute it and/or modify it under
188             the same terms as the Perl 5 programming language system itself.
189            
190             =cut
191