Changeset 25726

Timestamp:

12/03/08 05:23:06 (4 years ago)

Author:

ktat

Message:

add module_prefix option; remove duplicated code

Location:

lang/perl/Util-Any/trunk

Files:

• Makefile.PL (modified) (1 diff)
• lib/Util/Any.pm (modified) (8 diffs)
• t/01-util-kind-my-prefix.t (added)
• t/lib/MyUtil.pm (modified) (1 diff)

lang/perl/Util-Any/trunk/Makefile.PL

@@ -10 +10 @@
     PL_FILES            => {},
     PREREQ_PM => {
-        'Test::More' => 0,
+        'Test::More'      => 0,
+        'ExportTo'        => 0,
+        'List::Util'      => 0,
+        'List::MoreUtils' => 0,
+        'Hash::Util'      => 0,
+        'Scalar::Util'    => 0,
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },

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

@@ -2 +2 @@
 
 use ExportTo ();
+use Carp ();
 use warnings;
 use strict;
 
 our %Utils = (
-              List   => [ qw/List::Util List::MoreUtils/ ],
-              Scalar => [ qw/Scalar::Util/ ],
-              Hash   => [ qw/Hash::Util/ ],
+              list   => [ qw/List::Util List::MoreUtils/ ],
+              scalar => [ qw/Scalar::Util/ ],
+              hash   => [ qw/Hash::Util/ ],
              );
 
@@ -15 +16 @@
   my $caller = (caller)[0];
   my %want;
-  my %opt = (prefix => 0);
+  my %opt = (prefix => 0, module_prefix => 0);
 
   if (@_ > 1 and ref $_[-1] eq 'HASH') {
@@ -23 +24 @@
   if (@_) {
     if (ref $_[0] eq 'HASH') {
-      %want = %{shift()};
+      my %_want = %{shift()};
+      %want = map {lc($_) => $_want{$_}} keys %_want;
     } elsif (lc($_[0]) eq 'all') {
       @want{keys %Utils} = ();
     } else {
-      @want{@_} = ();
+      @want{map lc $_, @_} = ();
     }
   }
@@ -34 +36 @@
 
   foreach my $kind (keys %Utils) {
-    my $prefix = lc($kind) . '_';
+    my ($prefix, $module_prefix) = ('','');
+
     if (exists $want{$kind}) {
       foreach my $class (@{$Utils{$kind}}) {
+        ($class, $module_prefix) = ref $class ? @$class : ($class, $prefix);
+        if ($opt{module_prefix} and $module_prefix) {
+          $prefix = $module_prefix;
+        } elsif ($opt{prefix}) {
+          $prefix = lc($kind) . '_';
+        }
         eval "require $class";
         unless ($@) {
           my @funcs = @{${class} . '::EXPORT_OK'};
-          unless (my $want_func = $want{$kind}) {
-            if ($opt{prefix}) {
-              ExportTo::export_to
-                  ($caller => {map {$prefix . $_ => $class . '::' . $_} @funcs});
-            } else {
-              ExportTo::export_to
-                  ($caller => [map $class . '::' . $_, @funcs]);
-            }
-          } else {
+          if (my $want_func = $want{$kind}) {
             my %w;
             @w{@$want_func} = ();
-            if ($opt{prefix}) {
-              ExportTo::export_to
-                  ($caller => {map {$prefix . $_ => $class . '::' . $_} grep exists $w{$_}, @funcs});
-            } else {
-              ExportTo::export_to
-                  ($caller => [map $class . '::' . $_, grep exists $w{$_}, @funcs]);
-            }
+            @funcs = grep exists $w{$_}, @funcs;
           }
+          if ($prefix) {
+            ExportTo::export_to
+                ($caller => {map {$prefix . $_ => $class . '::' . $_} @funcs});
+          } else {
+            ExportTo::export_to
+                ($caller => [map $class . '::' . $_, @funcs]);
+          }
+        } else {
+          Carp::carp $@;
         }
       }
@@ -80 +84 @@
 =head1 SYNOPSIS
 
-    use Util::Any qw/List/;
+    use Util::Any qw/list/;
     # you can import any functions of List::Util and List::MoreUtils
 
@@ -87 +91 @@
 If you want to choose functions
 
-    use Util::Any {List => qw/uniq/};
+    use Util::Any {list => qw/uniq/};
     # you can import uniq function, not import other functions
 
@@ -94 +98 @@
 If you want to import All kind of utility functions
 
-    use Util::Any qw/All/;
+    use Util::Any qw/all/;
 
 If you want to import functions with prefix(ex. list_, scalar_, hash_)
 
-    use Util::Any qw/All/, {prefix => 1};
-    use Util::Any qw/List/, {prefix => 1};
+    use Util::Any qw/all/, {prefix => 1};
+    use Util::Any qw/list/, {prefix => 1};
     use Util::Any {List => qw/uniq/}, {prefix => 1};
+    
+    print list_uniq qw/1, 0, 1, 2, 3, 3/;
 
 =head1 DESCRIPTION
@@ -118 +124 @@
  package Util::Yours;
  
- BEGIN {
-  use base qw/Util::Any/;
-  push @{$Util::Any::Utils{List}}, qw/Your::Favolite::List::Utils/;
- }
+ use base qw/Util::Any/;
+ push @{$Util::Any::Utils{list}}, qw/Your::Favorite::List::Utils/;
  
  1;
 
-In your code.
-
- use Util::Yours qw/List/;
+In your code;
+
+ use Util::Yours qw/list/;
+
+=head1 PREFIX FOR EACH MODULE
+
+If you want to import many modules and they have same function name.
+You can specify prefix for each module like the following.
+
+ use base qw/Util::Any/;
+ 
+ %Util::Any::Utils = (
+      list => [['List::Util' => 'lu_'], ['List::MoreUtils' => 'lmu_']]
+ );
+
+
+In your code;
+
+ use Util::Yours qw/list/, {module_prefix => 1};
 
 =head1 AUTHOR

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

@@ -1 +1 @@
 package MyUtil;
 
-BEGIN {
-  use base qw/Util::Any/;
-  %Util::Any::Utils =
-    (
-     List => [qw/List::Util/],
-    );
-}
+use base qw/Util::Any/;
+%Util::Any::Utils =
+  (
+   list => [['List::Util' => 'lu_']],
+  );
 
 1;