File Coverage

blib/lib/Bot/Cobalt/Core.pm
Criterion Covered Total %
statement 60 152 39.4
branch 2 28 7.1
condition 0 10 0.0
subroutine 23 41 56.1
pod 3 8 37.5
total 88 239 36.8


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Core;
2             $Bot::Cobalt::Core::VERSION = '0.021001';
3             ## This is the core Syndicator singleton.
4              
5 5     5   1583 use strictures 2;
  5         24  
  5         175  
6              
7 5     5   802 use v5.10;
  5         10  
8 5     5   17 use Carp;
  5         4  
  5         227  
9              
10 5     5   2497 use POE;
  5         132983  
  5         38  
11              
12 5     5   215303 use Bot::Cobalt::Common;
  5         7  
  5         40  
13 5     5   2025 use Bot::Cobalt::IRC;
  5         9  
  5         133  
14 5     5   1671 use Bot::Cobalt::Lang;
  5         12  
  5         146  
15 5     5   1923 use Bot::Cobalt::Logger;
  5         11  
  5         192  
16              
17 5     5   1852 use Bot::Cobalt::Core::ContextMeta::Auth;
  5         8  
  5         111  
18 5     5   1730 use Bot::Cobalt::Core::ContextMeta::Ignore;
  5         7  
  5         104  
19 5     5   1671 use Bot::Cobalt::Core::Loader;
  5         9  
  5         126  
20              
21 5     5   18 use Scalar::Util 'blessed';
  5         7  
  5         166  
22 5     5   17 use Try::Tiny;
  5         5  
  5         173  
23              
24 5     5   17 use Path::Tiny;
  5         6  
  5         177  
25 5     5   17 use Types::Path::Tiny -types;
  5         5  
  5         33  
26              
27 5     5   3001 use Moo;
  5         6  
  5         22  
28              
29             has cfg => (
30             required => 1,
31             is => 'rw',
32             isa => InstanceOf['Bot::Cobalt::Conf'],
33             );
34              
35             has var => (
36             required => 1,
37             is => 'ro',
38             isa => Path,
39             coerce => 1,
40             );
41              
42             has etc => (
43             lazy => 1,
44             is => 'ro',
45             isa => Path,
46             coerce => 1,
47 1     1   529 builder => sub { shift->cfg->etc },
48             );
49              
50             has log => (
51             lazy => 1,
52             is => 'rw',
53             isa => HasMethods[qw/debug info warn error/],
54             builder => sub {
55 1     1   608 my ($self) = @_;
56 1         4 my %opts = (
57             level => $self->loglevel,
58             );
59 1 50       467 if (my $log_format = $self->cfg->core->opts->{LogFormat}) {
60 0         0 $opts{log_format} = $log_format
61             }
62 1 50       49 if (my $log_time_fmt = $self->cfg->core->opts->{LogTimeFormat}) {
63 0         0 $opts{time_format} = $log_time_fmt
64             }
65 1         40 Bot::Cobalt::Logger->new( %opts )
66             },
67             );
68              
69             has loglevel => (
70             is => 'rw',
71             isa => Str,
72 2     2   137 builder => sub { 'info' },
73             );
74              
75             has detached => (
76             lazy => 1,
77             is => 'ro',
78             isa => Int,
79 0     0   0 builder => sub { 0 },
80             );
81              
82             has debug => (
83             lazy => 1,
84             isa => Int,
85             is => 'rw',
86 0     0   0 builder => sub { 0 },
87             );
88              
89             ## version/url used for var replacement:
90             has version => (
91             lazy => 1,
92             is => 'rwp',
93             isa => Str,
94 0   0 0   0 builder => sub { __PACKAGE__->VERSION // 'vcs' }
95             );
96              
97             has url => (
98             lazy => 1,
99             is => 'rwp',
100             isa => Str,
101 0     0   0 builder => sub { "http://www.metacpan.org/release/Bot-Cobalt" },
102             );
103              
104             has langset => (
105             lazy => 1,
106             is => 'ro',
107             isa => InstanceOf['Bot::Cobalt::Lang'],
108             writer => 'set_langset',
109             builder => sub {
110 1     1   447 my ($self) = @_;
111 1         5 Bot::Cobalt::Lang->new(
112             use_core => 1,
113             lang_dir => path( $self->etc .'/langs' ),
114             lang => $self->cfg->core->language,
115             )
116             },
117             );
118              
119             has lang => (
120             lazy => 1,
121             is => 'ro',
122             isa => HashObj,
123             coerce => 1,
124             writer => 'set_lang',
125             builder => sub {
126 1     1   835 my ($self) = @_;
127 1         4 $self->langset->rpls
128             },
129             );
130              
131             has State => (
132             lazy => 1,
133             ## global 'heap' of sorts
134             is => 'ro',
135             isa => HashObj,
136             coerce => 1,
137             builder => sub {
138             {
139 0     0   0 HEAP => { },
140             StartedTS => time(),
141             Counters => {
142             Sent => 0,
143             },
144              
145             # nonreloadable plugin list keyed on alias for plugin mgrs:
146             NonReloadable => { },
147             }
148             },
149             );
150              
151             has PluginObjects => (
152             lazy => 1,
153             ## alias -> object mapping
154             is => 'rw',
155             isa => HashObj,
156             coerce => 1,
157 0     0   0 builder => sub { {} },
158             );
159              
160             has Provided => (
161             lazy => 1,
162             ## Some plugins provide optional functionality.
163             ## This hash lets other plugins see if an event is available.
164             is => 'ro',
165             isa => HashObj,
166             coerce => 1,
167 0     0   0 builder => sub { {} },
168             );
169              
170             has auth => (
171             lazy => 1,
172             is => 'rw',
173             isa => Object,
174             builder => sub {
175 1     1   1580 Bot::Cobalt::Core::ContextMeta::Auth->new
176             },
177             );
178              
179             has ignore => (
180             lazy => 1,
181             is => 'rw',
182             isa => Object,
183             builder => sub {
184 1     1   893 Bot::Cobalt::Core::ContextMeta::Ignore->new
185             },
186             );
187              
188             ## FIXME not documented
189             has resolver => (
190             lazy => 1,
191             is => 'rwp',
192             isa => Object,
193             builder => sub {
194 0     0     POE::Component::Client::DNS->spawn(
195             Alias => 'core_resolver',
196             )
197             },
198             );
199              
200              
201             extends 'POE::Component::Syndicator';
202             with 'Bot::Cobalt::Core::Role::Singleton';
203             with 'Bot::Cobalt::Core::Role::EasyAccessors';
204             with 'Bot::Cobalt::Core::Role::Timers';
205             with 'Bot::Cobalt::Core::Role::IRC';
206              
207              
208             ## FIXME test needed:
209             sub rpl {
210 0     0 0   my ($self, $rpl) = splice @_, 0, 2;
211              
212 0 0         confess "rpl() method requires a RPL tag"
213             unless defined $rpl;
214              
215 0   0       my $string = $self->lang->{$rpl}
216             // return "Unknown RPL $rpl, vars: ".join(' ', @_);
217              
218 0           rplprintf( $string, @_ )
219             }
220              
221             sub init {
222 0     0 0   my ($self) = @_;
223              
224             my $logfile = $self->cfg->core->paths->{Logfile}
225 0   0       // path( $self->var .'/cobalt.log' );
226              
227 0 0         if ($self->detached) {
228             # Presumably our frontend closed these
229 0 0         open STDOUT, '>>', $logfile or die $!;
230 0 0         open STDERR, '>>', $logfile or die $!;
231             } else {
232 0           $self->log->output->add(
233             'screen' => {
234             type => 'Term',
235             },
236             );
237             }
238              
239 0           $self->log->output->add(
240             'logfile' => {
241             type => 'File',
242             file => $logfile,
243             },
244             );
245              
246             ## Language set check. Force attrib fill.
247 0           $self->lang;
248              
249 0           $self->_syndicator_init(
250             prefix => 'ev_', ## event prefix for sessions
251             reg_prefix => 'Cobalt_',
252             types => [ SERVER => 'Bot', USER => 'Outgoing' ],
253             options => { },
254             object_states => [
255             $self => [
256             'syndicator_started',
257             'syndicator_stopped',
258              
259             'shutdown',
260             'sighup',
261              
262             'ev_plugin_error',
263              
264             'core_timer_check_pool',
265             ],
266             ],
267             );
268              
269             }
270              
271             sub syndicator_started {
272 0     0 1   my ($kernel, $self) = @_[KERNEL, OBJECT];
273              
274 0           $kernel->sig('INT' => 'shutdown');
275 0           $kernel->sig('TERM' => 'shutdown');
276 0           $kernel->sig('HUP' => 'sighup');
277              
278 0           $self->log->info(__PACKAGE__.' '.$self->version);
279              
280 0           $self->log->info("--> Initializing plugins . . .");
281              
282 0           my $i;
283             my @plugins = sort {
284 0           $self->cfg->plugins->plugin($b)->priority
285             <=>
286             $self->cfg->plugins->plugin($a)->priority
287 0           } @{ $self->cfg->plugins->list_plugins };
  0            
288              
289 0           PLUGIN: for my $plugin (@plugins)
290             {
291 0           my $this_plug_cf = $self->cfg->plugins->plugin($plugin);
292              
293 0           my $module = $this_plug_cf->module;
294              
295 0 0         unless ( $this_plug_cf->autoload ) {
296 0           $self->log->debug("Skipping $plugin - NoAutoLoad is true");
297              
298             next PLUGIN
299 0           }
300              
301 0           my $obj;
302             try {
303 0     0     $obj = Bot::Cobalt::Core::Loader->load($module);
304              
305 0 0         unless ( Bot::Cobalt::Core::Loader->is_reloadable($obj) ) {
306 0           $self->State->{NonReloadable}->{$plugin} = 1;
307 0           $self->log->debug("$plugin marked non-reloadable");
308             }
309             } catch {
310 0     0     $self->log->error("Load failure; $_");
311              
312             next PLUGIN
313 0           };
  0            
314              
315             ## save stringified object -> plugin mapping:
316 0           $self->PluginObjects->{$obj} = $plugin;
317              
318 0 0         unless ( $self->plugin_add($plugin, $obj) ) {
319 0           $self->log->error("plugin_add failure for $plugin");
320              
321 0           delete $self->PluginObjects->{$obj};
322              
323 0           Bot::Cobalt::Core::Loader->unload($module);
324              
325             next PLUGIN
326 0           }
327              
328 0           ++$i;
329             }
330              
331 0           $self->log->info("-> $i plugins loaded");
332              
333 0           $self->send_event('plugins_initialized', $_[ARG0]);
334              
335 0           $self->log->info("-> started, plugins_initialized sent");
336              
337             ## kickstart timer pool
338 0           $kernel->yield('core_timer_check_pool');
339             }
340              
341             sub sighup {
342 0     0 0   my $self = $_[OBJECT];
343 0           $self->log->warn("SIGHUP received");
344              
345 0 0         if ($self->detached) {
346             ## Caught by Plugin::Rehash if present
347             ## Not documented because you should be using the IRC interface
348             ## (...and if the bot was run with --nodetach it will die, below)
349 0           $self->log->info("sending Bot_rehash (SIGHUP)");
350 0           $self->send_event( 'Bot_rehash' );
351             } else {
352             ## we were (we think) attached to a terminal and it's (we think) gone
353             ## shut down soon as we can:
354 0           $self->log->warn("Lost terminal; shutting down");
355              
356 0           $_[KERNEL]->yield('shutdown');
357             }
358              
359 0           $_[KERNEL]->sig_handled();
360             }
361              
362             sub shutdown {
363 0 0   0 1   my $self = ref $_[0] eq __PACKAGE__ ? $_[0] : $_[OBJECT];
364              
365 0           $self->log->warn("Shutdown called, destroying syndicator");
366              
367 0           $self->_syndicator_destroy();
368             }
369              
370             sub syndicator_stopped {
371 0     0 1   my ($kernel, $self) = @_[KERNEL, OBJECT];
372              
373 0           $kernel->alarm('core_timer_check_pool');
374              
375 0           $self->log->debug("issuing: POCOIRC_SHUTDOWN, shutdown");
376              
377 0           $kernel->signal( $kernel, 'POCOIRC_SHUTDOWN' );
378 0           $kernel->post( $kernel, 'shutdown' );
379              
380 0           $self->log->warn("Core syndicator stopped.");
381             }
382              
383             sub ev_plugin_error {
384 0     0 0   my ($kernel, $self, $err) = @_[KERNEL, OBJECT, ARG0];
385              
386             ## Receives the same error as 'debug => 1' (in Syndicator init)
387              
388 0           $self->log->error("Plugin err: $err");
389              
390             ## Bot_plugin_error
391 0           $self->send_event( 'plugin_error', $err );
392             }
393              
394             ### Core low-pri timer
395              
396             sub core_timer_check_pool {
397 0     0 0   my ($kernel, $self) = @_[KERNEL, OBJECT];
398              
399             ## Timers are provided by Core::Role::Timers
400              
401 0           my $timerpool = $self->TimerPool;
402              
403 0           TIMER: for my $id (keys %$timerpool) {
404 0           my $timer = $timerpool->{$id};
405              
406 0 0 0       unless (blessed $timer && $timer->isa('Bot::Cobalt::Timer') ) {
407             ## someone's been naughty
408 0           $self->log->warn("not a Bot::Cobalt::Timer: $id");
409 0           delete $timerpool->{$id};
410             next TIMER
411 0           }
412              
413 0 0         if ( $timer->execute_if_ready ) {
414 0           my $event = $timer->event;
415              
416 0 0         $self->log->debug("timer execute; $id ($event)")
417             if $self->debug > 1;
418              
419 0           $self->send_event( 'executed_timer', $id );
420 0           $self->timer_del($id);
421             }
422              
423             } ## TIMER
424              
425             ## most definitely not a high-precision timer.
426             ## checked every second or so
427 0           $kernel->alarm('core_timer_check_pool' => time + 1);
428             }
429              
430             1;
431             __END__