Changeset 35510

Timestamp:

10/06/09 03:39:33 (4 years ago)

Author:

ktat

Message:

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

=== Changes
==================================================================
--- Changes (revision 39944)
+++ Changes (local)
@@ -1,5 +1,13 @@

Revision history for Util-Any

+0.17 2009/10/06 03:32
+ add -args option to give common arguments to all functions in same kind.
+ enable to work -all with kind setting. for example
+ -all, -list => {...}
+ fix typo: inherit Perl6::Exprot::Attr and ':ALL' keyword didn't work correctly.
+ fix typo: inherit Exproer and ':all' keyword didn't work correctly.
+ Thanks to Richard Jelinek, again.
+

0.16 2009/09/30 03:16

fix bug: using SubExportor?'s generator way and select functions with rename function,

didn't working correctly

@@ -58,7 +66,7 @@

0.07 2009/04/12 03:58

Fix bug when inheriting

- Thanks to Rechard Jelinek
+ Thanks to Richard Jelinek

0.06 2009/03/22 14:55

support Exporter and Exporter::Simple

Location:

lang/perl/Util-Any/trunk

Files:

• Changes (modified) (2 diffs)
• MANIFEST (modified) (4 diffs)
• lib/Util/Any.pm (modified) (12 diffs)
• t/01-synopsis.t (modified) (1 diff)
• t/03-priority.t (added)
• t/05-smart-rename.t (modified) (2 diffs)
• t/06-perl6-export-attrs-all.t (added)
• t/08-exporter-simple-all.t (added)
• t/09-exporter-all.t (added)
• t/10-sub-exporter-all.t (added)
• t/11-sub-exporter-all.t (modified) (2 diffs)
• t/12-sub-exporter-like-export-with-args.t (added)
• t/lib/SubExporterGenerator.pm (modified) (2 diffs)
• t/lib/UtilExporter.pm (modified) (1 diff)
• t/lib/UtilPerl6ExportAttrs.pm (modified) (1 diff)

lang/perl/Util-Any/trunk/Changes

@@ -1 +1 @@
 Revision history for Util-Any
+
+0.17    2009/10/06 03:32
+        add -args option to give common arguments to all functions in same kind.
+        enable to work -all with kind setting. for example
+               -all, -list => {...}
+        fix typo: inherit Perl6::Exprot::Attr and ':ALL' keyword didn't work correctly.
+        fix typo: inherit Exproer and ':all' keyword didn't work correctly.
+        Thanks to  Richard Jelinek, again.
 
 0.16    2009/09/30 03:16
@@ -59 +67 @@
 0.07    2009/04/12 03:58
         Fix bug when inheriting
-        Thanks to Rechard Jelinek
+        Thanks to  Richard Jelinek
 
 0.06    2009/03/22 14:55

lang/perl/Util-Any/trunk/MANIFEST

@@ -29 +29 @@
 t/01-util-kind-all-prefix.t
 t/03-debug.t
-t/03-debug.t
+t/03-priority.t
 t/04-option.t
 t/04-option-select.t
@@ -39 +39 @@
 t/06-perl6-export-attrs2.t
 t/06-perl6-export-attrs-no-args.t
+t/06-perl6-export-attrs-all.t
 t/07-perl6-export-attrs.t
 t/07-perl6-export-attrs2.t
@@ -45 +46 @@
 t/08-exporter-simple2.t
 t/08-exporter-simple-no-args.t
+t/08-exporter-simple-all.t
 t/09-exporter.t
 t/09-exporter2.t
+t/09-exporter-all.t
 t/09-exporter-no-args.t
+t/10-sub-exporter-all.t
 t/10-sub-exporter.t
 t/10-sub-exporter2.t
@@ -57 +61 @@
 t/11-sub-exporter-full-all.t
 t/12-sub-exporter-like-export.t
+t/12-sub-exporter-like-export-with-args.t
 t/13-inherit.t
 t/14-pluggable.t

lang/perl/Util-Any/trunk/lib/Util/Any.pm

@@ -57 +57 @@
     # Carp::croak "$pkg doesn't have such kind of functions : $kind"
     # unless exists $config->{$kind};
-    $pkg->_kind_exporter($caller, $config->{$kind}, $kind, $want_kind->{$kind}, \%opt);
+    $pkg->_kind_exporter($caller, $config->{$kind}, (lc(join "", $kind =~m{(\w+)}go)), $want_kind->{$kind}, \%opt);
   }
 }
 
 sub _kind_exporter {
-  my ($pkg, $caller, $config, $kind, $import_setting, $opt) = @_;
-  my ($funcs, $local_definition, $kind_prefix) = $pkg->_func_definitions($import_setting);
-  my ($kind_word, $prefix, %want_funcs, %exported, %class_func) = (lc(join "", $kind =~m{(\w+)}go), '');
-  @want_funcs{@$funcs} = ();
-
-  foreach my $class_config (@$config) { # $class_config is class name or array ref
+  my ($pkg, $caller, $kind_config, $kind_word, $import_setting, $opt) = @_;
+  my ($wanted_funcs, $local_definition, $kind_prefix, $kind_args) = $pkg->_func_definitions($import_setting);
+  my ($prefix, %exported, %class_func);
+
+  foreach my $class_config (@$kind_config) { # $class_config is class name or array ref
     my ($class, $module_prefix, $config_options) = ref $class_config ? @$class_config : ($class_config, '', '');
 
@@ -97 +96 @@
         @funcs = @{_all_funcs_in_class($class)};
       }
-      foreach my $function (%want_funcs ? (grep {defined $config_options->{$_}} keys %want_funcs) : grep !/^-/, keys %$config_options) {
+      foreach my $function (@$wanted_funcs ? (grep {defined $config_options->{$_}} @$wanted_funcs) : grep !/^-/, keys %$config_options) {
         if (ref(my $gen = $config_options->{$function}) eq 'CODE') {
           # Like Sub::Exporter generator
@@ -105 +104 @@
               $arg{$_} = $def->{$_}  for grep !/^-/, keys %$def;
               ExportTo::export_to($caller => {($def->{-as} || $function)
-                                              => $gen->($pkg, $class, $function, \%arg)});
-
-
+                                              => $gen->($pkg, $class, $function, \%arg, $kind_args)});
             }
           } else {
-            ExportTo::export_to($caller => {$prefix . $function => $gen->($pkg, $class, $function, {})});
+            ExportTo::export_to($caller => {$prefix . $function => $gen->($pkg, $class, $function, {}, $kind_args)});
           }
           $exported{$function} = undef;
@@ -123 +120 @@
     $class_func{$class} = [\@funcs, \%rename];
   }
+  my %want_funcs;
+  @want_funcs{@$wanted_funcs} = ();
   foreach my $class (keys %class_func) {
-    $pkg->_do_export($caller, $class, $class_func{$class}->[0], \%want_funcs, \%exported,
-                     $local_definition, $class_func{$class}->[1], $prefix, $kind_prefix);
+    _do_export($caller, $class, $class_func{$class}->[0], \%want_funcs, \%exported,
+               $local_definition, $class_func{$class}->[1], $prefix, $kind_prefix);
   }
 }
 
 sub _do_export {
-  my ($pkg, $caller, $class, $funcs, $want_funcs, $exported, $local_definition, $rename, $prefix, $kind_prefix) = @_;
-
+  my ($caller, $class, $funcs, $want_funcs, $exported, $local_definition, $rename, $prefix, $kind_prefix) = @_;
   my %reverse_rename = reverse %$rename;
   if (%$local_definition) {
@@ -207 +205 @@
   my (@arg, %want_kind);
   my $import_module = $pkg->_use_import_module;
+  my $all_improt = 0;
   if (@$org_args) {
     @$org_args = %{$org_args->[0]} if ref $org_args->[0] eq 'HASH';
     if (lc($org_args->[0]) =~ /^([:-])?all/) {
+      my $all_import = shift @$org_args;
       my $inherit_all = $1;
       $pkg->_lazy_load_plugins_all($config) if $opt->{'plugin'} eq 'lazy' and $pkg->can('_plugins');
@@ -215 +215 @@
       @want_kind{keys %$config} = ();
       if ($inherit_all and $import_module) {
-        if ($import_module eq 'Expoter' or $import_module eq 'Exporter::Simple') {
+        if ($import_module eq 'Exporter' or $import_module eq 'Exporter::Simple') {
           no strict 'refs'; no warnings;
-          push @arg, ':all' if ${$pkg . '::EXPORT_TAGS'}{":all"};
+          push @arg, ':all' if ${$pkg . '::EXPORT_TAGS'}{"all"};
+
         } elsif ($import_module eq 'Sub::Exporter') {
           push @arg, '-all';
-        } elsif ($import_module eq 'Perl6::Exporter::Attrs') {
+        } elsif ($import_module eq 'Perl6::Export::Attrs') {
           push @arg, ':ALL';
         }
       }
+    } elsif ($opt->{'plugin'} eq 'lazy' and $pkg->can('_plugins')) {
+      $pkg->_lazy_load_plugins($config, $org_args);
+    }
+    if (List::MoreUtils::any {ref $_} @$org_args) {
+      for (my $i = 0; $i < @$org_args; $i++) {
+        my $kind = $org_args->[$i];
+        my $import_setting = $org_args->[$i + 1] ? $org_args->[++$i] : undef;
+        _insert_want_arg($config, $kind, $import_setting, \%want_kind, \@arg);
+      }
     } else {
-      $pkg->_lazy_load_plugins($config, $org_args) if $opt->{'plugin'} eq 'lazy' and $pkg->can('_plugins');
-      if (List::MoreUtils::any {ref $_} @$org_args) {
-        for (my $i = 0; $i < @$org_args; $i++) {
-          my $kind = $org_args->[$i];
-          my $import_setting = $org_args->[$i + 1] ? $org_args->[++$i] : undef;
-          _insert_want_arg($config, $kind, $import_setting, \%want_kind, \@arg);
-        }
-      } else {
-        # export specified kinds
-        foreach my $kind (@$org_args) {
-          _insert_want_arg($config, $kind, undef, \%want_kind, \@arg);
-        }
+      # export specified kinds
+      foreach my $kind (@$org_args) {
+        _insert_want_arg($config, $kind, undef, \%want_kind, \@arg);
       }
     }
@@ -307 +308 @@
 sub _func_definitions {
   my ($pkg, $want_func_definition) = @_;
-  my $kind_prefix;
-  my (@funcs, %funcs, %local_definition);
+  my ($kind_prefix, $kind_args, @wanted_funcs, %funcs, %local_definition);
   if (ref $want_func_definition eq 'HASH') {
     # list => {func => {-as => 'rename'}};  list => {-prefix => 'hoge_' }
     $kind_prefix = $want_func_definition->{-prefix}
       if exists $want_func_definition->{-prefix};
+    $kind_args = $want_func_definition->{-args}
+      if exists $want_func_definition->{-args};
     foreach my $f (grep !/^-/, keys %$want_func_definition) {
       $local_definition{$f} = [$want_func_definition->{$f}];
@@ -319 +321 @@
     foreach (my $i = 0; $i < @$want_func_definition; $i++) {
       my ($k, $v) = @{$want_func_definition}[$i, $i + 1];
-      if (ref $v) {
+      if ($k eq '-prefix') {
+        $kind_prefix = $v;
         $i++;
-        if ($k eq '-prefix') {
-          $kind_prefix = $v;
-        } else {
-          push @funcs, $k;
-          push @{$local_definition{$k} ||= []}, $v;
-        }
+      } elsif ($k eq '-args') {
+        $kind_args = $v;
+        $i++;
+      }elsif (ref $v) {
+        $i++;
+        push @wanted_funcs, $k;
+        push @{$local_definition{$k} ||= []}, $v;
       } else {
-        push @funcs, $k;
+        push @wanted_funcs, $k;
       }
     }
-    @funcs = List::MoreUtils::uniq @funcs;
-  }
-  return \@funcs, \%local_definition, $kind_prefix || '';
+    @wanted_funcs = List::MoreUtils::uniq @wanted_funcs;
+  }
+  return \@wanted_funcs, \%local_definition, $kind_prefix || '', $kind_args || {};
 }
 
@@ -406 +410 @@
 =cut
 
-our $VERSION = '0.16';
+our $VERSION = '0.17';
 
 =head1 SYNOPSIS
@@ -686 +690 @@
 functions in -list, are exported with prefix "list__" except 'min' and 'min' is exported as 'lmin'.
 
+=head1 PRIORITY OF THE WAYS TO CHANGE FUNCTION NAME
+
+There are some ways to chnage function name.
+Their priority is the following.
+
+=over 4
+
+=item 1 rename
+
+ -list => {uniq => {-as => 'luniq'}}
+
+=item 2 kind_prefix
+
+ -list => {-prefix => list}
+
+=item 3 module_prefix
+
+Only if module's prefix is defined
+
+ ..., {module_prefix => 1}
+
+=item 4 prefix
+
+ ..., {prefix => 1}
+
+=item 5 smart_rename
+
+ ..., {smart_rename => 1}
+
+=back
+
+I don't recommend to use 3, 4, 5 in same time, because it may confuse you.
+
+=over 4
+
+=item 3 + 4
+
+if module's prefix is defined in class(not defined in Util::Any), use 3, or use 4.
+
+=item 3 + 5
+
+3 or 5. reason is as same as the above.
+
+=item 3 + 4 + 5
+
+5 is ignored.
+
+=item 4 + 5
+
+5 is ignored.
+
+=back
+
 =head1 NOTE ABOUT all KEYWORD
 
@@ -926 +983 @@
 Util::Any try to export duplicate function C<min>, one of both should fail.
 
+=head4 GIVE DEFAULT ARGUMENTS TO CODE GENERATOR
+
+You may want to give default arguments to all code generators in same kind.
+For example, if you create shortcut to use Number::Format,
+you may want to give common arguments with creating instance.
+
+ -number => [
+    [ 'Number::Format' => {
+        'round' => sub {
+            my($pkg, $class, $func, $args, $default_args) = @_;
+            my $n = 'Number::Format'->new(%$default_args);
+            sub { $n->round(@_); }
+        },
+        'number_format' => sub {
+            my($pkg, $class, $func, $args, $default_args) = @_;
+            my $n = 'Number::Format'->new(%$default_args, %$args);
+            sub { $n->format_number(@_); }
+        }
+      }
+    ];
+
+And write as the following:
+
+ use Util::Yours -number => [-args => {thousands_sep => "_", int_curr_symbol => '\'} ];
+ 
+ print number_format(100000); # 100_000
+ print number_price(100000);  # \100_000
+
+thousands_sep and int_curr_symbol are given to all of -number kind of function.
+
 =head2 USE PLUGGABLE FEATURE FOR YOUR MODULE
 
@@ -970 +1057 @@
 
 NOTE THAT: I don't recommend this usage, because using this may confuse user;
-some of import options are for Util::Any and others are for exporter-like module.
+some of import options are for Util::Any and others are for exporter-like module
+(especially, ussing with Sub::Exporter is confusing).
 
 CPAN has some modules to export functions.

lang/perl/Util-Any/trunk/t/01-synopsis.t

@@ -83 +83 @@
 ok(!defined &l_uniq);
 
+package EE;
+use Test::More;
+
+use Util::Any -list => {uniq => {-as => 'li_uniq'}, -prefix => "ll_"}, {smart_rename => 1};
+is_deeply([li_uniq qw/1 0 1 2 3 3/], [1,0,2,3]);
+is(ll_min(qw/10 9 8 4 5 7/), 4);
+ok(!defined &ll_uniq);
+

lang/perl/Util-Any/trunk/t/05-smart-rename.t

@@ -1 +1 @@
 use Test::More 'no_plan';
 use lib qw(./lib t/lib);
+
+package AA;
+use Test::More;
+
 use SmartRename -utf8, {smart_rename => 1};
 
@@ -9 +13 @@
 ok(defined(&utf8_downgrade));
 
+package BB;
+use Test::More;
+
+use SmartRename -utf8 => {is_utf8 => {-as => 'utf_flagged'}, -prefix => 'xx_', smart_rename => 1};
+
+ok(!defined(&xx_is_utf8));
+ok(defined(&utf_flagged));
+ok(defined(&xx_utf8_upgrade));
+ok(defined(&xx_downgrade));
+

lang/perl/Util-Any/trunk/t/11-sub-exporter-all.t

@@ -5 +5 @@
 my $err;
 BEGIN {
-  eval "use UtilSubExporter 'all'";
+  eval "use UtilSubExporter '-all'";
   $err = $@;
 }
@@ -18 +18 @@
 ok(defined &min,    'defined min');
 ok(defined &minstr, 'defined minstr');
-ok(!defined &hello,       'not defined hello');
-ok(!defined &hi,          'not defined hi');
-ok(!defined &askme,       'not defined askme');
+ok(defined &hello,       'defined hello');
+ok(defined &hi,          'defined hi');
+ok(defined &askme,       'defined askme');
 
 is((first {$_ >= 4} (2,10,4,3,5)), 10, 'list first');

lang/perl/Util-Any/trunk/t/lib/SubExporterGenerator.pm

@@ -21 +21 @@
               max => \&build_max_reformatter,
               hoge => sub { sub () {"hogehoge"}},
+              check_default => \&check_default,
              }
             ],
@@ -45 +46 @@
 }
 
+sub check_default {
+  my ($pkg, $class, $name, $args, $default_args) = @_;
+  sub {
+    return $default_args;
+  }
+}
+
 1;

lang/perl/Util-Any/trunk/t/lib/UtilExporter.pm

@@ -13 +13 @@
                     'us'    => [qw/hi/],
                     'hello' => [qw/hello_name hello_where/],
+                    'all'   => [qw/hello hi askme/],
                    );
 

lang/perl/Util-Any/trunk/t/lib/UtilPerl6ExportAttrs.pm

@@ -34 +34 @@
                 ];
 
-sub import {
-  my $pkg = shift;
-  my $caller = (caller)[0];
-
-  no strict 'refs';
-  eval "package $caller; $pkg" . '->Util::Any::import(@_);';
-  my @arg = grep !exists $Utils->{$_}, @_;
-  if (@_ and @arg) {
-    eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
-  } elsif (!@_) {
-    eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import';
-  }
-  return;
-}
+## sub import {
+##   my $pkg = shift;
+##   my $caller = (caller)[0];
+## 
+##   no strict 'refs';
+##   eval "package $caller; $pkg" . '->Util::Any::import(@_);';
+##   my @arg = grep !exists $Utils->{$_}, @_;
+##   if (@_ and @arg) {
+##     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import(@arg)';
+##   } elsif (!@_) {
+##     eval "package $caller; $pkg" . '->Perl6::Export::Attrs::_generic_import';
+##   }
+##   return;
+## }
 
 1;