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

Revision 35365, 22.8 kB (checked in by ktat, 4 years ago)

add test file; fix typo.

Line 
1package Util::Any;
2
3use ExportTo ();
4use Clone ();
5use Carp ();
6use warnings;
7use List::MoreUtils qw/uniq any/;
8use strict;
9
10our $Utils = {
11              list   => [ qw/List::Util List::MoreUtils/ ],
12              scalar => [ qw/Scalar::Util/ ],
13              hash   => [ qw/Hash::Util/ ],
14              debug  => [ ['Data::Dumper', '', ['Dumper']] ],
15              string => [ qw/String::Util String::CamelCase/ ],
16             };
17# I'll delete no dash group in the above, in future.
18$Utils->{'-' . $_} = $Utils->{$_} foreach keys %$Utils;
19
20our $SubExporterImport = 'do_import';
21
22sub import {
23  my ($pkg, $caller) = (shift, (caller)[0]);
24  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-[A-Z]\w+$/;
25
26  my %opt = (prefix => 0, module_prefix => 0, debug => 0, smart_rename => 0);
27  if (@_ > 1 and ref $_[-1] eq 'HASH') {
28    @opt{qw/prefix module_prefix debug smart_rename/} = (delete @{$_[-1]}{qw/prefix module_prefix debug smart_rename/});
29    pop @_ unless %{$_[-1]};
30  }
31
32  my $config = Clone::clone(do { no strict 'refs'; ${$pkg . '::Utils'} });
33  my ($arg, $want) = $pkg->_arrange_args(\@_, $config, $caller);
34  foreach my $kind (keys %$want) {
35    my ($prefix, $module_prefix, $options) = ('', '', []);
36    Carp::croak "$pkg doesn't have such kind of functions : $kind" unless exists $config->{$kind};
37    my ($funcs, $local_definition, $kind_prefix) = $pkg->_func_definitions($kind, $want->{$kind});
38
39    foreach my $class (@{$config->{$kind}}) { # $class is class name or array ref
40      my @funcs = @{$funcs->{$kind} || []};
41      ($class, $module_prefix, $options) = @$class if ref $class;
42      my $k = lc(join "", $kind =~m{(\w+)}g);
43      $prefix = $kind_prefix                             ? $kind_prefix   :
44                ($opt{module_prefix} and $module_prefix) ? $module_prefix :
45                 $opt{prefix}                            ? lc($k) . '_'   :
46                 $opt{smart_rename}                      ? $pkg->_create_smart_rename($k) : '';
47
48      my $evalerror = '';
49      if ($evalerror = do { local $@; eval "require $class"; $evalerror = $@ }) {
50        $opt{debug} == 2 ? Carp::croak $evalerror : Carp::carp $evalerror;
51      }
52      my %rename;
53      if (ref $options eq 'HASH') {
54        push @funcs, @{$options->{-select}} if exists $options->{-select};
55        if (exists $options->{-except}) {
56          Carp::croak "cannot use -select & -except in same time." if exists $options->{select};
57          my %except;
58          @except{@{$options->{-except}}} = ();
59          push @funcs, grep !exists $except{$_}, @{_all_funcs_in_class($class)};
60        } elsif (! @funcs) {
61          @funcs =  @{_all_funcs_in_class($class)};
62        }
63        foreach my $o (grep !/^-/, keys %$options) {
64          if (ref $options->{$o} eq 'CODE') {
65            my $gen = $options->{$o};
66            foreach my $def (@{$local_definition->{$o}}) {
67              my %arg;
68              $arg{$_} = $def->{$_}  for grep !/^-/, keys %$def;
69              ExportTo::export_to($caller => {delete $def->{-as} => $gen->($pkg, $class, $o, \%arg)});
70            }
71
72          } elsif (defined &{$class . '::' . $o}) {
73            push @funcs , $o;
74            $rename{$o} = $options->{$o};
75          }
76        }
77      } elsif(ref $options eq 'ARRAY') {
78        push @funcs, @$options;
79      }
80      $pkg->_do_export($caller, $class, \@funcs, $local_definition, \%rename, $prefix);
81    }
82  }
83}
84
85sub _create_smart_rename {
86  my ($pkg, $k) = @_;
87  return sub {
88    my $str = shift;
89    my $prefix = '';
90    if ($str =~s{^(is_|has_|enable_|disable_|isnt_|have_|set_)}{}) {
91      $prefix = $1;
92    }
93    if ($str !~ m{^$k} and $str !~ m{$k$}) {
94      return $prefix . $k . '_' . $str;
95    } else {
96      return $prefix . $str;
97    }
98  };
99}
100
101sub _all_funcs_in_class {
102  my ($class) = @_;
103  my %f;
104  no strict 'refs';
105  @f{@{$class . '::EXPORT_OK'}, @{$class . '::EXPORT'}} = ();
106  return [grep defined &{$class . '::' . $_}, keys %f];
107}
108
109sub _do_export {
110  my ($pkg, $caller, $class, $funcs, $local_definition, $rename, $prefix) = @_;
111  my @export_funcs = @$funcs ? @$funcs : @{_all_funcs_in_class($class)};
112  if (%$local_definition) {
113    foreach my $func (keys %$local_definition) {
114      foreach my $def (@{$local_definition->{$func}}) {
115        my $local_rename = delete $def->{-as} || '';
116        unless (%$def) {
117          ExportTo::export_to
118              ($caller =>
119               {
120                ($local_rename ? $local_rename : $prefix ? (ref $prefix eq 'CODE' ? $prefix->($func) : $prefix . $func) : $func)
121                              => $class . '::' . $func
122               });
123        }
124      }
125    }
126    @export_funcs = grep !exists $local_definition->{$_}, @export_funcs;
127  }
128  ExportTo::export_to($caller => ($prefix or %$rename)
129                      ? {map {(ref $prefix ne 'CODE' ? $prefix . ($rename->{$_} || $_) : $prefix->($_)) => $class . '::' . $_} @export_funcs}
130                      : [map $class . '::' . $_, uniq @export_funcs]);
131}
132
133sub _insert_want_arg {
134  my ($config, $kind, $setting, $want, $arg) = @_;
135  $kind = lc $kind;
136  exists $config->{$kind} ?
137    $want->{$kind} = $setting:
138    push @$arg, $kind, defined $setting ? $setting : ();
139}
140
141sub _arrange_args {
142  my ($pkg, $org_args, $config, $caller) = @_;
143  my (@arg, %want);
144  my $import_module = $pkg->_use_import_module || '';
145  if (@$org_args) {
146    @$org_args = %{$org_args->[0]} if ref $org_args->[0] eq 'HASH';
147
148    if (lc($org_args->[0]) eq 'all') {
149      # import all functions which Util::Any proxy
150      @want{keys %$config} = ();
151    } elsif (lc($org_args->[0]) =~ /^[:-]all$/) {
152      # import ALL functions
153      @want{keys %$config} = ();
154      if ($import_module) {
155        if ($import_module eq 'Expoter'          or
156            $import_module eq 'Exporter::Simple'
157           ) {
158          no strict 'refs';
159          no warnings;
160          push @arg, ':all' if ${$pkg . '::EXPORT_TAGS'}{":all"};
161        } elsif ($import_module eq 'Sub::Exporter') {
162          push @arg, '-all';
163        } elsif ($import_module eq 'Perl6::Exporter::Attrs') {
164          push @arg, ':ALL';
165        }
166      }
167    } elsif (any {ref $_} @$org_args) {
168      for (my $i = 0; $i < @$org_args; $i++) {
169        my $f = $org_args->[$i];
170        my $setting = $org_args->[$i + 1] ? $org_args->[++$i] : undef;
171        _insert_want_arg($config, $f, $setting, \%want, \@arg);
172      }
173    } else {
174      # export specified kinds
175      foreach my $f (@$org_args) {
176        _insert_want_arg($config, $f, undef, \%want, \@arg);
177      }
178    }
179  }
180  $pkg->_do_base_import($import_module, $caller, \@arg) if (@arg or !@$org_args) and $import_module;
181  return \@arg, \%want;
182}
183
184sub _func_definitions {
185  my ($pkg, $kind, $want_func_definition, $kind_prefix) = @_;
186  my (%funcs, %local_definition);
187  if (ref $want_func_definition eq 'HASH') {
188    # list => {func => {-as => 'rename'}};  list => {-prefix => 'hoge_' }
189    $kind_prefix = $want_func_definition->{-prefix}
190      if exists $want_func_definition->{-prefix};
191    foreach my $f (grep !/^-/, keys %$want_func_definition) {
192      push @{$funcs{$kind} ||= []}, $f;
193      $local_definition{$f} = [$want_func_definition->{$f}];
194    }
195  } elsif (ref $want_func_definition eq 'ARRAY') {
196    foreach (my $i = 0; $i < @$want_func_definition; $i++) {
197      my ($k, $v) = @{$want_func_definition}[$i, $i + 1];
198      if (ref $v) {
199        $i++;
200        if ($k eq '-prefix') {
201          $kind_prefix = $v;
202        } else {
203          push @{$funcs{$kind} ||= []}, $k;
204          push @{$local_definition{$k} ||= []}, $v;
205        }
206      } else {
207        push @{$funcs{$kind} ||= []}, $k;
208      }
209    }
210    @{$funcs{$kind} ||= []} = uniq @{$funcs{$kind} ||= []};
211  }
212  return \%funcs, \%local_definition, $kind_prefix || '';
213}
214
215sub _do_base_import {
216  # working with other modules like Expoter
217  my ($pkg, $import_module, $caller, $arg) = @_;
218  my $pkg_utils;
219  {
220    no strict 'refs';
221    no warnings;
222    $pkg_utils = ${$pkg . '::Utils'};
223  }
224  if ($import_module eq 'Perl6::Export::Attrs') {
225    eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@$arg);';
226  } elsif ($import_module eq 'Exporter::Simple') {
227    eval "package $caller; $pkg" . '->Exporter::Simple::import(@$arg);';
228  } elsif ($import_module eq 'Exporter') {
229    eval "package $caller; $pkg" . '->Exporter::import(@$arg);';
230  } elsif ($import_module eq 'Sub::Exporter') {
231    no strict 'refs';
232    no warnings;
233    my $import_name =  ${"${pkg}::SubExporterImport"} || $Util::Any::SubExporterImport;
234    eval "package $caller; $pkg" . '->$import_name(@$arg);';
235  }
236  die $@ if $@;
237}
238
239sub _base_import {
240  my ($pkg, $caller, @flgs) = @_;
241  {
242    no strict 'refs';
243    push @{"${caller}::ISA"}, __PACKAGE__;
244  }
245  my @unknown;
246
247  while (my $flg = lc shift @flgs) {
248    no strict 'refs';
249    if ($flg eq '-perl6exportattrs') {
250      eval "use Perl6::Export::Attrs ();";
251      *{$caller . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
252      *{$caller . '::_use_import_module'} = sub { 'Perl6::Export::Attrs' };
253    } elsif ($flg eq '-subexporter') {
254      eval "use Sub::Exporter ();";
255      *{$caller . '::_use_import_module'} = sub { 'Sub::Exporter' };
256    } elsif ($flg eq '-exportersimple') {
257      eval "use Exporter::Simple ();";
258      *{$caller . '::_use_import_module'} = sub { 'Exporter::Simple' };
259    } elsif ($flg eq '-exporter') {
260      use Exporter ();
261      push @{"${caller}::ISA"}, 'Exporter';
262      *{$caller . '::_use_import_module'} = sub { 'Exporter' };
263    } elsif ($flg eq '-base') {
264      # nothing to do
265    } else {
266      push @unknown, $flg;
267    }
268  }
269  Carp::croak "cannot understand the option: @unknown" if @unknown;
270}
271
272sub _use_import_module { 0 }
273
274=head1 NAME
275
276Util::Any - to export any utilities and to create your own utilitiy module
277
278=cut
279
280our $VERSION = '0.10';
281
282=head1 SYNOPSIS
283
284    use Util::Any -list;
285    # you can import any functions of List::Util and List::MoreUtils
286   
287    print uniq qw/1, 0, 1, 2, 3, 3/;
288
289If you want to choose functions
290
291    use Util::Any {-list => qw/uniq/};
292    # you can import uniq function, not import other functions
293   
294    print uniq qw/1, 0, 1, 2, 3, 3/;
295
296If you want to import All kind of utility functions
297
298    use Util::Any -all;
299   
300    my $o = bless {};
301    my %hash = (a => 1, b => 2);
302   
303    # from Scalar::Util
304    blessed $o;
305   
306    # from Hash::Util
307    lock_keys %hash;
308
309If you want to import functions with prefix(ex. list_, scalar_, hash_)
310
311    use Util::Any -all, {prefix => 1};
312    use Util::Any -list, {prefix => 1};
313    use Util::Any {-list => ['uniq']}, {prefix => 1};
314   
315    print list_uniq qw/1, 0, 1, 2, 3, 3/;
316
317=head1 DESCRIPTION
318
319For the people like the man who cannot remember C<uniq> function is in whether List::Util or List::MoreUtils.
320And for the newbie who don't know where useful utilities is.
321
322Perl has many modules and they have many utility functions.
323For example, List::Util, List::MoreUtils, Scalar::Util, Hash::Util,
324String::Util, String::CamelCase, Data::Dumper etc.
325
326We, Perl users, have to memorize modules name and their functions name.
327Using this module, you don't need to memorize modules name,
328only memorize kinds of modules and functions name.
329
330And this module allows you to create your own utility module, easily.
331You can create your own module and use this in the same way as Util::Any like the following.
332
333 use YourUtil -list;
334
335see C<CREATE YOUR OWN Util::Any>, in detail.
336
337=head1 HOW TO USE
338
339=head2 use Util::Any (KIND)
340
341 use Util::Any -list, -hash;
342
343Give list of kinds of modules. All functions in moduls are exporeted.
344
345=head2  use Util::Any {KIND => [FUNCTIONS], ...};
346
347 use Util::Any {-list => ['uniq'], -hash => ['lock_keys']};
348
349Give hash ref whose key is kind and value is function names.
350Selected functions are exported.
351
352=head2  use Util::Any ..., {OPTION => VALUE};
353
354Util::Any can take last argument as option, which should be hash ref.
355
356=over 4
357
358=item prefix => 1
359
360add kind prefix to function name.
361
362 use Util::Any -list, {prefix => 1};
363 
364 list_uniq(1,2,3,4,5); # it is List::More::Utils's uniq function
365
366=item module_prefix => 1
367
368see L<PREFIX FOR EACH MODULE>.
369Uti::Any itself doesn't have such a definition.
370
371=item smart_rename => 1
372
373see L<SMART RENAME FOR EACH KIND>.
374
375=item debug => 1/2
376
377Util::Any doesn't say anything when loading module fails.
378If you pass debug value, warn or die.
379
380 use Util::Any -list, {debug => 1}; # warn
381 use Util::Any -list, {debug => 2}; # die
382
383=back
384
385=head1 EXPORT
386
387Kinds of functions and list of exported functions are below.
388Note that these modules and version are on my environment(Perl 5.8.4).
389So, it must be diffrent on your environment.
390
391=head2 scalar
392
393from Scalar::Util (1.19)
394
395 blessed
396 dualvar
397 isvstring
398 isweak
399 looks_like_number
400 openhandle
401 readonly
402 refaddr
403 reftype
404 set_prototype
405 tainted
406 weaken
407
408=head2 hash
409
410from Hash::Util (0.05)
411
412 hash_seed
413 lock_hash
414 lock_keys
415 lock_value
416 unlock_hash
417 unlock_keys
418 unlock_value
419
420=head2 list
421
422from List::Util (1.19)
423
424 first
425 max
426 maxstr
427 min
428 minstr
429 reduce
430 shuffle
431 sum
432
433from List::MoreUtils (0.21)
434
435 after
436 after_incl
437 all
438 any
439 apply
440 before
441 before_incl
442 each_array
443 each_arrayref
444 false
445 first_index
446 first_value
447 firstidx
448 firstval
449 indexes
450 insert_after
451 insert_after_string
452 last_index
453 last_value
454 lastidx
455 lastval
456 mesh
457 minmax
458 natatime
459 none
460 notall
461 pairwise
462 part
463 true
464 uniq
465 zip
466
467=head2 string
468
469from String::Util (0.11)
470
471 crunch
472 define
473 equndef
474 fullchomp
475 hascontent
476 htmlesc
477 neundef
478 nospace
479 randcrypt
480 randword
481 trim
482 unquote
483
484from String::CamelCase (0.01)
485
486 camelize
487 decamelize
488 wordsplit
489
490=head2 debug
491
492from Data::Dumper (2.121)
493
494 Dumper
495
496=head1 CREATE YOUR OWN Util::Any
497
498Just inherit Util::Any and define $Utils hash ref as the following.
499
500 package Util::Yours;
501 
502 use Clone qw/clone/;
503 use Util::Any -Base; # or use base qw/Util::Any/;
504 our $Utils = clone $Util::Any::Utils;
505 push @{$Utils->{-list}}, qw/Your::Favorite::List::Utils/;
506 
507 1;
508
509In your code;
510
511 use Util::Yours -list;
512
513=head2 $Utils STRUCTURE
514
515=head3 overview
516
517 $Utils => {
518    # simply put module names
519    -kind1 => [qw/Module1 Module2 ..../],
520    -# Module name and its prefix
521    -kind2 => [ [Module1 => 'module_prefix'], ... ],
522    # limit functions to be exported
523    -kind3 => [ [Module1, 'module_prefix', [qw/func1 func2/] ], ... ],
524    # as same as above except not specify modul prefix
525    -kind4 => [ [Module1, '', [qw/func1 func2/] ], ... ],
526 };
527
528=head3 Key must be lower character.
529
530 NG $Utils = { LIST => [qw/List::Util/]};
531 OK $Utils = { list => [qw/List::Util/]};
532 OK $Utils = { -list => [qw/List::Util/]};
533 OK $Utils = { ':list' => [qw/List::Util/]};
534
535=head3 C<all> cannot be used for key.
536
537 NG $Utils = { all    => [qw/List::Util/]};
538 NG $Utils = { -all   => [qw/List::Util/]};
539 NG $Utils = { ':all' => [qw/List::Util/]};
540
541=head3 Value is array ref which contained scalar or array ref.
542
543Scalar is module name. Array ref is module name and its prefix.
544
545 $Utils = { list => ['List::Utils'] };
546 $Utils = { list => [['List::Utils', 'prefix_']] };
547
548see L<PREFIX FOR EACH MODULE>
549
550=head2 PREFIX FOR EACH MODULE
551
552If you want to import many modules and they have same function name.
553You can specify prefix for each module like the following.
554
555 use base qw/Util::Any/;
556 
557 our $Utils = {
558      list => [['List::Util' => 'lu_'], ['List::MoreUtils' => 'lmu_']]
559 };
560
561In your code;
562
563 use Util::Yours qw/list/, {module_prefix => 1};
564
565=head2 SMART RENAME FOR EACH KIND
566
567smart_rename option renmae function name by a little smart way.
568For example,
569
570 our $Utils = {
571   utf8 => [['utf8', '',
572             {
573              is_utf8   => 'is_utf8',
574              upgrade   => 'utf8_upgrade',
575              downgrade => 'downgrade',
576             }
577            ]],
578 };
579
580In this definition, use C<prefix => 1> is not good idea. If you use it:
581
582 is_utf8      => utf8_is_utf8
583 utf8_upgrade => utf8_utf8_upgrade
584 downgrade    => utf8_downgrade
585
586That's too bad. If you use C<smart_rename => 1> instead:
587
588 is_utf8      => is_utf8
589 utf8_upgrade => utf8_upgrade
590 downgrade    => utf8_downgrade
591
592rename rule is represented in _create_smart_rename in Util::Any.
593
594=head2 OTHER WAY TO EXPORT FUNCTIONS
595
596=head2 SELECT FUNCTIONS
597
598Util::Any auomaticaly export functions from modules' @EXPORT and @EXPORT_OK.
599In some cases, it is not good idea like Data::Dumper's Dumper and DumperX.
600Thease 2 functions are same feature.
601
602So you can limit functions to be exported.
603
604 our $Utils = {
605      -debug => [
606                ['Data::Dumper', '',
607                ['Dumper']], # only Dumper method is exported.
608               ],
609 };
610
611or
612
613 our $Utils = {
614      -debug => [
615                ['Data::Dumper', '',
616                 { -select => ['Dumper'] }, # only Dumper method is exported.
617                ]
618               ],
619 };
620
621
622=head2 SELECT FUNCTIONS EXCEPT
623
624Inverse of -select option. Cannot use this option with -select.
625
626 our $Utils = {
627      -debug => [
628                ['Data::Dumper', '',
629                 { -except => ['DumperX'] }, # export functions except DumperX
630                ]
631               ],
632 };
633
634=head2 RENAME FUNCTIONS
635
636To rename function name, use this option with -select or -exception,
637this definition is prior to them.
638
639In the following example, 'min' is not in -select list, but can be exported.
640
641 our $Utils = {
642      -list  => [
643                 [
644                  'List::Util', '',
645                  {
646                   'first' => 'list_first', # first as list_first
647                   'sum'   => 'lsum',       # sum   as lsum
648                   'min'   => 'lmin',       # min   as lmin
649                   -select => ['first', 'sum', 'shuffle'],
650                  }
651                 ]
652                ],
653  };
654
655=head2 EXPORTING LIKE Sub::Exporter
656
657This featrue is not enough tested. and only support '-prefix' and '-as'.
658
659 use UtilSubExporter -list => {-prefix => 'list__', min => {-as => "list___min"}},
660                     # The following is normal Sub::Exporter importing
661                     greet => {-prefix => "greet_"},
662                     'askme' => {-as => "ask_me"};
663
664Check t/lib/UtilSubExporter.pm, t/10-sub-exporter-like-epxort.t and  t/12-sub-exporter-like-export.t
665
666=head3 Sub::Exporter's generator way
667
668It's experimental feature, not enough tested.
669
670=head1 WORKING WITH EXPORTER-LIKE MODULES
671
672CPAN has some modules to export functions.
673Util::Any can work with some of such modules, L<Exporter>, L<Exporter::Simple>, L<Sub::Exporter> and L<Perl6::Export::Attrs>.
674If you want to use other modules, please inform me or implement import method by yourself.
675
676If you want to use module mentioned above, you have to change the way to inherit these modules.
677
678=head2 DIFFERENCE between 'all' and '-all' or ':all'
679
680If your utility module which inherited Util::Any has utility functions and export them by Exporter-like module,
681behavior of 'all' and '-all' or ':all' is a bit different.
682
683 'all' ... export all utilities defined in your package's $Utils variables.
684 '-all' or ':all' ... export all utilities including functions in your util module itself.
685
686=head2 ALTERNATIVE INHERITING
687
688Normaly, you use;
689
690 package YourUtils;
691 
692 use Util::Any -Base; # or "use base qw/Util::Any/;"
693
694But, if you want to use L<Exporter>, L<Exporter::Simple> or L<Perl6::Export::Attrs>.
695write as the following, instead.
696
697 # if you want to use Exporter
698 use Util::Any -Exporter;
699 # if you want to use Exporter::Simple
700 use Util::Any -ExporterSimple;
701 # if you want to use Sub::Exporter
702 use Util::Any -SubExporter;
703 # if you want to use Perl6::Export::Attrs
704 use Util::Any -Perl6ExportAttrs;
705
706That's all.
707Note that B<don't use base the above modules in your utility module>.
708
709There is one notice to use Sub::Exporter.
710
711 Sub::Exporter::setup_exporter
712       ({
713           as => 'do_import', # name is important
714           exports => [...],
715           groups  => { ... },
716       });
717
718You must pass "as" option to setup_exporter and its value must be "do_import".
719If you want to change this name, do the following.
720
721 Sub::Exporter::setup_exporter
722       ({
723           as => $YourUtils::SubExporterImport = '__do_import',
724           exports => [...],
725           groups  => { ... },
726       });
727
728=head3 EXAMPLE to USE Perl6::Export::Attrs in YOUR OWN UTIL MODULE
729
730Perl6::Export::Attributes is not recommended in the following URL
731(http://www.perlfoundation.org/perl5/index.cgi?pbp_module_recommendation_commentary).
732So, you'd beter use other exporter module. It is left as an example.
733
734 package Util::Yours;
735 
736 use Clone qw/clone/;
737 use Util::Any -Perl6ExportAttrs;
738 our $Utils = clone $Util::Any::Utils;
739 push @{$Utils->{list}}, qw/Your::Favorite::List::Utils/;
740 
741 sub foo :Export(:DEFAULT) {
742   return "foo!";
743 }
744 
745 sub bar :Export(:bar) {
746   return "bar!";
747 }
748 
749 1;
750
751=head2 IMPLEMENT IMPORT by YOURSELF
752
753Perl6::Export::Attributes is not recommended in the following URL
754(http://www.perlfoundation.org/perl5/index.cgi?pbp_module_recommendation_commentary).
755So, you'd beter use other exporter module. It is left as an example.
756
757You can write your own import method and BEGIN block like the following.
758Instead of using "use Util::Any -Perl6ExportAttrs".
759
760 package UtilPerl6ExportAttr;
761 
762 use strict;
763 use base qw/Util::Any/;
764 use Clone qw/clone/;
765 
766 BEGIN {
767   use Perl6::Export::Attrs ();
768   no strict 'refs';
769   *{__PACKAGE__ . '::MODIFY_CODE_ATTRIBUTES'} = \&Perl6::Export::Attrs::_generic_MCA;
770 }
771 
772 our $Utils = clone $Util::Any::Utils;
773 $Utils->{your_list} = [
774                  ['List::Util', '', [qw(first min sum)]],
775                 ];
776 
777 sub import {
778   my $pkg = shift;
779   my $caller = (caller)[0];
780 
781   no strict 'refs';
782   eval "package $caller; $pkg" . '->Util::Any::import(@_);';
783   my @arg = grep !exists $Utils->{$_}, @_;
784   if ((@_ and @arg) or !@_) {
785     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
786   }
787   return;
788 }
789 
790 sub foo :Export(:DEFAULT) {
791   return "foo!";
792 }
793 
794 1;
795
796=head1 AUTHOR
797
798Ktat, C<< <ktat at cpan.org> >>
799
800=head1 BUGS
801
802Please report any bugs or feature requests to
803C<bug-util-any at rt.cpan.org>, or through the web interface at
804L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Util-Any>.
805I will be notified, and then you'll automatically be notified of progress on
806your bug as I make changes.
807
808=head1 SUPPORT
809
810You can find documentation for this module with the perldoc command.
811
812    perldoc Util::Any
813
814You can also look for information at:
815
816=over 4
817
818=item * AnnoCPAN: Annotated CPAN documentation
819
820L<http://annocpan.org/dist/Util-Any>
821
822=item * CPAN Ratings
823
824L<http://cpanratings.perl.org/d/Util-Any>
825
826=item * RT: CPAN's request tracker
827
828L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Util-Any>
829
830=item * Search CPAN
831
832L<http://search.cpan.org/dist/Util-Any>
833
834=back
835
836=head1 REPOSITORY
837
838  svn co http://svn.coderepos.org/share/lang/perl/Util-Any/trunk Util-Any
839
840Subversion repository of Util::Any is hosted at http://coderepos.org/share/.
841patches and collaborators are welcome.
842
843=head1 SEE ALSO
844
845The following modules can work with Util::Any.
846
847L<Exporter>, L<Exporter::Simple>, L<Sub::Exporter> and L<Perl6::Export::Attrs>.
848
849Now I try to make L<Util::All> module based on Util::Any. see the following URL.
850
851 http://github.com/ktat/Util-All
852
853=head1 ACKNOWLEDGEMENTS
854
855=head1 COPYRIGHT & LICENSE
856
857Copyright 2008-2009 Ktat, all rights reserved.
858
859This program is free software; you can redistribute it and/or modify it
860under the same terms as Perl itself.
861
862=cut
863
8641; # End of Util-Any
Note: See TracBrowser for help on using the browser.