view release on metacpan or  search on metacpan

lib/Util/Any.pm  view on Meta::CPAN

package Util::Any;

use ExportTo ();
use Clone ();
use Carp ();
use warnings;
use strict;

our $Utils = {
              list   => [ qw/List::Util List::MoreUtils List::Pairwise/ ],
              data   => [ qw/Scalar::Util/ ],
              hash   => [ qw/Hash::Util/ ],
              debug  => [ ['Data::Dumper', '', ['Dumper']] ],
              string => [ qw/String::Util String::CamelCase/ ],
             };

$Utils->{'scalar'} = $Utils->{data};
# I'll delete no dash group in the above, in future.
$Utils->{'-' . $_} = $Utils->{$_} foreach keys %$Utils;

our $SubExporterImport = 'do_import';

sub _default_kinds { }

# borrow from List::MoreUtils
sub _any (&@) {
    my $f = shift;
    return if ! @_;
    for (@_) {
        return 1 if $f->();
    }
    return 0;
}

sub _uniq (@) {
    my %h;
    map { $h{$_}++ == 0 ? $_ : () } @_;
}
# /end

sub import {
  my ($pkg, $caller) = (shift, (caller)[0]);
  return $pkg->_base_import($caller, @_) if @_ and $_[0] =~/^-[A-Z]\w+$/o;

  my %opt;
  if (@_ > 1 and ref $_[-1] eq 'HASH') {
    @opt{qw/prefix module_prefix debug smart_rename plugin/}
      = (delete @{$_[-1]}{qw/prefix module_prefix debug smart_rename plugin/});
    pop @_ unless %{$_[-1]};
  }
  $opt{$_} ||= 0 foreach qw/prefix module_prefix debug smart_rename/;
  if (not defined $opt{plugin}) {
    $opt{plugin} = 'lazy';
  } elsif ($opt{plugin} and $opt{plugin} ne 'eager') {
    Carp::croak "wrong option is passed for plugin: " . $opt{plugin};
  }

  @_ = %{$_[0]} if @_ == 1 and ref $_[0] eq 'HASH';

  my $config = Clone::clone(do { no strict 'refs'; ${$pkg . '::Utils'} });
  if ($pkg->can('_plugins')) {
    if ($opt{plugin} eq 'eager') {
      foreach my $plugin ($pkg->plugins) {
        eval "require $plugin";
        my $util = $plugin->utils;
        foreach my $kind (keys %$util) {
          push @{$config->{$kind} ||= []}, @{$util->{$kind}};
        }
      }
    }
  }
  my ($arg, $want_kind) = $pkg->_arrange_args
    ([
      @_ ? ($_[0] =~m{^[-:]?all$}i ?  ($_[0], $pkg->_default_kinds, @_[1 .. $#_]) : ($pkg->_default_kinds, @_))
         : ($pkg->_default_kinds)
     ],
     $config, $caller, \%opt);
  foreach my $kind (keys %$want_kind) {
    # Carp::croak "$pkg doesn't have such kind of functions : $kind"
    # unless exists $config->{$kind};
    $pkg->_kind_exporter($caller, $config->{$kind}, (lc(join "", $kind =~m{(\w+)}go)), $want_kind->{$kind}, \%opt);
  }
}

sub _kind_exporter {
  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, '', '');

    my $evalerror = '';
    if ($evalerror = do { local $@; eval {my $path = $class; $path =~s{::}{/}go; require $path. ".pm"; $evalerror = $@ }; $@}) {
      # if ($evalerror = do { local $@; eval "require $class"; $evalerror = $@ }) {
      $opt->{debug} == 2 ? Carp::croak $evalerror : Carp::carp $evalerror;
    }

    $prefix = $kind_prefix                       ? $kind_prefix                           :
      ($opt->{module_prefix} and $module_prefix) ? $module_prefix                         :
      $opt->{prefix}                             ? lc($kind_word) . '_'                   :
      $opt->{smart_rename}                       ? $pkg->_create_smart_rename($kind_word) : '';