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.021002';
3 109     109   57309 use v5.10;
  109         194  
4 109     109   2630 use strictures 2;
  109         2678  
  109         867  
5 109     43   6690 use Carp;
  43         820  
  43         3982  
6              
7 43     43   12934 use List::Objects::WithUtils;
  43         18634  
  43         185  
8              
9 43     43   1570178 use Import::Into;
  43         9459  
  43         669  
10              
11 43     43   12261 use Bot::Cobalt::Utils ();
  43         125  
  43         654  
12 43     36   15651 use IRC::Utils ();
  36         376289  
  36         789  
13 36     36   12172 use Object::Pluggable::Constants ();
  36         7266  
  36         495  
14 36     36   1112 use Try::Tiny ();
  36         56  
  36         334  
15              
16 36     36   14479 use Types::Standard ();
  36         1261927  
  36         961  
17 36     36   13320 use List::Objects::Types ();
  36         675977  
  36         17699  
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   666 my (undef, @items) = @_;
101 216         394 my $target = caller;
102              
103 216         11441 feature->import( ':5.10' );
104 216         1139 strictures->import::into($target);
105 216         55544 Try::Tiny->import::into($target);
106              
107 216         33741 my $toimport = hash;
108              
109             # : or - prefixed tags are valid, everything else is a func/symbol:
110 216         3531 my (@tags, @funcs);
111 216         392 for my $item (@items) {
112 175         305 my $maybe_prefix = substr $item, 0, 1;
113 175 50 66     731 if ($maybe_prefix eq ':' || $maybe_prefix eq '-') {
114 175         479 push @tags, lc substr $item, 1;
115             } else {
116 6         9 push @funcs, $item;
117             }
118             }
119              
120             @tags = $ImportMap->keys->all
121 216 100 66     885 if grep {; $_ eq 'all' } @tags
  175   66     1087  
122             # empty import implies all:
123             or !@tags and !@funcs;
124              
125             # groups/tags:
126 216         1478 for my $tag (@tags) {
127 607   33     4795 my $groups = $ImportMap->get($tag)
128             || confess "Import failed; tag '$tag' not exported";
129 607         2717 for my $pkg ($groups->keys->all) {
130 884 100       10166 if ($toimport->exists($pkg)) {
131 222         702 $toimport->get($pkg)->push( $groups->get($pkg)->all )
132             } else {
133 668         2183 $toimport->set( $pkg => $groups->get($pkg) )
134             }
135             }
136             }
137              
138             # individual symbols:
139 216         2077 for my $func (@funcs) {
140 6   0     30 my $pkg = $FuncMap->get($func)
141             || confess "Import failed; function '$func' not exported";
142 6 0       30 if ($toimport->exists($pkg)) {
143 6         8 $toimport->get($pkg)->push($func)
144             } else {
145 6         65 $toimport->set( $pkg => array($func) )
146             }
147             }
148              
149 216         572 my $iter = $toimport->iter;
150 216         1541 my @failed;
151 216         496 while (my ($pkg, $optlist) = $iter->()) {
152 668 50       3653 my $importstr = $optlist->has_any ?
153             "use $pkg qw/" . $optlist->uniq->join(' ') . "/;"
154             : "use $pkg;";
155 668         17011 my $c = "package $target; $importstr; 1";
156 668         849 local $@;
157 36 50 0 36   248 eval $c and not $@ or carp $@ and push @failed, $pkg;
  36   33 36   65  
  36     6   577  
  36     6   282  
  36     6   62  
  36     6   401  
  668     6   39795  
  6     6   10  
  6     6   83  
  6     6   27  
  6     6   7  
  6     6   103  
  6     6   27  
  6     6   8  
  6     6   176  
  6     6   30  
  6     6   7  
  6     6   65  
  6     6   26  
  6     6   7  
  6     6   191  
  6     6   27  
  6     6   8  
  6     6   61  
  6     6   27  
  6     6   9  
  6     6   239  
  6     6   25  
  6     6   8  
  6     6   152  
  6     6   26  
  6     6   10  
  6     6   186  
  6     6   27  
  6     6   9  
  6     6   110  
  6     6   27  
  6     6   7  
  6     6   172  
  6     6   33  
  6     6   10  
  6     6   234  
  6     6   28  
  6     6   7  
  6     6   149  
  6     6   27  
  6     6   7  
  6     6   79  
  6     6   26  
  6     6   8  
  6     6   112  
  6     6   29  
  6     3   9  
  6     3   174  
  6     3   25  
  6     3   9  
  6     3   95  
  6     3   28  
  6     3   8  
  6     3   127  
  6     3   123  
  6     3   11  
  6     2   91  
  6     2   27  
  6     2   7  
  6     2   101  
  6     1   41  
  6     1   9  
  6     1   33  
  6     1   28  
  6     1   9  
  6     1   99  
  6         25  
  6         9  
  6         41  
  6         27  
  6         9  
  6         122  
  6         28  
  6         10  
  6         88  
  6         28  
  6         11  
  6         73  
  6         29  
  6         12  
  6         37  
  6         29  
  6         7  
  6         219  
  6         29  
  6         9  
  6         155  
  6         30  
  6         7  
  6         208  
  6         31  
  6         9  
  6         226  
  6         27  
  6         7  
  6         69  
  6         30  
  6         8  
  6         258  
  6         30  
  6         7  
  6         93  
  6         30  
  6         9  
  6         96  
  6         28  
  6         8  
  6         201  
  6         27  
  6         8  
  6         108  
  6         28  
  6         151  
  6         94  
  6         30  
  6         8  
  6         140  
  6         29  
  6         10  
  6         87  
  3         14  
  3         4  
  3         116  
  3         14  
  3         4  
  3         133  
  3         13  
  3         5  
  3         17  
  3         15  
  3         4  
  3         129  
  3         13  
  3         5  
  3         18  
  3         15  
  3         6  
  3         78  
  3         13  
  3         5  
  3         45  
  3         12  
  3         6  
  3         17  
  3         15  
  3         6  
  3         97  
  3         14  
  3         6  
  3         54  
  2         9  
  2         3  
  2         12  
  2         10  
  2         3  
  2         12  
  2         9  
  2         2  
  2         13  
  2         11  
  2         2  
  2         13  
  1         5  
  1         2  
  1         5  
  1         5  
  1         1  
  1         5  
  1         4  
  1         2  
  1         8  
  1         5  
  1         1  
  1         42  
  1         4  
  1         1  
  1         7  
  1         5  
  1         1  
  1         7  
158             }
159              
160 216 50       1180 if (@failed) {
161 6         103 croak 'Failed to import '. join ', ', @failed
162             }
163              
164             1
165 216         8829 }
166              
167             1;
168             __END__