lib/Moo/_Utils.pm

   1 package Moo::_Utils;
   2
   3 sub _getglob { \*{$_[0]} }
   4 sub _getstash { \%{"$_[0]::"} }
   5
   6 use strictures 1;
   7 use base qw(Exporter);
   8
   9 our @EXPORT = qw(_getglob _install_modifier _load_module _maybe_load_module);
  10
  11 sub _install_modifier {
  12   my ($into, $type, $name, $code) = @_;
  13
  14   if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
  15     require Sub::Defer;
  16     Sub::Defer::undefer_sub($to_modify);
  17   }
  18
  19   Class::Method::Modifiers::install_modifier(@_);
  20 }
  21
  22 our %MAYBE_LOADED;
  23
  24 sub _load_module {
  25   (my $proto = $_[0]) =~ s/::/\//g;
  26   return 1 if $INC{"${proto}.pm"};
  27   # can't just ->can('can') because a sub-package Foo::Bar::Baz
  28   # creates a 'Baz::' key in Foo::Bar's symbol table
  29   return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
  30   require "${proto}.pm";
  31   return 1;
  32 }
  33
  34 sub _maybe_load_module {
  35   return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
  36   (my $proto = $_[0]) =~ s/::/\//g;
  37   if (eval { require "${proto}.pm"; 1 }) {
  38     $MAYBE_LOADED{$_[0]} = 1;
  39   } else {
  40     if (exists $INC{"${proto}.pm"}) {
  41       warn "$_[0] exists but failed to load with error: $@";
  42     }
  43     $MAYBE_LOADED{$_[0]} = 0;
  44   }
  45   return $MAYBE_LOADED{$_[0]};
  46 }
  47
  48 1;