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.161950';
3 4     4   7715 use v5.10;
  4         13  
4 4     4   18 use Moose::Role;
  4         5  
  4         31  
5              
6             with 'Bot::Backbone::Service::Role::SendPolicy';
7              
8 4     4   14906 use namespace::autoclean;
  4         6  
  4         37  
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   10 my $self = shift;
31              
32             # If a named dispatcher is given use that
33 9 100       294 if ($self->has_dispatcher) {
    100          
34 2         56 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         78 $self->dispatcher_name('<service_dispatcher>');
40 3         8 return $self->meta->run_dispatch_builder;
41             }
42              
43             # Use an empty dispatcher
44             else {
45 4         111 $self->dispatcher_name('<empty>');
46 4         107 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         33 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       18 if ($predicate->isa('Bot::Backbone::Dispatcher::Predicate::Command')) {
69 2 50       63 if ($commands{ $predicate->match }) {
70 2         52 $predicate->match( $commands{ $predicate->match } );
71             }
72             }
73             }
74             }
75              
76             sub BUILD {
77 9     9 1 3935 my $self = shift;
78              
79 9 100       295 $self->_apply_command_rewrite if $self->has_custom_commands;
80             }
81              
82              
83             sub dispatch_message {
84 34     34 1 174 my ($self, $message) = @_;
85              
86 34 50       1074 if ($self->has_dispatcher) {
87 34         1047 $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.161950
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