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.021003';
3 109     109   57252 use v5.10;
  109         215  
4 109     109   3367 use strictures 2;
  109         2875  
  109         931  
5 109     43   6614 use Carp;
  43         1103  
  43         3826  
6              
7 43     43   14808 use List::Objects::WithUtils;
  43         20238  
  43         197  
8              
9 43     43   1647522 use Import::Into;
  43         9701  
  43         717  
10              
11 43     43   13039 use Bot::Cobalt::Utils ();
  43         124  
  43         648  
12 43     36   14307 use IRC::Utils ();
  36         375502  
  36         784  
13 36     36   12908 use Object::Pluggable::Constants ();
  36         8671  
  36         477  
14 36     36   306 use Try::Tiny ();
  36         56  
  36         328  
15              
16 36     36   14187 use Types::Standard ();
  36         1298188  
  36         1005  
17 36     36   14174 use List::Objects::Types ();
  36         686845  
  36         18415  
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 215     215   681 my (undef, @items) = @_;
101 215         423 my $target = caller;
102              
103 215         12820 feature->import( ':5.10' );
104 215         1193 strictures->import::into($target);
105 215         57215 Try::Tiny->import::into($target);
106              
107 215         33700 my $toimport = hash;
108              
109             # : or - prefixed tags are valid, everything else is a func/symbol:
110 215         3570 my (@tags, @funcs);
111 215         441 for my $item (@items) {
112 175         317 my $maybe_prefix = substr $item, 0, 1;
113 175 50 66     727 if ($maybe_prefix eq ':' || $maybe_prefix eq '-') {
114 175         517 push @tags, lc substr $item, 1;
115             } else {
116 6         9 push @funcs, $item;
117             }
118             }
119              
120             @tags = $ImportMap->keys->all
121 215 100 66     1010 if grep {; $_ eq 'all' } @tags
  175   66     1076  
122             # empty import implies all:
123             or !@tags and !@funcs;
124              
125             # groups/tags:
126 215         1642 for my $tag (@tags) {
127 599   33     4848 my $groups = $ImportMap->get($tag)
128             || confess "Import failed; tag '$tag' not exported";
129 599         2731 for my $pkg ($groups->keys->all) {
130 874 100       10498 if ($toimport->exists($pkg)) {
131 218         711 $toimport->get($pkg)->push( $groups->get($pkg)->all )
132             } else {
133 662         2543 $toimport->set( $pkg => $groups->get($pkg) )
134             }
135             }
136             }
137              
138             # individual symbols:
139 215         2116 for my $func (@funcs) {
140 6   0     98 my $pkg = $FuncMap->get($func)
141             || confess "Import failed; function '$func' not exported";
142 6 0       27 if ($toimport->exists($pkg)) {
143 6         8 $toimport->get($pkg)->push($func)
144             } else {
145 6         121 $toimport->set( $pkg => array($func) )
146             }
147             }
148              
149 215         566 my $iter = $toimport->iter;
150 215         1693 my @failed;
151 215         450 while (my ($pkg, $optlist) = $iter->()) {
152 662 50       3825 my $importstr = $optlist->has_any ?
153             "use $pkg qw/" . $optlist->uniq->join(' ') . "/;"
154             : "use $pkg;";
155 662         17893 my $c = "package $target; $importstr; 1";
156 662         704 local $@;
157 36 50 0 36   355 eval $c and not $@ or carp $@ and push @failed, $pkg;
  36   33 36   65  
  36     6   424  
  36     6   315  
  36     6   67  
  36     6   478  
  662     6   40005  
  6     6   8  
  6     6   138  
  6     6   26  
  6     6   8  
  6     6   85  
  6     6   28  
  6     6   9  
  6     6   349  
  6     6   28  
  6     6   8  
  6     6   61  
  6     6   28  
  6     6   10  
  6     6   172  
  6     6   28  
  6     6   7  
  6     6   92  
  6     6   27  
  6     6   10  
  6     6   136  
  6     6   25  
  6     6   8  
  6     6   183  
  6     6   27  
  6     6   10  
  6     6   118  
  6     6   27  
  6     6   9  
  6     6   195  
  6     6   28  
  6     6   8  
  6     6   148  
  6     6   30  
  6     6   10  
  6     6   142  
  6     6   27  
  6     6   10  
  6     6   141  
  6     6   29  
  6     6   8  
  6     6   135  
  6     6   26  
  6     6   8  
  6     6   89  
  6     6   30  
  6     3   9  
  6     3   239  
  6     3   29  
  6     3   7  
  6     2   150  
  6     2   28  
  6     2   7  
  6     2   250  
  6     2   28  
  6     2   9  
  6     2   38  
  6     2   29  
  6     2   9  
  6     2   124  
  6     1   27  
  6     1   9  
  6     1   36  
  6     1   31  
  6     1   9  
  6     1   107  
  6         27  
  6         7  
  6         106  
  6         30  
  6         8  
  6         37  
  6         29  
  6         9  
  6         106  
  6         29  
  6         9  
  6         89  
  6         29  
  6         8  
  6         133  
  6         30  
  6         10  
  6         280  
  6         28  
  6         9  
  6         38  
  6         31  
  6         8  
  6         113  
  6         28  
  6         12  
  6         285  
  6         30  
  6         8  
  6         114  
  6         33  
  6         9  
  6         95  
  6         32  
  6         10  
  6         203  
  6         31  
  6         10  
  6         87  
  6         34  
  6         10  
  6         175  
  6         26  
  6         10  
  6         216  
  6         29  
  6         159  
  6         150  
  6         28  
  6         9  
  6         153  
  6         32  
  6         8  
  6         104  
  3         15  
  3         4  
  3         60  
  3         15  
  3         5  
  3         74  
  3         15  
  3         3  
  3         134  
  3         14  
  3         6  
  3         49  
  2         9  
  2         2  
  2         12  
  2         10  
  2         3  
  2         14  
  2         9  
  2         2  
  2         11  
  2         11  
  2         3  
  2         10  
  2         10  
  2         3  
  2         50  
  2         9  
  2         4  
  2         11  
  2         9  
  2         4  
  2         13  
  2         9  
  2         2  
  2         9  
  2         9  
  2         4  
  2         11  
  2         11  
  2         2  
  2         11  
  1         5  
  1         2  
  1         5  
  1         5  
  1         2  
  1         5  
  1         5  
  1         1  
  1         7  
  1         5  
  1         1  
  1         41  
  1         5  
  1         2  
  1         7  
  1         5  
  1         2  
  1         5  
158             }
159              
160 215 50       1196 if (@failed) {
161 6         94 croak 'Failed to import '. join ', ', @failed
162             }
163              
164             1
165 215         9508 }
166              
167             1;
168             __END__