root/lang/perl/Util-Any/trunk/lib/Util/Any.pm @ 31435

Revision 31435, 13.6 kB (checked in by ktat, 5 years ago)

Checking in changes prior to tagging of version 0.05. Changelog diff is:

Line 
1package Util::Any;
2
3use ExportTo ();
4use Carp ();
5use warnings;
6use List::MoreUtils qw/uniq/;
7use strict;
8
9our $Utils = {
10              list   => [ qw/List::Util List::MoreUtils/ ],
11              scalar => [ qw/Scalar::Util/ ],
12              hash   => [ qw/Hash::Util/ ],
13              debug  => [ ['Data::Dumper', '', ['Dumper']] ],
14              string => [ qw/String::Util String::CamelCase/ ],
15             };
16
17sub import {
18  my $pkg = shift;
19  my $caller = (caller)[0];
20
21  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-\w+$/;
22
23  no strict 'refs';
24
25  my $config = ${$pkg . '::Utils'};
26  my %want;
27  my %opt = (prefix => 0, module_prefix => 0, debug => 0);
28
29  if (@_ > 1 and ref $_[-1] eq 'HASH') {
30    %opt = (%opt, %{pop()});
31  }
32
33  if (@_) {
34    if (ref $_[0] eq 'HASH') {
35      my %_want = %{shift()};
36      %want = map {lc($_) => $_want{$_}} keys %_want;
37    } elsif (lc($_[0]) eq 'all') {
38      @want{keys %$config} = ();
39    } else {
40      @want{map lc $_, @_} = ();
41    }
42  }
43
44  no strict 'refs';
45
46  foreach my $kind (keys %$config) {
47    my ($prefix, $module_prefix, $options) = ('','', []);
48
49    if (exists $want{$kind}) {
50      foreach my $class (@{$config->{$kind}}) {
51        ($class, $module_prefix, $options) = ref $class ? @$class : ($class, '', []);
52        if ($opt{module_prefix} and $module_prefix) {
53          $prefix = $module_prefix;
54        } elsif ($opt{prefix}) {
55          $prefix = lc($kind) . '_';
56        }
57        my $evalerror;
58        {
59          local $@;
60          eval "require $class";
61          $evalerror = $@;
62        };
63        unless ($evalerror) {
64          my $export_funcs = ref $options eq 'ARRAY' ? $options : $options->{-select};
65          my (%funcs, %rename);
66          @funcs{@{$class . '::EXPORT_OK'}, @{$class . '::EXPORT'}} = ();
67          my @funcs = grep defined &{$class . '::' . $_}, keys %funcs;
68          if (my $want_func = $want{$kind}) {
69            my %w;
70            @w{@$want_func} = ();
71            @funcs = grep exists $w{$_}, @funcs;
72          } elsif (@{$export_funcs || []}) {
73            @funcs = grep defined &{$class . '::' . $_}, @$export_funcs;
74          }
75          if (ref $options eq 'HASH') {
76            if (exists $options->{-except}) {
77              Carp::croak "cannot use -select & -except in same time." if @{$export_funcs || []};
78              my %except;
79              @except{@{$options->{-except}}} = ();
80              @funcs = grep !exists $except{$_}, @funcs;
81            }
82            foreach my $o (grep !/^-/, keys %$options) {
83              if (defined &{$class . '::' . $o}) {
84                push @funcs , $o;
85                $rename{$o} = $options->{$o};
86              }
87            }
88          }
89          ExportTo::export_to($caller => ($prefix or %rename)
90                              ? {map {$prefix . ($rename{$_} || $_) => $class . '::' . $_} uniq @funcs}
91                              : [map $class . '::' . $_, uniq @funcs]);
92        } elsif(defined $opt{debug}) {
93          $opt{debug} == 2 ? Carp::croak $evalerror : Carp::carp $evalerror;
94        }
95      }
96    }
97  }
98  if ($pkg->_use_perl6_export_attrs) {
99    no strict 'refs';
100    no warnings;
101    my $pkg_utils = ${$pkg . '::Utils'};
102    my @arg = defined $pkg_utils ? (grep !exists $pkg_utils->{$_}, @_)
103                                 : (grep !exists $Utils->{$_}, @_);
104    if (@_ and @arg) {
105      eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg);';
106    } elsif (!@_) {
107      eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import;';
108    }
109  }
110}
111
112sub _base_import {
113  my ($pkg, $caller, @flgs) = @_;
114  {
115    no strict 'refs';
116    push @{"${caller}::ISA"}, __PACKAGE__;
117  }
118
119  while (my $flg = shift @flgs) {
120    if (lc($flg) eq '-perl6exportattrs') {
121      eval "use Perl6::Export::Attrs ();";
122      no strict 'refs';
123      *{$caller . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
124      *{$caller . '::_use_perl6_export_attrs'} = sub { 1 };
125    }
126  }
127}
128
129sub _use_perl6_export_attrs { 0 }
130
131=head1 NAME
132
133Util::Any - Export any utilities and To create your own Util::Any
134
135=head1 VERSION
136
137Version 0.05
138
139=cut
140
141our $VERSION = '0.05';
142
143=head1 SYNOPSIS
144
145    use Util::Any qw/list/;
146    # you can import any functions of List::Util and List::MoreUtils
147   
148    print uniq qw/1, 0, 1, 2, 3, 3/;
149
150If you want to choose functions
151
152    use Util::Any {list => qw/uniq/};
153    # you can import uniq function, not import other functions
154   
155    print uniq qw/1, 0, 1, 2, 3, 3/;
156
157If you want to import All kind of utility functions
158
159    use Util::Any qw/all/;
160   
161    my $o = bless {};
162    my %hash = (a => 1, b => 2);
163   
164    # from Scalar::Util
165    blessed $o;
166   
167    # from Hash::Util
168    lock_keys %hash;
169
170If you want to import functions with prefix(ex. list_, scalar_, hash_)
171
172    use Util::Any qw/all/, {prefix => 1};
173    use Util::Any qw/list/, {prefix => 1};
174    use Util::Any {List => qw/uniq/}, {prefix => 1};
175   
176    print list_uniq qw/1, 0, 1, 2, 3, 3/;
177
178=head1 DESCRIPTION
179
180For the people like the man who cannot remember C<uniq> function is in whether List::Util or List::MoreUtils.
181And for the newbie who don't know where useful utilities is.
182
183Perl has many modules and they have many utility functions.
184For example, List::Util, List::MoreUtils, Scalar::Util, Hash::Util,
185String::Util, String::CamelCase, Data::Dumper etc.
186
187We, Perl users, have to memorize modules name and their functions name.
188Using this module, you don't need to memorize modules name,
189only memorize kinds of modules and functions name.
190
191And this module allows you to create your own utility module, easily.
192You can create your own module and use this in the same way as Util::Any like the following.
193
194 use YourUtil qw/list/;
195
196see C<CREATE YOUR OWN Util::Any>, in detail.
197
198=head1 HOW TO USE
199
200=head2 use Util::Any (KIND)
201
202 use Util::Any qw/list hash/;
203
204Give list of kinds of modules. All functions in moduls are exporeted.
205
206=head2  use Util::Any {KIND => [FUNCTIONS], ...};
207
208 use Util::Any {list => ['uniq'], hash => ['lock_keys']};
209
210Give hash ref whose key is kind and value is function names.
211Selected functions are exported.
212
213=head2  use Util::Any ..., {OPTION => VALUE};
214
215Util::Any can take last argument as option, which should be hash ref.
216
217=over 4
218
219=item prefix => 1
220
221add kind prefix to function name.
222
223 use Util::Any qw/list/, {prefix => 1};
224 
225 list_uniq(1,2,3,4,5); # it is List::More::Utils's uniq function
226
227=item module_prefix => 1
228
229see L<PREFIX FOR EACH MODULE>.
230Uti::Any itself doesn't have such a definition.
231
232=item debug => 1/2
233
234Util::Any doesn't say anything when loading module fails.
235If you pass debug value, warn or die.
236
237 use Util::Any qw/list/, {debug => 1}; # warn
238 use Util::Any qw/list/, {debug => 2}; # die
239
240=back
241
242=head1 EXPORT
243
244Kinds of functions and list of exported functions are below.
245Note that these modules and version are on my environment(Perl 5.8.4).
246So, it must be diffrent on your environment.
247
248=head2 scalar
249
250from Scalar::Util (1.19)
251
252 blessed
253 dualvar
254 isvstring
255 isweak
256 looks_like_number
257 openhandle
258 readonly
259 refaddr
260 reftype
261 set_prototype
262 tainted
263 weaken
264
265=head2 hash
266
267from Hash::Util (0.05)
268
269 hash_seed
270 lock_hash
271 lock_keys
272 lock_value
273 unlock_hash
274 unlock_keys
275 unlock_value
276
277=head2 list
278
279from List::Util (1.19)
280
281 first
282 max
283 maxstr
284 min
285 minstr
286 reduce
287 shuffle
288 sum
289
290from List::MoreUtils (0.21)
291
292 after
293 after_incl
294 all
295 any
296 apply
297 before
298 before_incl
299 each_array
300 each_arrayref
301 false
302 first_index
303 first_value
304 firstidx
305 firstval
306 indexes
307 insert_after
308 insert_after_string
309 last_index
310 last_value
311 lastidx
312 lastval
313 mesh
314 minmax
315 natatime
316 none
317 notall
318 pairwise
319 part
320 true
321 uniq
322 zip
323
324=head2 string
325
326from String::Util (0.11)
327
328 crunch
329 define
330 equndef
331 fullchomp
332 hascontent
333 htmlesc
334 neundef
335 nospace
336 randcrypt
337 randword
338 trim
339 unquote
340
341from String::CamelCase (0.01)
342
343 camelize
344 decamelize
345 wordsplit
346
347=head2 debug
348
349from Data::Dumper (2.121)
350
351 Dumper
352
353=head1 CREATE YOUR OWN Util::Any
354
355Just inherit Util::Any and define $Utils hash ref as the following.
356
357 package Util::Yours;
358 
359 use Clone qw/clone/;
360 use Util::Any -Base; # or use base qw/Util::Any/;
361 our $Utils = clone $Util::Any::Utils;
362 push @{$Utils->{list}}, qw/Your::Favorite::List::Utils/;
363 
364 1;
365
366In your code;
367
368 use Util::Yours qw/list/;
369
370=head1 USE Perl6::Export::Attrs in YOUR OWN UTIL MODULE
371
372Perl6::Export::Attrs overrides caller package's import method.
373So, when your module use Perl6::Export::Attrs, Util::Any cannot work.
374
375Util::Any provides option to solve this prolblem.
376Write the follwoing instead of "use Util::Any -Base" or "use base qw/Util::Any/".
377
378 use Util::Any -Perl6ExportAttrs;
379
380example;
381
382 package Util::Yours;
383 
384 use Clone qw/clone/;
385 use Util::Any -Perl6ExportAttrs;
386 our $Utils = clone $Util::Any::Utils;
387 push @{$Utils->{list}}, qw/Your::Favorite::List::Utils/;
388 
389 sub foo :Export(:DEFAULT) {
390   return "foo!";
391 }
392 
393 sub bar :Export(:bar) {
394   return "bar!";
395 }
396 
397 1;
398
399Or you can write your own import method and BEGIN block like the follwoing.
400
401 package UtilPerl6ExportAttr;
402 
403 use strict;
404 use base qw/Util::Any/;
405 use Clone qw/clone/;
406 
407 BEGIN {
408   use Perl6::Export::Attrs ();
409   no strict 'refs';
410   *{__PACKAGE__ . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
411 }
412 
413 our $Utils = clone $Util::Any::Utils;
414 $Utils->{your_list} = [
415                  ['List::Util', '', [qw(first min sum)]],
416                 ];
417 
418 sub import {
419   my $pkg = shift;
420   my $caller = (caller)[0];
421 
422   no strict 'refs';
423   eval "package $caller; $pkg" . '->Util::Any::import(@_);';
424   my @arg = grep !exists $Utils->{$_}, @_;
425   if (@_ and @arg) {
426     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
427   } elsif (!@_) {
428     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import';
429   }
430   return;
431 }
432 
433 sub foo :Export(:DEFAULT) {
434   return "foo!";
435 }
436 
437 1;
438
439=head2 $Utils STRUCTURE
440
441=head3 overview
442
443 $Utils => {
444    # simply put module names
445    kind1 => [qw/Module1 Module2 ..../],
446    # Module name and its prefix
447    kind2 => [ [Module1 => 'module_prefix'], ... ],
448    # limit functions to be exported
449    kind3 => [ [Module1, 'module_prefix', [qw/func1 func2/] ], ... ],
450    # as same as above except not specify modul prefix
451    kind4 => [ [Module1, '', [qw/func1 func2/] ], ... ],
452 };
453
454=head3 Key must be lower character.
455
456 NG $Utils = { LIST => [qw/List::Util/]};
457 OK $Utils = { list => [qw/List::Util/]};
458
459=head3 C<all> cannot be used for key.
460
461 NG $Utils = { all => [qw/List::Util/]};
462
463=head3 Value is array ref which contained scalar or array ref.
464
465Scalar is module name. Array ref is module name and its prefix.
466
467 $Utils = { list => ['List::Utils'] };
468 $Utils = { list => [['List::Utils', 'prefix_']] };
469
470see L<PREFIX FOR EACH MODULE>
471
472=head1 PREFIX FOR EACH MODULE
473
474If you want to import many modules and they have same function name.
475You can specify prefix for each module like the following.
476
477 use base qw/Util::Any/;
478 
479 our $Utils = {
480      list => [['List::Util' => 'lu_'], ['List::MoreUtils' => 'lmu_']]
481 };
482
483In your code;
484
485 use Util::Yours qw/list/, {module_prefix => 1};
486
487=head1 OTHER WAY TO EXPORT FUNCTIONS
488
489=head1 SELECT FUNCTIONS
490
491Util::Any auomaticaly export functions from modules' @EXPORT and @EXPORT_OK.
492In some cases, it is not good idea like Data::Dumper's Dumper and DumperX.
493
494So you can limit functions to be exported.
495
496 our $Utils = {
497      debug => [
498                ['Data::Dumper', '',
499                ['Dumper']], # only Dumper method is exported.
500               ],
501 };
502
503or
504
505 our $Utils = {
506      debug => [
507                ['Data::Dumper', '',
508                 { -select => ['Dumper'] }, # only Dumper method is exported.
509                ]
510               ],
511 };
512
513
514=head1 SELECT FUNCTIONS EXCEPT
515
516Inverse of -select option. Cannot use this option with -select.
517
518 our $Utils = {
519      debug => [
520                ['Data::Dumper', '',
521                 { -except => ['DumperX'] }, # export functions except DumperX
522                ]
523               ],
524 };
525
526=head1 RENAME FUNCTIONS
527
528To rename function name. Using this option with -select or -exception,
529this definition is prior to them.
530
531In the following example, 'min' is not in -select list, but can be exported.
532
533 our $Utils = {
534      list  => [
535                 [
536                  'List::Util', '',
537                  {
538                   'first' => 'list_first', # first as list_first
539                   'sum'   => 'lsum',       # sum   as lsum
540                   'min'   => 'lmin',       # min   as lmin
541                   -select => ['first', 'sum', 'shuffle'],
542                  }
543                 ]
544                ],
545  };
546
547=head1 AUTHOR
548
549Ktat, C<< <ktat at cpan.org> >>
550
551=head1 BUGS
552
553Please report any bugs or feature requests to
554C<bug-util-any at rt.cpan.org>, or through the web interface at
555L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Util-Any>.
556I will be notified, and then you'll automatically be notified of progress on
557your bug as I make changes.
558
559=head1 SUPPORT
560
561You can find documentation for this module with the perldoc command.
562
563    perldoc Util::Any
564
565You can also look for information at:
566
567=over 4
568
569=item * AnnoCPAN: Annotated CPAN documentation
570
571L<http://annocpan.org/dist/Util-Any>
572
573=item * CPAN Ratings
574
575L<http://cpanratings.perl.org/d/Util-Any>
576
577=item * RT: CPAN's request tracker
578
579L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Util-Any>
580
581=item * Search CPAN
582
583L<http://search.cpan.org/dist/Util-Any>
584
585=back
586
587=head1 REPOSITORY
588
589  svn co http://svn.coderepos.org/share/lang/perl/Util-Any/trunk Util-Any
590
591Subversion repository of Util::Any is hosted at http://coderepos.org/share/.
592patches and collaborators are welcome.
593
594=head1 ACKNOWLEDGEMENTS
595
596=head1 COPYRIGHT & LICENSE
597
598Copyright 2008 Ktat, all rights reserved.
599
600This program is free software; you can redistribute it and/or modify it
601under the same terms as Perl itself.
602
603=cut
604
6051; # End of Util-Any
Note: See TracBrowser for help on using the browser.