File Coverage

blib/lib/Bot/Cobalt/Common.pm
Criterion Covered Total %
statement 252 252 100.0
branch 8 14 57.1
condition 8 21 38.1
subroutine 84 84 100.0
pod n/a
total 352 371 94.8


line stmt bran cond sub pod time code
1             package Bot::Cobalt::Common;
2             $Bot::Cobalt::Common::VERSION = '0.021001';
3 109     109   54766 use v5.10;
  109         183  
4 109     109   2868 use strictures 2;
  109         2624  
  109         887  
5 109     43   5696 use Carp;
  43         1340  
  43         3837  
6              
7 43     43   12797 use List::Objects::WithUtils;
  43         18232  
  43         175  
8              
9 43     43   1544437 use Import::Into;
  43         9079  
  43         685  
10              
11 43     43   11731 use Bot::Cobalt::Utils ();
  43         111  
  43         570  
12 43     36   13716 use IRC::Utils ();
  36         363857  
  36         760  
13 36     36   11684 use Object::Pluggable::Constants ();
  36         8016  
  36         434  
14 36     36   370 use Try::Tiny ();
  36         55  
  36         301  
15              
16 36     36   13684 use Types::Standard ();
  36         1253762  
  36         881  
17 36     36   12769 use List::Objects::Types ();
  36         647113  
  36         17337  
18              
19             our $ImportMap = hash(
20             string => hash(
21             'Bot::Cobalt::Utils' => array( qw/
22             rplprintf
23             color
24             glob_to_re
25             glob_to_re_str
26             glob_grep
27             / ),
28              
29             'IRC::Utils' => array( qw/
30             lc_irc
31             eq_irc
32             uc_irc
33             decode_irc
34             strip_color
35             strip_formatting
36             / ),
37             ),
38              
39             errors => hash(
40             'Carp' => array(qw/carp croak confess/),
41             ),
42              
43             passwd => hash(
44             'Bot::Cobalt::Utils' => array( qw/ mkpasswd passwdcmp / ),
45             ),
46              
47             time => hash(
48             'Bot::Cobalt::Utils' => array( qw/
49             timestr_to_secs
50             secs_to_timestr
51             secs_to_str
52             secs_to_str_y
53             / ),
54             ),
55              
56             validate => hash(
57             'IRC::Utils' => array( qw/
58             is_valid_nick_name
59             is_valid_chan_name
60             / ),
61             ),
62              
63             host => hash(
64             'IRC::Utils' => array( qw/
65             parse_user
66             normalize_mask
67             matches_mask
68             / ),
69             ),
70              
71             constant => hash(
72             'Object::Pluggable::Constants' => array( ':ALL' ),
73             ),
74              
75             types => hash(
76             'Types::Standard' => array( -types ),
77             'List::Objects::Types' => array( -types ),
78             ),
79             );
80              
81             my $FuncMap =
82             $ImportMap
83             ->values
84             ->map(sub {
85             my @func_pkg_pairs;
86             my $iter = $_->iter;
87             while (my ($pkg, $opts) = $iter->()) {
88             $opts->visit(sub {
89             my $maybe_prefix = substr $_, 0, 1;
90             push @func_pkg_pairs, ($_ => $pkg)
91             unless $maybe_prefix eq ':'
92             or $maybe_prefix eq '-'
93             })
94             }
95             @func_pkg_pairs
96             })
97             ->inflate;
98              
99             sub import {
100 216     216   738 my (undef, @items) = @_;
101 216         354 my $target = caller;
102              
103 216         10627 feature->import( ':5.10' );
104 216         1119 strictures->import::into($target);
105 216         55166 Try::Tiny->import::into($target);
106              
107 216         33096 my $toimport = hash;
108              
109             # : or - prefixed tags are valid, everything else is a func/symbol:
110 216         2692 my (@tags, @funcs);
111 216         355 for my $item (@items) {
112 175         283 my $maybe_prefix = substr $item, 0, 1;
113 175 50 66     748 if ($maybe_prefix eq ':' || $maybe_prefix eq '-') {
114 175         435 push @tags, lc substr $item, 1;
115             } else {
116 6         7 push @funcs, $item;
117             }
118             }
119              
120             @tags = $ImportMap->keys->all
121 216 100 66     834 if grep {; $_ eq 'all' } @tags
  175   66     911  
122             # empty import implies all:
123             or !@tags and !@funcs;
124              
125             # groups/tags:
126 216         1322 for my $tag (@tags) {
127 607   33     4493 my $groups = $ImportMap->get($tag)
128             || confess "Import failed; tag '$tag' not exported";
129 607         2526 for my $pkg ($groups->keys->all) {
130 884 100       9465 if ($toimport->exists($pkg)) {
131 222         730 $toimport->get($pkg)->push( $groups->get($pkg)->all )
132             } else {
133 668         2121 $toimport->set( $pkg => $groups->get($pkg) )
134             }
135             }
136             }
137              
138             # individual symbols:
139 216         1945 for my $func (@funcs) {
140 6   0     79 my $pkg = $FuncMap->get($func)
141             || confess "Import failed; function '$func' not exported";
142 6 0       25 if ($toimport->exists($pkg)) {
143 6         6 $toimport->get($pkg)->push($func)
144             } else {
145 6         37 $toimport->set( $pkg => array($func) )
146             }
147             }
148              
149 216         471 my $iter = $toimport->iter;
150 216         1413 my @failed;
151 216         502 while (my ($pkg, $optlist) = $iter->()) {
152 668 50       3415 my $importstr = $optlist->has_any ?
153             "use $pkg qw/" . $optlist->uniq->join(' ') . "/;"
154             : "use $pkg;";
155 668         16360 my $c = "package $target; $importstr; 1";
156 668         759 local $@;
157 36 50 0 36   226 eval $c and not $@ or carp $@ and push @failed, $pkg;
  36   33 36   60  
  36     6   535  
  36     6   284  
  36     6   62  
  36     6   316  
  668     6   38881  
  6     6   7  
  6     6   128  
  6     6   24  
  6     6   8  
  6     6   137  
  6     6   27  
  6     6   6  
  6     6   32  
  6     6   26  
  6     6   8  
  6     6   193  
  6     6   27  
  6     6   8  
  6     6   168  
  6     6   25  
  6     6   9  
  6     6   114  
  6     6   26  
  6     6   7  
  6     6   77  
  6     6   26  
  6     6   8  
  6     6   120  
  6     6   28  
  6     6   8  
  6     6   252  
  6     6   27  
  6     6   8  
  6     6   128  
  6     6   27  
  6     6   6  
  6     6   179  
  6     6   37  
  6     6   9  
  6     6   188  
  6     6   25  
  6     6   11  
  6     6   84  
  6     6   24  
  6     6   9  
  6     6   81  
  6     6   26  
  6     6   7  
  6     6   138  
  6     6   27  
  6     3   7  
  6     3   59  
  6     3   27  
  6     3   5  
  6     3   79  
  6     3   26  
  6     3   8  
  6     3   178  
  6     3   25  
  6     3   7  
  6     2   80  
  6     2   26  
  6     2   8  
  6     2   96  
  6     1   25  
  6     1   8  
  6     1   65  
  6     1   27  
  6     1   7  
  6     1   138  
  6         29  
  6         8  
  6         34  
  6         26  
  6         9  
  6         31  
  6         26  
  6         8  
  6         98  
  6         25  
  6         7  
  6         82  
  6         27  
  6         8  
  6         73  
  6         29  
  6         8  
  6         109  
  6         26  
  6         9  
  6         164  
  6         27  
  6         8  
  6         170  
  6         25  
  6         10  
  6         193  
  6         27  
  6         7  
  6         66  
  6         26  
  6         8  
  6         173  
  6         27  
  6         7  
  6         238  
  6         27  
  6         9  
  6         109  
  6         28  
  6         7  
  6         138  
  6         26  
  6         9  
  6         35  
  6         26  
  6         138  
  6         155  
  6         26  
  6         7  
  6         91  
  6         24  
  6         7  
  6         78  
  3         11  
  3         3  
  3         91  
  3         13  
  3         5  
  3         164  
  3         11  
  3         5  
  3         81  
  3         14  
  3         4  
  3         17  
  3         14  
  3         3  
  3         16  
  3         13  
  3         5  
  3         15  
  3         14  
  3         3  
  3         65  
  3         13  
  3         3  
  3         43  
  3         13  
  3         3  
  3         129  
  3         14  
  3         3  
  3         16  
  2         8  
  2         2  
  2         11  
  2         8  
  2         3  
  2         10  
  2         9  
  2         2  
  2         10  
  2         9  
  2         2  
  2         9  
  1         4  
  1         2  
  1         4  
  1         4  
  1         1  
  1         6  
  1         4  
  1         2  
  1         4  
  1         4  
  1         1  
  1         35  
  1         4  
  1         1  
  1         6  
  1         4  
  1         2  
  1         5  
158             }
159              
160 216 50       1097 if (@failed) {
161 6         66 croak 'Failed to import '. join ', ', @failed
162             }
163              
164             1
165 216         8618 }
166              
167             1;
168             __END__