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