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 use constant lt_5_8_3 => ( $] < 5.008003 ) ? 1 : 0;
   9 use constant can_haz_subname => eval { require Sub::Name };
  10
  11 use strictures 1;
  12 use Module::Runtime qw(require_module);
  13 use base qw(Exporter);
  14 use Moo::_mro;
  15
  16 our @EXPORT = qw(
  17     _getglob _install_modifier _load_module _maybe_load_module
  18     _get_linear_isa _getstash _install_coderef _name_coderef
  19     _in_global_destruction
  20 );
  21
  22 sub _in_global_destruction ();
  23
  24 sub _install_modifier {
  25   my ($into, $type, $name, $code) = @_;
  26
  27   if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
  28     require Sub::Defer;
  29     Sub::Defer::undefer_sub($to_modify);
  30   }
  31
  32   Class::Method::Modifiers::install_modifier(@_);
  33 }
  34
  35 our %MAYBE_LOADED;
  36
  37 sub _load_module {
  38   (my $proto = $_[0]) =~ s/::/\//g;
  39   return 1 if $INC{"${proto}.pm"};
  40   # can't just ->can('can') because a sub-package Foo::Bar::Baz
  41   # creates a 'Baz::' key in Foo::Bar's symbol table
  42   my $stash = _getstash($_[0])||{};
  43   return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash;
  44   require_module($_[0]);
  45   return 1;
  46 }
  47
  48 sub _maybe_load_module {
  49   return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
  50   (my $proto = $_[0]) =~ s/::/\//g;
  51   local $@;
  52   if (eval { require "${proto}.pm"; 1 }) {
  53     $MAYBE_LOADED{$_[0]} = 1;
  54   } else {
  55     if (exists $INC{"${proto}.pm"}) {
  56       warn "$_[0] exists but failed to load with error: $@";
  57     }
  58     $MAYBE_LOADED{$_[0]} = 0;
  59   }
  60   return $MAYBE_LOADED{$_[0]};
  61 }
  62
  63 sub _get_linear_isa {
  64   return mro::get_linear_isa($_[0]);
  65 }
  66
  67 sub _install_coderef {
  68   no warnings 'redefine';
  69   *{_getglob($_[0])} = _name_coderef(@_);
  70 }
  71
  72 sub _name_coderef {
  73   shift if @_ > 2; # three args is (target, name, sub)
  74   can_haz_subname ? Sub::Name::subname(@_) : $_[1];
  75 }
  76
  77 sub STANDARD_DESTROY {
  78   my $self = shift;
  79
  80   my $e = do {
  81     local $?;
  82     local $@;
  83     eval {
  84       $self->DEMOLISHALL(_in_global_destruction);
  85     };
  86     $@;
  87   };
  88
  89   no warnings 'misc';
  90   die $e if $e; # rethrow
  91 }
  92
  93 if (eval { require_module('Devel::GlobalDestruction') }) {
  94   *_in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction;
  95 } elsif (defined ${^GLOBAL_PHASE}) {
  96   eval 'sub _in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }';
  97 } else {
  98   eval <<'PP_IGD' or die $@;
  99
 100 my ($in_global_destruction, $before_is_installed);
 101
 102 sub _in_global_destruction () { $in_global_destruction }
 103
 104 END {
 105   # SpeedyCGI runs END blocks every cycle but somehow keeps object instances
 106   # hence lying about it seems reasonable...ish
 107   $in_global_destruction = 1 unless $CGI::SpeedyCGI::i_am_speedy;
 108 }
 109
 110 # threads do not execute the global ENDs (it would be stupid). However
 111 # one can register a new END via simple string eval within a thread, and
 112 # achieve the same result. A logical place to do this would be CLONE, which
 113 # is claimed to run in the context of the new thread. However this does
 114 # not really seem to be the case - any END evaled in a CLONE is ignored :(
 115 # Hence blatantly hooking threads::create
 116
 117 if ($INC{'threads.pm'}) {
 118   my $orig_create = threads->can('create');
 119   no warnings 'redefine';
 120   *threads::create = sub {
 121     { local $@; eval 'END { $in_global_destruction = 1 }' };
 122     goto $orig_create;
 123   };
 124   $before_is_installed = 1;
 125 }
 126
 127 # just in case threads got loaded after us (silly)
 128 sub CLONE {
 129   unless ($before_is_installed) {
 130     require Carp;
 131     Carp::croak("You must load the 'threads' module before @{[ __PACKAGE__ ]}");
 132   }
 133 }
 134
 135 1;  # keep eval happy
 136
 137 PP_IGD
 138
 139 }
 140
 141 1;