File Coverage

blib/lib/Bot/Cobalt/Core/Role/IRC.pm
Criterion Covered Total %
statement 33 41 80.4
branch 6 14 42.8
condition 4 12 33.3
subroutine 10 10 100.0
pod 4 4 100.0
total 57 81 70.3


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Core::Role::IRC;
2             $Bot::Cobalt::Core::Role::IRC::VERSION = '0.021003';
3 5     5   2640 use 5.10.1;
  5         12  
4 5     5   18 use strictures 2;
  5         30  
  5         146  
5 5     5   851 no warnings 'once';
  5         8  
  5         127  
6              
7 5     5   19 use Bot::Cobalt::Common ':types';
  5         6  
  5         31  
8              
9 5     5   24 use Scalar::Util 'blessed';
  5         10  
  5         227  
10              
11              
12 5     5   19 use Moo::Role;
  5         7  
  5         37  
13             requires qw/ log debug /;
14              
15              
16             has 'Servers' => (
17             is => 'rw',
18             isa => HashRef,
19             default => sub { +{} },
20             );
21              
22              
23             sub is_connected {
24 1     1 1 3 my ($self, $context) = @_;
25 1 50 33     10 return unless $context and exists $self->Servers->{$context};
26 0         0 $self->Servers->{$context}->connected
27             }
28              
29             *get_irc_server = *get_irc_context;
30             sub get_irc_context {
31 3     3 1 5 my ($self, $context) = @_;
32 3 50 33     20 return unless defined $context and exists $self->Servers->{$context};
33 0         0 $self->Servers->{$context}
34             }
35              
36             *get_irc_object = *get_irc_obj;
37             sub get_irc_obj {
38 1     1 1 3 my ($self, $context) = @_;
39 1 50       4 if (! $context) {
40 0         0 $self->log->warn(
41             "get_irc_obj called with no context at "
42             .join ' ', (caller)[0,2]
43             );
44             return
45 0         0 }
46              
47 1         3 my $c_obj = $self->get_irc_context($context);
48 1 50 33     31 unless ($c_obj && blessed $c_obj) {
49 1         19 $self->log->warn(
50             "get_irc_obj called but context $context not found at "
51             .join ' ', (caller)[0,2]
52             );
53             return
54 1         7 }
55            
56 0 0       0 blessed $c_obj->irc ? $c_obj->irc : ()
57             }
58              
59             sub get_irc_casemap {
60 1     1 1 2 my ($self, $context) = @_;
61 1 50       4 if (! $context) {
62 0         0 $self->log->warn(
63             "get_irc_casemap called with no context at "
64             .join ' ', (caller)[0,2]
65             );
66             return
67 0         0 }
68              
69 1         4 my $c_obj = $self->get_irc_context($context);
70 1 50 33     31 unless ($c_obj && blessed $c_obj) {
71 1         17 $self->log->warn(
72             "get_irc_casemap called but context $context not found at "
73             .join ' ', (caller)[0,2]
74             );
75             return
76 1         5 }
77              
78             $c_obj->casemap
79 0           }
80              
81              
82             1;
83             __END__