Changeset 35363 for lang/perl

Show
Ignore:
Timestamp:
09/14/09 08:28:34 (5 years ago)
Author:
ktat
Message:

add smart_rename feature

Location:
lang/perl/Util-Any/trunk
Files:
3 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/Util-Any/trunk/Changes

    r35361 r35363  
    11Revision history for Util-Any 
     2 
     30.10    2009/09/13 08:17 
     4        add option smart_rename. 
    25 
    360.09    2009/09/13 03:31 
  • lang/perl/Util-Any/trunk/lib/Util/Any.pm

    r35361 r35363  
    2424  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-[A-Z]\w+$/; 
    2525 
    26   my %opt = (prefix => 0, module_prefix => 0, debug => 0); 
     26  my %opt = (prefix => 0, module_prefix => 0, debug => 0, smart_rename => 0); 
    2727  if (@_ > 1 and ref $_[-1] eq 'HASH') { 
    28     @opt{qw/prefix module_prefix debug/} = (delete @{$_[-1]}{qw/prefix module_prefix debug/}); 
     28    @opt{qw/prefix module_prefix debug smart_rename/} = (delete @{$_[-1]}{qw/prefix module_prefix debug smart_rename/}); 
    2929    pop @_ unless %{$_[-1]}; 
    3030  } 
     
    4040      my @funcs = @{$funcs->{$kind} || []}; 
    4141      ($class, $module_prefix, $options) = @$class if ref $class; 
     42      my $k = lc(join "", $kind =~m{(\w+)}g); 
    4243      $prefix = $kind_prefix                             ? $kind_prefix   : 
    4344                ($opt{module_prefix} and $module_prefix) ? $module_prefix : 
    44                 $opt{prefix}                             ? lc(join "",$kind =~m{(\w+)}g) . '_': ''; 
     45                 $opt{prefix}                            ? lc($k) . '_'   : 
     46                 $opt{smart_rename}                      ? $pkg->_create_smart_rename($k) : ''; 
    4547 
    4648      my $evalerror = ''; 
     
    8183} 
    8284 
     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 
    83101sub _all_funcs_in_class { 
    84102  my ($class) = @_; 
     
    100118              ($caller => 
    101119               { 
    102                 ($local_rename ? $local_rename : $prefix ? $prefix . $func : $func) 
     120                ($local_rename ? $local_rename : $prefix ? (ref $prefix eq 'CODE' ? $prefix->($func) : $prefix . $func) : $func) 
    103121                              => $class . '::' . $func 
    104122               }); 
     
    109127  } 
    110128  ExportTo::export_to($caller => ($prefix or %$rename) 
    111                       ? {map {($prefix . ($rename->{$_} || $_)) => $class . '::' . $_} @export_funcs} 
     129                      ? {map {(ref $prefix ne 'CODE' ? $prefix . ($rename->{$_} || $_) : $prefix->($_)) => $class . '::' . $_} @export_funcs} 
    112130                      : [map $class . '::' . $_, uniq @export_funcs]); 
    113131} 
     
    260278=cut 
    261279 
    262 our $VERSION = '0.09'; 
     280our $VERSION = '0.10'; 
    263281 
    264282=head1 SYNOPSIS 
     
    350368see L<PREFIX FOR EACH MODULE>. 
    351369Uti::Any itself doesn't have such a definition. 
     370 
     371=item smart_rename => 1 
     372 
     373see L<SMART RENAME FOR EACH KIND>. 
    352374 
    353375=item debug => 1/2 
     
    541563 use Util::Yours qw/list/, {module_prefix => 1}; 
    542564 
     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 
    543594=head2 OTHER WAY TO EXPORT FUNCTIONS 
    544595 
  • lang/perl/Util-Any/trunk/t/01-unit.t

    r35361 r35363  
    2020undef &_use_import_module; 
    2121 
    22  
     22my $r = Util::Any->_create_smart_rename("hoge"); 
     23is $r->("is_hoge"), "is_hoge"; 
     24is $r->("is_hogehoge"), "is_hogehoge"; 
     25is $r->("fuga"), "hoge_fuga"; 
     26is $r->("is_fuga"), "is_hoge_fuga"; 
     27is $r->("foo_bar_hoge"), "foo_bar_hoge"; 
     28is $r->("foo_bar_hoge_fuga"), "hoge_foo_bar_hoge_fuga";