lib/Moo/_Utils.pm

   1 package Moo::_Utils;
   2
   3 no warnings 'once'; # guard against -w
   4
   5 sub _getglob { \*{$_[0]} }
   6 sub _getstash { \%{"$_[0]::"} }
   7
   8 BEGIN {
   9   *lt_5_8_3 = $] < 5.008003
  10     ? sub () { 1 }
  11     : sub () { 0 }
  12   ;
  13 }
  14
  15 use strictures 1;
  16 use Module::Runtime qw(require_module);
  17 use base qw(Exporter);
  18 use Moo::_mro;
  19
  20 our @EXPORT = qw(
  21     _getglob _install_modifier _load_module _maybe_load_module
  22     _get_linear_isa _getstash
  23 );
  24
  25 sub _install_modifier {
  26   my ($into, $type, $name, $code) = @_;
  27
  28   if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
  29     require Sub::Defer;
  30     Sub::Defer::undefer_sub($to_modify);
  31   }
  32
  33   Class::Method::Modifiers::install_modifier(@_);
  34 }
  35
  36 our %MAYBE_LOADED;
  37
  38 sub _load_module {
  39   (my $proto = $_[0]) =~ s/::/\//g;
  40   return 1 if $INC{"${proto}.pm"};
  41   # can't just ->can('can') because a sub-package Foo::Bar::Baz
  42   # creates a 'Baz::' key in Foo::Bar's symbol table
  43   my $stash = _getstash($_[0])||{};
  44   return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash;
  45   require_module($_[0]);
  46   return 1;
  47 }
  48
  49 sub _maybe_load_module {
  50   return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
  51   (my $proto = $_[0]) =~ s/::/\//g;
  52   local $@;
  53   if (eval { require "${proto}.pm"; 1 }) {
  54     $MAYBE_LOADED{$_[0]} = 1;
  55   } else {
  56     if (exists $INC{"${proto}.pm"}) {
  57       warn "$_[0] exists but failed to load with error: $@";
  58     }
  59     $MAYBE_LOADED{$_[0]} = 0;
  60   }
  61   return $MAYBE_LOADED{$_[0]};
  62 }
  63
  64 sub _get_linear_isa {
  65     return mro::get_linear_isa($_[0]);
  66 }
  67
  68 our $_in_global_destruction = 0;
  69 END { $_in_global_destruction = 1 }
  70
  71 sub STANDARD_DESTROY {
  72   my $self = shift;
  73
  74   my $e = do {
  75     local $?;
  76     local $@;
  77     eval {
  78       $self->DEMOLISHALL($_in_global_destruction);
  79     };
  80     $@;
  81   };
  82
  83   no warnings 'misc';
  84   die $e if $e; # rethrow
  85 }
  86
  87 1;