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