Commit | Line | Data |
---|---|---|
b1eebd55 | 1 | package Moo::_Utils; |
6c74d087 | 2 | |
0fe2ad8c | 3 | no warnings 'once'; # guard against -w |
4 | ||
119014a7 | 5 | sub _getglob { \*{$_[0]} } |
5ed7d68a | 6 | sub _getstash { \%{"$_[0]::"} } |
119014a7 | 7 | |
2215d4b9 | 8 | BEGIN { |
9 | *lt_5_8_3 = $] < 5.008003 | |
10 | ? sub () { 1 } | |
11 | : sub () { 0 } | |
12 | ; | |
13 | } | |
14 | ||
6c74d087 | 15 | use strictures 1; |
cf62c989 | 16 | use Module::Runtime qw(require_module); |
6c74d087 | 17 | use base qw(Exporter); |
3c739397 | 18 | use Moo::_mro; |
6c74d087 | 19 | |
3c739397 | 20 | our @EXPORT = qw( |
21 | _getglob _install_modifier _load_module _maybe_load_module | |
3362e41c | 22 | _get_linear_isa _getstash |
3c739397 | 23 | ); |
6c74d087 | 24 | |
6c74d087 | 25 | sub _install_modifier { |
6c74d087 | 26 | my ($into, $type, $name, $code) = @_; |
a165a07f | 27 | |
dccea57d | 28 | if (my $to_modify = $into->can($name)) { # CMM will throw for us if not |
7568ba55 | 29 | require Sub::Defer; |
dccea57d | 30 | Sub::Defer::undefer_sub($to_modify); |
31 | } | |
a165a07f | 32 | |
6c74d087 | 33 | Class::Method::Modifiers::install_modifier(@_); |
34 | } | |
35 | ||
daa05b62 | 36 | our %MAYBE_LOADED; |
37 | ||
fb5074f6 | 38 | sub _load_module { |
fb5074f6 | 39 | (my $proto = $_[0]) =~ s/::/\//g; |
5ed7d68a | 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 | return 1 if grep !/::$/, keys %{_getstash($_[0])||{}}; | |
cf62c989 | 44 | require_module($_[0]); |
fb5074f6 | 45 | return 1; |
46 | } | |
47 | ||
daa05b62 | 48 | sub _maybe_load_module { |
49 | return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]}; | |
50 | (my $proto = $_[0]) =~ s/::/\//g; | |
59812c87 | 51 | local $@; |
daa05b62 | 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 | ||
3c739397 | 63 | sub _get_linear_isa { |
64 | return mro::get_linear_isa($_[0]); | |
65 | } | |
66 | ||
67 | our $_in_global_destruction = 0; | |
68 | END { $_in_global_destruction = 1 } | |
69 | ||
59812c87 | 70 | sub STANDARD_DESTROY { |
71 | my $self = shift; | |
72 | ||
73 | my $e = do { | |
74 | local $?; | |
75 | local $@; | |
76 | eval { | |
77 | $self->DEMOLISHALL($_in_global_destruction); | |
78 | }; | |
79 | $@; | |
80 | }; | |
81 | ||
82 | no warnings 'misc'; | |
83 | die $e if $e; # rethrow | |
84 | } | |
85 | ||
6c74d087 | 86 | 1; |