File Coverage

blib/lib/Util/Any.pm
Criterion Covered Total %
statement 327 331 98.7
branch 155 180 86.1
condition 72 87 82.7
subroutine 39 39 100.0
pod n/a
total 593 637 93.0


line stmt bran cond sub pod time code
1             package Util::Any;
2              
3 55     55   1031174 use ExportTo ();
  55         29492  
  55         856  
4 55     55   14932 use Clone ();
  55         94846  
  55         941  
5 55     55   247 use Carp ();
  55         74  
  55         726  
6 55     55   170 use warnings;
  55         61  
  55         1393  
7 55     55   176 use strict;
  55         63  
  55         17942  
8              
9             our $Utils = {
10             list => [ qw/List::Util List::MoreUtils List::Pairwise/ ],
11             data => [ qw/Scalar::Util/ ],
12             hash => [ qw/Hash::Util/ ],
13             debug => [ ['Data::Dumper', '', ['Dumper']] ],
14             string => [ qw/String::Util String::CamelCase/ ],
15             };
16              
17             $Utils->{'scalar'} = $Utils->{data};
18             # I'll delete no dash group in the above, in future.
19             $Utils->{'-' . $_} = $Utils->{$_} foreach keys %$Utils;
20              
21             our $SubExporterImport = 'do_import';
22              
23       87     sub _default_kinds { }
24              
25             # borrow from List::MoreUtils
26             sub _any (&@) {
27 92     92   178 my $f = shift;
28 92 100       240 return if ! @_;
29 75         144 for (@_) {
30 124 100       177 return 1 if $f->();
31             }
32 37         77 return 0;
33             }
34              
35             sub _uniq (@) {
36 306     306   251 my %h;
37 306 100       378 map { $h{$_}++ == 0 ? $_ : () } @_;
  4483         9811  
38             }
39             # /end
40              
41             sub import {
42 122     122   53535 my ($pkg, $caller) = (shift, (caller)[0]);
43 122 100 100     1070 return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-[A-Z]\w+$/o;
44              
45 90         111 my %opt;
46 90 100 100     419 if (@_ > 1 and ref $_[-1] eq 'HASH') {
47             @opt{qw/prefix module_prefix debug smart_rename plugin/}
48 42         50 = (delete @{$_[-1]}{qw/prefix module_prefix debug smart_rename plugin/});
  42         181  
49 42 100       49 pop @_ unless %{$_[-1]};
  42         106  
50             }
51 90   100     1593 $opt{$_} ||= 0 foreach qw/prefix module_prefix debug smart_rename/;
52 90 100 66     270 if (not defined $opt{plugin}) {
    50          
53 82         807 $opt{plugin} = 'lazy';
54             } elsif ($opt{plugin} and $opt{plugin} ne 'eager') {
55 0         0 Carp::croak "wrong option is passed for plugin: " . $opt{plugin};
56             }
57              
58 90 100 100     1683 @_ = %{$_[0]} if @_ == 1 and ref $_[0] eq 'HASH';
  7         27  
59              
60 55     55   231 my $config = Clone::clone(do { no strict 'refs'; ${$pkg . '::Utils'} });
  55         80  
  55         46406  
  90         90  
  90         80  
  90         2677  
61 90 100       681 if ($pkg->can('_plugins')) {
62 13 100       27 if ($opt{plugin} eq 'eager') {
63 4         11 foreach my $plugin ($pkg->plugins) {
64 12         4964 eval "require $plugin";
65 12         156 my $util = $plugin->utils;
66 12         117 foreach my $kind (keys %$util) {
67 16   100     16 push @{$config->{$kind} ||= []}, @{$util->{$kind}};
  16         48  
  16         43  
68             }
69             }
70             }
71             }
72 90 100       650 my ($arg, $want_kind) = $pkg->_arrange_args
    100          
73             ([
74             @_ ? ($_[0] =~m{^[-:]?all$}i ? ($_[0], $pkg->_default_kinds, @_[1 .. $#_]) : ($pkg->_default_kinds, @_))
75             : ($pkg->_default_kinds)
76             ],
77             $config, $caller, \%opt);
78 90         323 foreach my $kind (keys %$want_kind) {
79             # Carp::croak "$pkg doesn't have such kind of functions : $kind"
80             # unless exists $config->{$kind};
81 249         30928 $pkg->_kind_exporter($caller, $config->{$kind}, (lc(join "", $kind =~m{(\w+)}go)), $want_kind->{$kind}, \%opt);
82             }
83             }
84              
85             sub _kind_exporter {
86 249     249   376 my ($pkg, $caller, $kind_config, $kind_word, $import_setting, $opt) = @_;
87 249         466 my ($wanted_funcs, $local_definition, $kind_prefix, $kind_args) = $pkg->_func_definitions($import_setting);
88 249         263 my ($prefix, %exported, %class_func);
89              
90 249         1022 foreach my $class_config (@$kind_config) { # $class_config is class name or array ref
91 393 100       958 my ($class, $module_prefix, $config_options) = ref $class_config ? @$class_config : ($class_config, '', '');
92              
93 393         405 my $evalerror = '';
94 393 100       944 if ($evalerror = do { local $@; eval {my $path = $class; $path =~s{::}{/}go; require $path. ".pm"; $evalerror = $@ }; $@}) {
  393         336  
  393         421  
  393         341  
  393         908  
  393         42961  
  391         287403  
  393         989  
95             # if ($evalerror = do { local $@; eval "require $class"; $evalerror = $@ }) {
96 2 100       288 $opt->{debug} == 2 ? Carp::croak $evalerror : Carp::carp $evalerror;
97             }
98              
99             $prefix = $kind_prefix ? $kind_prefix :
100             ($opt->{module_prefix} and $module_prefix) ? $module_prefix :
101             $opt->{prefix} ? lc($kind_word) . '_' :
102 392 100 66     1621 $opt->{smart_rename} ? $pkg->_create_smart_rename($kind_word) : '';
    100          
    100          
    100          
103              
104 392         324 my (@funcs, %rename);
105 392 100       603 if (ref $config_options eq 'HASH') {
106             # -kind => {'first' => 'list_first', # first as list_first
107             # 'min' => \&build_min_reformatter,
108             # -select => ['first', 'sum', 'shuffle'] }
109              
110 66 100       192 if (exists $config_options->{-select}) {
    100          
    50          
111 34 50       57 Carp::croak "cannot use -except & -select in same time." if exists $config_options->{-except};
112 34         26 @funcs = @{$config_options->{-select}}
  34         71  
113             } elsif (exists $config_options->{-except}) {
114 1         1 my %except;
115 1         1 @except{@{$config_options->{-except}}} = ();
  1         4  
116 1         2 @funcs = grep !exists $except{$_}, @{_all_funcs_in_class($class)};
  1         2  
117             } elsif (not @funcs) {
118 31         20 @funcs = @{_all_funcs_in_class($class)};
  31         52  
119             }
120 66 100       1203 foreach my $function (@$wanted_funcs ? (grep {defined $config_options->{$_}} @$wanted_funcs) : grep !/^-/, keys %$config_options) {
  29         42  
121 130 100       218 if (ref(my $gen = $config_options->{$function}) eq 'CODE') {
    100          
122             # Like Sub::Exporter generator
123 83 100       99 if (exists $local_definition->{$function}) {
124 6         4 foreach my $def (@{$local_definition->{$function}}) {
  6         11  
125 10         122 my %arg;
126 10         38 $arg{$_} = $def->{$_} for grep !/^-/, keys %$def;
127 10   33     39 ExportTo::export_to($caller => {($def->{-as} || $function)
128             => $gen->($pkg, $class, $function, \%arg, $kind_args)});
129             }
130             } else {
131 77 100       83 if ($function ne '.') {
132 76         172 ExportTo::export_to($caller => {$prefix . $function => $gen->($pkg, $class, $function, {}, $kind_args)});
133             } else {
134 1         3 $gen->($pkg, $class, $function, {}, $kind_args);
135             }
136             }
137 83         4846 $exported{$function} = undef;
138 47         113 } elsif (defined &{$class . '::' . $function}) {
139 44         36 push @funcs, $function;
140 44         65 $rename{$function} = $config_options->{$function};
141             }
142             }
143             } else {
144 326 100       495 @funcs = ref $config_options eq 'ARRAY' ? @$config_options : @{_all_funcs_in_class($class)};
  284         431  
145             }
146 392         1317 $class_func{$class} = [\@funcs, \%rename];
147             }
148 248         223 my %want_funcs;
149 248         313 @want_funcs{@$wanted_funcs} = ();
150 248         475 foreach my $class (keys %class_func) {
151             _do_export($caller, $class, $class_func{$class}->[0], \%want_funcs, \%exported,
152 387         31492 $local_definition, $class_func{$class}->[1], $prefix, $kind_prefix);
153             }
154             }
155              
156             sub _do_export {
157 387     387   595 my ($caller, $class, $funcs, $want_funcs, $exported, $local_definition, $rename, $prefix, $kind_prefix) = @_;
158 387         768 my %reverse_rename = reverse %$rename;
159 387 100       1032 if (%$local_definition) {
    100          
160 29         47 foreach my $func (keys %$local_definition) {
161 40 100       808 next if exists $exported->{$func};
162 29 50 66     69 next if %$want_funcs and not exists $want_funcs->{$func};
163              
164 29         23 foreach my $def (@{$local_definition->{$func}}) {
  29         50  
165 29 50       48 if (ref $def eq 'HASH') {
166 29   50     63 my $local_rename = $def->{-as} || '';
167 29   66     90 my $original_func = $reverse_rename{$func} || $func;
168 55 100   55   298 if (do { no strict 'refs'; defined &{$class . '::' . $original_func} }) {
  55         67  
  55         6005  
  29         20  
  29         28  
  29         147  
169 15 0       24 my $function_name =
    0          
    50          
170             ($local_rename ? $local_rename :
171             $prefix ? (ref $prefix eq 'CODE' ? $prefix->($func) : $prefix . $func) : $func);
172 15         54 ExportTo::export_to($caller => {$function_name => $class . '::' . $original_func});
173             }
174             } else {
175 0 0       0 Carp::croak("setting for fucntions must be hash ref for : $func => "
176             . (ref $def eq 'ARRAY' ? "[". join(", ",@$def) ."]" : $def));
177             }
178             }
179             }
180             } elsif (@$funcs) {
181 55     55   216 no strict 'refs';
  55         67  
  55         17882  
182 339         403 @$funcs = grep defined &{$class . '::'. $_}, @$funcs;
  6396         9874  
183 339 50       1576 return unless @$funcs;
184             }
185              
186 387         2058 my @export_funcs = grep !exists $local_definition->{$_}, @$funcs;
187 387 100       763 @export_funcs = grep exists $want_funcs->{$_}, @export_funcs if %$want_funcs;
188 387 100 100     1283 if ($prefix or %$rename) {
189 102 100       143 if (ref $prefix eq 'CODE') {
190 1         1 ExportTo::export_to($caller => {map { $prefix->($_) => $class . '::' . $_} @export_funcs});
  3         4  
191             } else {
192 101   66     135 ExportTo::export_to($caller => {map { $prefix . ($rename->{$_} || $_) => $class . '::' . $_} @export_funcs});
  1586         5565  
193             }
194             } else {
195 285         472 ExportTo::export_to($caller => [map $class . '::' . $_, _uniq @export_funcs]);
196             }
197             }
198              
199             sub _create_smart_rename {
200 2     2   4 my ($pkg, $kind) = @_;
201             return sub {
202 9     9   12 my $str = shift;
203 9         10 my $prefix = '';
204 9 100       31 if ($str =~s{^(is_|has_|enable_|disable_|isnt_|have_|set_)}{}) {
205 4         7 $prefix = $1;
206             }
207 9 100 100     80 if ($str !~ m{^$kind} and $str !~ m{$kind$}) {
208 5         21 return $prefix . $kind . '_' . $str;
209             } else {
210 4         19 return $prefix . $str;
211             }
212 2         9 };
213             }
214              
215             {
216             my %tmp;
217             sub _all_funcs_in_class {
218 318     318   354 my ($class) = @_;
219 318 100       1431 return $tmp{$class} if exists $tmp{$class};
220 107         102 my %f;
221             {
222 55     55   244 no strict 'refs';
  55         63  
  55         11171  
  107         144  
223 107         104 @f{@{$class . '::EXPORT_OK'}, @{$class . '::EXPORT'}} = ();
  107         1101  
  107         1153  
224             }
225 107         396 return $tmp{$class} = [grep defined &{$class . '::' . $_}, keys %f];
  2244         3618  
226             }
227             }
228              
229             sub _arrange_args {
230 95     95   5446 my ($pkg, $org_args, $config, $caller, $opt) = @_;
231 95         85 my (@arg, %want_kind);
232 95         236 my $import_module = $pkg->_use_import_module;
233 95         97 my $all_improt = 0;
234 95 100       270 if (@$org_args) {
235 92 50 33     322 @$org_args = %{$org_args->[0]} if ref $org_args->[0] and (ref $org_args->[0]) eq 'HASH';
  0         0  
236 92   100     233 $opt->{'plugin'} ||= '';
237 92 100 100     665 if ($org_args->[0] =~ /^([:-])?all/i) {
    100          
238 20         34 my $all_import = shift @$org_args;
239 20         75 my $inherit_all = $1;
240 20 100 100     160 $pkg->_lazy_load_plugins_all($config) if $opt->{'plugin'} eq 'lazy' and $pkg->can('_plugins');
241             # import all functions which Util::Any proxy
242 20         105 @want_kind{keys %$config} = ();
243 20 100 100     107 if ($inherit_all and $import_module) {
244 4 100 66     31 if ($import_module eq 'Exporter' or $import_module eq 'Exporter::Simple') {
    50          
245 55     55   628 no strict 'refs'; no warnings;
  55     55   70  
  55         1314  
  55         178  
  55         65  
  55         48224  
246 1 50       0 push @arg, ':all' if ${$pkg . '::EXPORT_TAGS'}{"all"};
  1         5  
247              
248             } elsif ($import_module eq 'Sub::Exporter') {
249 3         6 push @arg, '-all';
250             }
251             }
252             } elsif ($opt->{'plugin'} eq 'lazy' and $pkg->can('_plugins')) {
253 4         10 $pkg->_lazy_load_plugins($config, $org_args);
254             }
255 92 100   124   390 if (_any {ref $_} @$org_args) {
  124         387  
256 38         89 for (my $i = 0; $i < @$org_args; $i++) {
257 57         61 my $kind = $org_args->[$i];
258 57         94 my $ref = ref $org_args->[$i + 1];
259 57 100       85 my $import_setting = $ref ? $org_args->[++$i] : undef;
260 57 100 100     167 if ($ref eq 'ARRAY' and !@$import_setting) {
261 2         3 $import_setting = [''];
262             }
263 57         122 _insert_want_arg($config, $kind, $import_setting, \%want_kind, \@arg);
264             }
265             } else {
266             # export specified kinds
267 54         94 foreach my $kind (@$org_args) {
268 45         104 _insert_want_arg($config, $kind, undef, \%want_kind, \@arg);
269             }
270             }
271             }
272 95 100       334 if ($import_module) {
273 11 100 100     81 $pkg->_do_base_import($import_module, $caller, \@arg) if @arg or !@$org_args;
274             } else {
275 84 100       711 Carp::carp("unknown arguments: @arg") if @arg;
276             }
277 95         465 return \@arg, \%want_kind;
278             }
279              
280             sub _insert_want_arg {
281             # distinct arguments to want(for Util::Any) and args(for other).
282 102     102   197 my ($config, $kind, $import_setting, $want_kind, $arg) = @_;
283 102         132 $kind = lc $kind;
284 102 100       193 if (exists $config->{$kind}) {
285 88         256 $want_kind->{$kind} = $import_setting;
286             } else {
287 14 100       45 push @$arg, $kind, defined $import_setting ? $import_setting : ();
288             }
289             }
290              
291             sub _lazy_load_plugins_all {
292 1     1   2 my ($pkg, $config) = @_;
293 1         2 foreach my $plugin (@{$pkg->_plugins}) {
  1         2  
294 3         113 eval "require $plugin";
295 3 50       23 next if $@;
296 3         9 my $util = $plugin->utils;
297 3         30 foreach my $kind (keys %$util) {
298 4   100     5 push @{$config->{$kind} ||= []}, @{$util->{$kind}};
  4         13  
  4         12  
299             }
300             }
301             }
302              
303             sub _lazy_load_plugins {
304 4     4   4 my ($pkg, $config, $org_args) = @_;
305 4         5 my (@all, @kinds);
306 4         2 for my $i (0 .. $#{$org_args}) {
  4         11  
307 5 50       13 next if ref $org_args->[$i];
308 5         5 my $k = $org_args->[$i];
309 5         17 $k =~ s{\W+}{}g;
310 5         8 $k =~ s{_}{::}g;
311 5 100       14 $k =~ s{^(.+)::all$}{$1|$1::\\w+} and push @all, $i;
312 5         10 push @kinds, $k;
313             }
314 4 50       6 return unless @kinds;
315              
316 4         13 my $regex = "^${pkg}::Plugin::(?:". join("|", @kinds) . ')';
317 4         4 my $all_regex = '';
318 4 100       7 if (@all) {
319 1         5 $org_args->[$_] =~s{_all$}{} for @all;
320 1         3 $all_regex = "^${pkg}::Plugin::(?:".join("|", map {m{(\w+)}} @{$org_args}[@all]). ')';
  1         5  
  1         2  
321             }
322 4         5 foreach my $plugin (@{$pkg->_plugins}) {
  4         6  
323 12 100 100     180 if ($plugin =~m{$regex\W}i or $plugin =~m{$regex$}i) {
324 7         282 eval "require $plugin";
325 7 50       145 next if $@;
326 7         23 my $util = $plugin->utils;
327 7         65 foreach my $kind (keys %$util) {
328 9   100     10 push @{$config->{$kind} ||= []}, @{$util->{$kind}};
  9         27  
  9         11  
329 9 50 66     48 if ($all_regex and ($plugin =~ m{$all_regex\W}i or $plugin =~ m{$all_regex$}i)) {
      66        
330 2         9 push @$org_args, $kind;
331             }
332             }
333             }
334             }
335             }
336              
337             sub _func_definitions {
338 249     249   245 my ($pkg, $want_func_definition) = @_;
339 249         242 my ($kind_prefix, $kind_args, @wanted_funcs, %funcs, %local_definition);
340 249 100       1085 if (ref $want_func_definition eq 'HASH') {
    100          
341             # list => {func => {-as => 'rename'}}; list => {-prefix => 'hoge_' }
342             $kind_prefix = $want_func_definition->{-prefix}
343 17 100       50 if exists $want_func_definition->{-prefix};
344             $kind_args = $want_func_definition->{-args}
345 17 50       51 if exists $want_func_definition->{-args};
346 17         58 foreach my $f (grep !/^-/, keys %$want_func_definition) {
347 12         59 $local_definition{$f} = [$want_func_definition->{$f}];
348             }
349             } elsif (ref $want_func_definition eq 'ARRAY') {
350 21         51 foreach (my $i = 0; $i < @$want_func_definition; $i++) {
351 39         37 my ($k, $v) = @{$want_func_definition}[$i, $i + 1];
  39         64  
352 39 100       441 if ($k eq '-prefix') {
    100          
    100          
353 1         2 $kind_prefix = $v;
354 1         2 $i++;
355             } elsif ($k eq '-args') {
356 1         1 $kind_args = $v;
357 1         2 $i++;
358             }elsif (ref $v) {
359 13         7 $i++;
360 13         15 push @wanted_funcs, $k;
361 13   100     10 push @{$local_definition{$k} ||= []}, $v;
  13         64  
362             } else {
363 24         60 push @wanted_funcs, $k;
364             }
365             }
366 21         44 @wanted_funcs = _uniq @wanted_funcs;
367             }
368 249   100     3932 return \@wanted_funcs, \%local_definition, $kind_prefix || '', $kind_args || {};
      100        
369             }
370              
371             sub _do_base_import {
372             # working with other modules like Expoter
373 10     10   14 my ($pkg, $import_module, $caller, $arg) = @_;
374 10         8 my $pkg_utils;
375             {
376 55     55   272 no strict 'refs';
  55         78  
  55         1379  
  10         12  
377 55     55   198 no warnings;
  55         63  
  55         4063  
378 10         9 $pkg_utils = ${$pkg . '::Utils'};
  10         28  
379             }
380 10 50       44 if ($import_module eq 'Exporter::Simple') {
    100          
    50          
381 0         0 eval "package $caller; $pkg" . '->Exporter::Simple::import(@$arg);';
382             } elsif ($import_module eq 'Exporter') {
383 4         250 eval "package $caller; $pkg" . '->Exporter::import(@$arg);';
384             } elsif ($import_module eq 'Sub::Exporter') {
385 55     55   217 no strict 'refs';
  55         68  
  55         1268  
386 55     55   178 no warnings;
  55         63  
  55         5682  
387 6   66     6 my $import_name = ${"${pkg}::SubExporterImport"} || $Util::Any::SubExporterImport;
388 6         983 eval "package $caller; $pkg" . '->$import_name(@$arg);';
389             }
390 10 50       2361 die $@ if $@;
391             }
392              
393             sub _base_import {
394 39     39   10187 my ($pkg, $caller, @flgs) = @_;
395             {
396 55     55   219 no strict 'refs';
  55         54  
  55         2809  
  39         47  
397 39         38 push @{"${caller}::ISA"}, __PACKAGE__;
  39         394  
398             }
399 39         52 my @unknown;
400 39   66     277 while (@flgs and my $flg = lc shift @flgs) {
401 55     55   193 no strict 'refs';
  55         78  
  55         20634  
402 42 100       221 if ($flg eq '-subexporter') {
    100          
    100          
    100          
    100          
403 8         17 eval { require Sub::Exporter };
  8         662  
404 8     8   7248 *{$caller . '::_use_import_module'} = sub { 'Sub::Exporter' };
  8         56  
  8         500  
405             } elsif ($flg eq '-exportersimple') {
406 5         8 eval { require Exporter::Simple };
  5         967  
407 5     1   51 *{$caller . '::_use_import_module'} = sub { 'Exporter::Simple' };
  5         38  
  1         2  
408             } elsif ($flg eq '-exporter') {
409 7         29 require Exporter;
410 7         6 push @{"${caller}::ISA"}, 'Exporter';
  7         48  
411 7     7   39 *{$caller . '::_use_import_module'} = sub { 'Exporter' };
  7         42  
  7         272  
412             } elsif ($flg eq '-base') {
413             # nothing to do
414             } elsif ($flg eq '-pluggable') {
415             # pluggable
416 3         1501 require Module::Pluggable;
417 3         27280 Module::Pluggable->import(require => 0, search_path => [$caller . '::Plugin'], inner => 0);
418 3         151 my @plugins = $pkg->plugins;
419 3     5   4189 *{$caller . '::_plugins'} = sub { \@plugins };
  3         32  
  5         9  
420             } else {
421 1         4 push @unknown, $flg;
422             }
423             }
424 39 100       2997 Carp::croak "cannot understand the option: @unknown" if @unknown;
425             }
426              
427 84     84   97 sub _use_import_module { 0 }
428              
429             =head1 NAME
430              
431             Util::Any - to export any utilities and to create your own utility module
432              
433             =cut
434              
435             our $VERSION = '0.25';
436              
437             =head1 SYNOPSIS
438              
439             use Util::Any -list;
440             # you can import any functions of List::Util and List::MoreUtils
441            
442             print uniq qw/1, 0, 1, 2, 3, 3/;
443              
444             If you want to choose functions
445              
446             use Util::Any -list => ['uniq'];
447             # you can import uniq function only, not import other functions
448            
449             print uniq qw/1, 0, 1, 2, 3, 3/;
450              
451             If you want to import All kind of utility functions
452              
453             use Util::Any -all;
454            
455             my $o = bless {};
456             my %hash = (a => 1, b => 2);
457            
458             # from Scalar::Util
459             blessed $o;
460            
461             # from Hash::Util
462             lock_keys %hash;
463              
464             If you want to import functions with prefix(ex. list_, scalar_, hash_)
465              
466             use Util::Any -all, {prefix => 1};
467             use Util::Any -list, {prefix => 1};
468             use Util::Any -list => ['uniq', 'min'], {prefix => 1};
469            
470             print list_uniq qw/1, 0, 1, 2, 3, 3/;
471            
472              
473             If you want to import functions with your own prefix.
474              
475             use Util::Any -list => {-prefix => "l_"};
476             print l_uniq qw/1, 0, 1, 2, 3, 3/;
477              
478             If you want to import functions as different name.
479              
480             use Util::Any -list => {uniq => {-as => 'listuniq'}};
481             print listuniq qw/1, 0, 1, 2, 3, 3/;
482              
483             When you use both renaming and your own prefix ?
484              
485             use Util::Any -list => {uniq => {-as => 'listuniq'}, -prefix => "l_"};
486             print listuniq qw/1, 0, 1, 2, 3, 3/;
487             print l_min qw/1, 0, 1, 2, 3, 3/;
488             # the following is NG
489             print l_uniq qw/1, 0, 1, 2, 3, 3/;
490              
491             =head1 DESCRIPTION
492              
493             For the people like the man who cannot remember C function is in whether List::Util or List::MoreUtils.
494             And for the newbie who don't know where useful utilities is.
495              
496             Perl has many modules and they have many utility functions.
497             For example, List::Util, List::MoreUtils, Scalar::Util, Hash::Util,
498             String::Util, String::CamelCase, Data::Dumper etc.
499              
500             We, Perl users, have to memorize modules name and their functions name.
501             Using this module, you don't need to memorize modules name,
502             only memorize kinds of modules and functions name.
503              
504             And this module allows you to create your own utility module, easily.
505             You can create your own module and use this in the same way as Util::Any like the following.
506              
507             use YourUtil -list;
508              
509             see C, in detail.
510              
511             =head1 HOW TO USE
512              
513             =head2 use Util::Any (KIND)
514              
515             use Util::Any -list, -hash;
516              
517             Give list of kinds of modules. All functions in modules are exported.
518              
519             =head2 use Util::Any KIND => [FUNCTIONS], ...;
520              
521             NOTE THAT kind '-all', 'all' or ':all' cannot take this option.
522              
523             use Util::Any -list => ['uniq'], -hash => ['lock_keys'];
524              
525             Give hash whose key is kind and value is function names as array ref.
526             Selected functions are exported.
527              
528             you can write it as hash ref.
529              
530             use Util::Any {-list => ['uniq'], -hash => ['lock_keys']};
531              
532             =head2 use Util::Any ..., {OPTION => VALUE};
533              
534             Util::Any can take last argument as option, which should be hash ref.
535              
536             =over 4
537              
538             =item prefix => 1
539              
540             add kind prefix to function name.
541              
542             use Util::Any -list, {prefix => 1};
543            
544             list_uniq(1,2,3,4,5); # it is List::More::Utils's uniq function
545              
546             =item module_prefix => 1
547              
548             see L.
549             Uti::Any itself doesn't have such a definition.
550              
551             =item smart_rename => 1
552              
553             see L.
554              
555             =item plugin => 'lazy' / 'eager' / 0 (default is 'lazy')
556              
557             If utility module based on Util::Any has plugin,
558             Its plugins are loaded when related kind is specified(if kind name matches module name).
559             If you want to load all plugin on using module, give 'eager' to this option.
560             If you don't want to use plugin, set 0.
561              
562             use Util::Yours -kind, .... {plugin => 'eager'}; # all plugins are loaded
563             use Util::Yours -kind, .... {plugin => 0}; # disable plugin feature.
564             use Util::Yours -kind; # is equal {plugin => 'lazy'}
565              
566             Relation of kind name and plugin name is the following.
567              
568             for example, If you have the following modules.
569              
570             Util::Yours::Plugin::Date
571             Util::Yours::Plugin::DateTime
572             Util::Yours::Plugin::Net
573             Util::Yours::Plugin::Net::Amazon
574             Util::Yours::Plugin::Net::Twitter
575              
576             the following code:
577              
578             use Util::Yours -date; # Plugin::Date is loaded
579             use Util::Yours -datetime; # Plugin::DateTime is loaded
580             use Util::Yours -net; # Plugin::Net is loaded
581             use Util::Yours -net_amazon; # Plugin::Net::Amazon is loaded
582             use Util::Yours -net_all; # Plugin::Net and Plugin::Net::* is loaded
583              
584             C<_all> is special keyword. see L<"NOTE ABOUT all KEYWORD">.
585              
586             =item debug => 1/2
587              
588             Util::Any doesn't say anything when loading module fails.
589             If you pass debug value, warn or die.
590              
591             use Util::Any -list, {debug => 1}; # warn
592             use Util::Any -list, {debug => 2}; # die
593              
594             =back
595              
596             =head1 EXPORT
597              
598             Kinds of functions and list of exported functions are below.
599             Note that these modules and version are on my environment(Perl 5.8.4).
600             So, it must be different on your environment.
601              
602             =head2 -data
603              
604             NOTE THAT: its old name is 'scalar' (you can use the name, yet).
605              
606             from Scalar::Util (1.19)
607              
608             blessed
609             dualvar
610             isvstring
611             isweak
612             looks_like_number
613             openhandle
614             readonly
615             refaddr
616             reftype
617             set_prototype
618             tainted
619             weaken
620              
621             =head2 -hash
622              
623             from Hash::Util (0.05)
624              
625             hash_seed
626             lock_hash
627             lock_keys
628             lock_value
629             unlock_hash
630             unlock_keys
631             unlock_value
632              
633             =head2 -list
634              
635             from List::Util (1.19)
636              
637             first
638             max
639             maxstr
640             min
641             minstr
642             reduce
643             shuffle
644             sum
645              
646             from List::MoreUtils (0.21)
647              
648             after
649             after_incl
650             all
651             any
652             apply
653             before
654             before_incl
655             each_array
656             each_arrayref
657             false
658             first_index
659             first_value
660             firstidx
661             firstval
662             indexes
663             insert_after
664             insert_after_string
665             last_index
666             last_value
667             lastidx
668             lastval
669             mesh
670             minmax
671             natatime
672             none
673             notall
674             pairwise
675             part
676             true
677             uniq
678             zip
679              
680             from List::Pairwise (0.29)
681              
682             mapp
683             grepp
684             firstp
685             lastp
686             map_pairwise
687             grep_pairwise
688             first_pairwise
689             last_pairwise
690             pair
691              
692             =head2 -string
693              
694             from String::Util (0.11)
695              
696             crunch
697             define
698             equndef
699             fullchomp
700             hascontent
701             htmlesc
702             neundef
703             nospace
704             randcrypt
705             randword
706             trim
707             unquote
708              
709             from String::CamelCase (0.01)
710              
711             camelize
712             decamelize
713             wordsplit
714              
715             =head2 -debug
716              
717             from Data::Dumper (2.121)
718              
719             Dumper
720              
721             =head1 EXPORTING LIKE Sub::Exporter
722              
723             Like Sub::Exporter, Util::Any can export function name as you like.
724              
725             use Util::Yours -list => {-prefix => 'list__', miin => {-as => "lmin"}};
726              
727             functions in -list, are exported with prefix "list__" except 'min' and 'min' is exported as C.
728              
729             =head1 PRIORITY OF THE WAYS TO CHANGE FUNCTION NAME
730              
731             There are some ways to change function name.
732             Their priority is the following.
733              
734             =over 4
735              
736             =item 1 rename
737              
738             -list => {uniq => {-as => 'luniq'}}
739              
740             =item 2 kind_prefix
741              
742             -list => {-prefix => list}
743              
744             =item 3 module_prefix
745              
746             Only if module's prefix is defined
747              
748             ..., {module_prefix => 1}
749              
750             =item 4 prefix
751              
752             ..., {prefix => 1}
753              
754             =item 5 smart_rename
755              
756             ..., {smart_rename => 1}
757              
758             =back
759              
760             I don't recommend to use 3, 4, 5 in same time, because it may confuse you.
761              
762             =over 4
763              
764             =item 3 + 4
765              
766             if module's prefix is defined in class(not defined in Util::Any), use 3, or use 4.
767              
768             =item 3 + 5
769              
770             3 or 5. reason is as same as the above.
771              
772             =item 3 + 4 + 5
773              
774             5 is ignored.
775              
776             =item 4 + 5
777              
778             5 is ignored.
779              
780             =back
781              
782             =head1 NOTE ABOUT all KEYWORD
783              
784             B is special keyword, so it has some restriction.
785              
786             =head2 use module with 'all' cannot take its arguments
787              
788             use Util::Any -all; # or 'all', ':all'
789              
790             This cannot take sequential arguments for "all". For example;
791              
792             NG: use Util::Any -all => ['shuffle'];
793              
794             When sequential arguments is kind's, it's ok.
795              
796             use Util::Any -all, -list => ['unique'];
797              
798             =head2 -plugin_module_all cannot take its arguments
799              
800             use Util::Yours -plugin_name_all;
801              
802             This cannot take sequential arguments for it. For example:
803              
804             NG: use Util::Yours -plugin_name_all => ['some_function'];
805              
806             =head1 CREATE YOUR OWN Util::Any
807              
808             Just inherit Util::Any and define $Utils hash ref as the following.
809              
810             package Util::Yours;
811            
812             use Clone qw/clone/;
813             use Util::Any -Base; # as same as use base qw/Util::Any/;
814             # If you don't want to inherit Util::Any setting, no need to clone.
815             our $Utils = clone $Util::Any::Utils;
816             push @{$Utils->{-list}}, qw/Your::Favorite::List::Utils/;
817            
818             1;
819              
820             In your code;
821              
822             use Util::Yours -list;
823              
824             =head2 $Utils STRUCTURE
825              
826             =head3 overview
827              
828             $Utils => {
829             # simply put module names
830             -kind1 => [qw/Module1 Module2 ..../],
831             -# Module name and its prefix
832             -kind2 => [ [Module1 => 'module_prefix'], ... ],
833             # limit functions to be exported
834             -kind3 => [ [Module1, 'module_prefix', [qw/func1 func2/] ], ... ],
835             # as same as above except not specify modul prefix
836             -kind4 => [ [Module1, '', [qw/func1 func2/] ], ... ],
837             };
838              
839             =head3 Key must be lower character.
840              
841             NG $Utils = { LIST => [qw/List::Util/]};
842             OK $Utils = { list => [qw/List::Util/]};
843             OK $Utils = { -list => [qw/List::Util/]};
844             OK $Utils = { ':list' => [qw/List::Util/]};
845              
846             =head3 C cannot be used for key.
847              
848             NG $Utils = { all => [qw/List::Util/]};
849             NG $Utils = { -all => [qw/List::Util/]};
850             NG $Utils = { ':all' => [qw/List::Util/]};
851              
852             =head3 Value is array ref which contained scalar or array ref.
853              
854             Scalar is module name. Array ref is module name and its prefix.
855              
856             $Utils = { list => ['List::Utils'] };
857             $Utils = { list => [['List::Utils', 'prefix_']] };
858              
859             see L
860              
861             =head2 PREFIX FOR EACH MODULE
862              
863             If you want to import many modules and they have same function name.
864             You can specify prefix for each module like the following.
865              
866             use base qw/Util::Any/;
867            
868             our $Utils = {
869             list => [['List::Util' => 'lu_'], ['List::MoreUtils' => 'lmu_']]
870             };
871              
872             In your code;
873              
874             use Util::Yours qw/list/, {module_prefix => 1};
875              
876             =head2 SMART RENAME FOR EACH KIND
877              
878             smart_rename option rename function name by a little smart way.
879             For example,
880              
881             our $Utils = {
882             utf8 => [['utf8', '',
883             {
884             is_utf8 => 'is_utf8',
885             upgrade => 'utf8_upgrade',
886             downgrade => 'downgrade',
887             }
888             ]],
889             };
890              
891             In this definition, use C 1> is not good idea. If you use it:
892              
893             is_utf8 => utf8_is_utf8
894             utf8_upgrade => utf8_utf8_upgrade
895             downgrade => utf8_downgrade
896              
897             That's too bad. If you use C 1> instead:
898              
899             is_utf8 => is_utf8
900             utf8_upgrade => utf8_upgrade
901             downgrade => utf8_downgrade
902              
903             rename rule is represented in _create_smart_rename in Util::Any.
904              
905             =head2 CHANGE smart_rename BEHAVIOUR
906              
907             To define _create_smart_rename, you can change smart_rename behaviour.
908             _create_smart_rename get 2 argument, package name and kind of utility,
909             and should return code reference which get function name and return new name.
910             As an example, see Util::Any's _create_smart_rename.
911              
912             =head2 OTHER WAY TO EXPORT FUNCTIONS
913              
914             =head3 SELECT FUNCTIONS
915              
916             Util::Any automatically export functions from modules' @EXPORT and @EXPORT_OK.
917             In some cases, it is not good idea like Data::Dumper's Dumper and C.
918             These 2 functions are same feature.
919              
920             So you can limit functions to be exported.
921              
922             our $Utils = {
923             -debug => [
924             ['Data::Dumper', '',
925             ['Dumper']], # only Dumper method is exported.
926             ],
927             };
928              
929             or
930              
931             our $Utils = {
932             -debug => [
933             ['Data::Dumper', '',
934             { -select => ['Dumper'] }, # only Dumper method is exported.
935             ]
936             ],
937             };
938              
939              
940             =head3 SELECT FUNCTIONS EXCEPT
941              
942             Inverse of -select option. Cannot use this option with -select.
943              
944             our $Utils = {
945             -debug => [
946             ['Data::Dumper', '',
947             { -except => ['DumperX'] }, # export functions except DumperX
948             ]
949             ],
950             };
951              
952             =head3 RENAME FUNCTIONS
953              
954             To rename function name, write original function name as hash key and renamed name as hash value.
955             this definition is prior to -select/-except.
956              
957             In the following example, 'min' is not in -select list, but can be exported.
958              
959             our $Utils = {
960             -list => [[
961             'List::Util', '',
962             {
963             'first' => 'list_first', # first as list_first
964             'sum' => 'lsum', # sum as lsum
965             'min' => 'lmin', # min as lmin
966             -select => ['first', 'sum', 'shuffle'],
967             }
968             ]]
969             };
970              
971             =head3 USE Sub::Exporter's GENERATOR WAY
972              
973             It's somewhat complicate, I just show you code.
974              
975             Your utility class:
976              
977             package SubExporterGenerator;
978            
979             use strict;
980             use Util::Any -Base;
981            
982             our $Utils =
983             {
984             -test => [[
985             'List::Util', '',
986             { min => \&build_min_reformatter,}
987             ]]
988             };
989            
990             sub build_min_reformatter {
991             my ($pkg, $class, $name, @option) = @_;
992             no strict 'refs';
993             my $code = do { no strict 'refs'; \&{$class . '::' . $name}};
994             sub {
995             my @args = @_;
996             $code->(@args, $option[0]->{under} || ());
997             }
998             }
999              
1000             Your script using your utility class:
1001              
1002             package main;
1003            
1004             use strict;
1005             use lib qw(lib t/lib);
1006             use SubExporterGenerator -test => [
1007             min => {-as => "min_under_20", under => 20},
1008             min => {-as => "min_under_5" , under => 5},
1009             ];
1010            
1011             print min_under_20(100,25,30); # 20
1012             print min_under_20(100,10,30); # 10
1013             print min_under_20(100,25,30); # 5
1014             print min_under_20(100,1,30); # 1
1015              
1016             If you don't specify C<-as>, exported function as C.
1017             But, of course, the following doesn't work.
1018              
1019             use SubExporterGenerator -test => [
1020             min => {under => 20},
1021             min => {under => 5},
1022             ];
1023              
1024             Util::Any try to export duplicate function C, one of both should fail.
1025              
1026             =head4 GIVE DEFAULT ARGUMENTS TO CODE GENERATOR
1027              
1028             You may want to give default arguments to all code generators in same kind.
1029             For example, if you create shortcut to use Number::Format,
1030             you may want to give common arguments with creating instance.
1031              
1032             -number => [
1033             [ 'Number::Format' => {
1034             'round' => sub {
1035             my($pkg, $class, $func, $args, $default_args) = @_;
1036             my $n = 'Number::Format'->new(%$default_args);
1037             sub { $n->round(@_); }
1038             },
1039             'number_format' => sub {
1040             my($pkg, $class, $func, $args, $default_args) = @_;
1041             my $n = 'Number::Format'->new(%$default_args, %$args);
1042             sub { $n->format_number(@_); }
1043             }
1044             }
1045             ];
1046              
1047             And write as the following:
1048              
1049             use Util::Yours -number => [-args => {thousands_sep => "_", int_curr_symbol => '\'} ];
1050            
1051             print number_format(100000); # 100_000
1052             print number_price(100000); # \100_000
1053              
1054             thousands_sep and int_curr_symbol are given to all of -number kind of function.
1055              
1056             =head2 DO SOMETHING WITHOUT EXPORTING ANYTHING
1057              
1058             -strict => [
1059             [ 'strict' => {
1060             '.' => sub {
1061             strict->import();
1062             warnings->import();
1063             },
1064             }
1065             ];
1066              
1067             This definition works like as pragma.
1068              
1069             use Util::Yours -strict;
1070              
1071             function name '.' is special. This name is not exported and only execute the code in the definition.
1072              
1073             =head2 ADD DEFAULT ARGUMENT FOR EXPORTING
1074              
1075             Define the following method.
1076              
1077             package You::Utils -Base;
1078             # ....
1079             sub _default_kinds { '-list', '-string' }
1080              
1081             This means '-list' and '-string' arguments are given as default exporting arguments.
1082             So, these are same.
1083              
1084             use Your::Utils;
1085              
1086             is equal to
1087              
1088             use Your::Utils -list, -string;
1089              
1090             If you want to disable default kinds.
1091              
1092             use Your::Utils -list => [], -string;
1093              
1094             =head2 ADD PLUGGABLE FEATURE FOR YOUR MODULE
1095              
1096             Just add a flag -Pluggbale.
1097              
1098             package Util::Yours;
1099             use Util::Any -Base, -Pluggable;
1100              
1101             And write plugin as the following:
1102              
1103             package Util::Yours::Plugin::Net;
1104            
1105             sub utils {
1106             # This structure is as same as $Utils.
1107             return {
1108             # kind name and plugin name should be same.
1109             -net => [
1110             [
1111             'Net::Amazon', '',
1112             {
1113             amazon => sub {
1114             my ($pkg, $class, $func, $args) = @_;
1115             my $amazon = Net::Amazon->new(token => $args->{token});
1116             sub { $amazon }
1117             },
1118             }
1119             ]
1120             ]
1121             };
1122             }
1123            
1124             1;
1125              
1126             And you can use it as the following.
1127              
1128             use Util::Yours -net => [amazon => {token => "your_token"}];
1129            
1130             my $amazon = amazon; # get Net::Amazon object;
1131              
1132             Util::Any can merge definition in plugins. If same kind is in several plugins, it works.
1133             But same kind and same function name is defined, one of them doesn't work.
1134              
1135             =head2 WORKING WITH EXPORTER-LIKE MODULES
1136              
1137             NOTE THAT: I don't recommend this usage, because using this may confuse user;
1138             some of import options are for Util::Any and others are for exporter-like module
1139             (especially, using with Sub::Exporter is confusing).
1140              
1141             CPAN has some modules to export functions.
1142             Util::Any can work with some of such modules, L, L and L.
1143             (note that: L is not supported after version 0.25 and the above)
1144             If you want to use other modules, please inform me or implement import method by yourself.
1145              
1146             If you want to use module mentioned above, you have to change the way to inherit these modules.
1147              
1148             =head3 DIFFERENCE between 'all' and '-all' or ':all'
1149              
1150             If your utility module which inherited Util::Any has utility functions and export them by Exporter-like module,
1151             behaviour of 'all' and '-all' or ':all' is a bit different.
1152              
1153             'all' ... export all utilities defined in your package's $Utils variables.
1154             '-all' or ':all' ... export all utilities including functions in your util module itself.
1155              
1156             =head3 ALTERNATIVE INHERITING
1157              
1158             Normally, you use;
1159              
1160             package YourUtils;
1161            
1162             use Util::Any -Base; # or "use base qw/Util::Any/;"
1163              
1164             But, if you want to use L, L or L.
1165             write as the following, instead.
1166              
1167             # if you want to use Exporter
1168             use Util::Any -Exporter;
1169             # if you want to use Exporter::Simple
1170             use Util::Any -ExporterSimple;
1171             # if you want to use Sub::Exporter
1172             use Util::Any -SubExporter;
1173              
1174             That's all.
1175             Note that B.
1176              
1177             There is one notice to use Sub::Exporter.
1178              
1179             Sub::Exporter::setup_exporter
1180             ({
1181             as => 'do_import', # name is important
1182             exports => [...],
1183             groups => { ... },
1184             });
1185              
1186             You must pass "as" option to setup_exporter and its value must be "do_import".
1187             If you want to change this name, do the following.
1188              
1189             Sub::Exporter::setup_exporter
1190             ({
1191             as => $YourUtils::SubExporterImport = '__do_import',
1192             exports => [...],
1193             groups => { ... },
1194             });
1195              
1196             =head1 AUTHOR
1197              
1198             Ktat, C<< >>
1199              
1200             =head1 BUGS
1201              
1202             Please report any bugs or feature requests to
1203             C, or through the web interface at
1204             L.
1205             I will be notified, and then you'll automatically be notified of progress on
1206             your bug as I make changes.
1207              
1208             =head1 SUPPORT
1209              
1210             You can find documentation for this module with the perldoc command.
1211              
1212             perldoc Util::Any
1213              
1214             You can also look for information at:
1215              
1216             =over 4
1217              
1218             =item * AnnoCPAN: Annotated CPAN documentation
1219              
1220             L
1221              
1222             =item * CPAN Ratings
1223              
1224             L
1225              
1226             =item * RT: CPAN's request tracker
1227              
1228             L
1229              
1230             =item * Search CPAN
1231              
1232             L
1233              
1234             =back
1235              
1236             =head1 REPOSITORY
1237              
1238             svn co http://svn.coderepos.org/share/lang/perl/Util-Any/trunk Util-Any
1239              
1240             Subversion repository of Util::Any is hosted at http://coderepos.org/share/.
1241             patches and collaborators are welcome.
1242              
1243             =head1 SEE ALSO
1244              
1245             The following modules can work with Util::Any.
1246              
1247             L, L, L and L.
1248              
1249             The following is new module Util::All, based on Util::Any.
1250              
1251             http://github.com/ktat/Util-All
1252              
1253             =head1 ACKNOWLEDGEMENTS
1254              
1255             =head1 COPYRIGHT & LICENSE
1256              
1257             Copyright 2008-2010 Ktat, all rights reserved.
1258              
1259             This program is free software; you can redistribute it and/or modify it
1260             under the same terms as Perl itself.
1261              
1262             =cut
1263              
1264             1; # End of Util-Any