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; |
14 | use base qw(Exporter); |
3c739397 |
15 | use Moo::_mro; |
6c74d087 |
16 | |
3c739397 |
17 | our @EXPORT = qw( |
18 | _getglob _install_modifier _load_module _maybe_load_module |
19 | _get_linear_isa |
20 | ); |
6c74d087 |
21 | |
6c74d087 |
22 | sub _install_modifier { |
6c74d087 |
23 | my ($into, $type, $name, $code) = @_; |
a165a07f |
24 | |
dccea57d |
25 | if (my $to_modify = $into->can($name)) { # CMM will throw for us if not |
7568ba55 |
26 | require Sub::Defer; |
dccea57d |
27 | Sub::Defer::undefer_sub($to_modify); |
28 | } |
a165a07f |
29 | |
6c74d087 |
30 | Class::Method::Modifiers::install_modifier(@_); |
31 | } |
32 | |
daa05b62 |
33 | our %MAYBE_LOADED; |
34 | |
5e03b55c |
35 | # _load_module is inlined in Role::Tiny - make sure to copy if you update it. |
36 | |
fb5074f6 |
37 | sub _load_module { |
fb5074f6 |
38 | (my $proto = $_[0]) =~ s/::/\//g; |
5ed7d68a |
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 | return 1 if grep !/::$/, keys %{_getstash($_[0])||{}}; |
faa9ce11 |
43 | { require "${proto}.pm"; } |
fb5074f6 |
44 | return 1; |
45 | } |
46 | |
daa05b62 |
47 | sub _maybe_load_module { |
48 | return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]}; |
49 | (my $proto = $_[0]) =~ s/::/\//g; |
59812c87 |
50 | local $@; |
daa05b62 |
51 | if (eval { require "${proto}.pm"; 1 }) { |
52 | $MAYBE_LOADED{$_[0]} = 1; |
53 | } else { |
54 | if (exists $INC{"${proto}.pm"}) { |
55 | warn "$_[0] exists but failed to load with error: $@"; |
56 | } |
57 | $MAYBE_LOADED{$_[0]} = 0; |
58 | } |
59 | return $MAYBE_LOADED{$_[0]}; |
60 | } |
61 | |
3c739397 |
62 | sub _get_linear_isa { |
63 | return mro::get_linear_isa($_[0]); |
64 | } |
65 | |
66 | our $_in_global_destruction = 0; |
67 | END { $_in_global_destruction = 1 } |
68 | |
59812c87 |
69 | sub STANDARD_DESTROY { |
70 | my $self = shift; |
71 | |
72 | my $e = do { |
73 | local $?; |
74 | local $@; |
75 | eval { |
76 | $self->DEMOLISHALL($_in_global_destruction); |
77 | }; |
78 | $@; |
79 | }; |
80 | |
81 | no warnings 'misc'; |
82 | die $e if $e; # rethrow |
83 | } |
84 | |
6c74d087 |
85 | 1; |