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); |
6b90ff03 | 13 | use Devel::GlobalDestruction; |
6c74d087 | 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 | |
575ba24c | 19 | _get_linear_isa _getstash _install_coderef _name_coderef |
3c739397 | 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 | ||
fb5074f6 | 35 | sub _load_module { |
fb5074f6 | 36 | (my $proto = $_[0]) =~ s/::/\//g; |
5ed7d68a | 37 | return 1 if $INC{"${proto}.pm"}; |
38 | # can't just ->can('can') because a sub-package Foo::Bar::Baz | |
39 | # creates a 'Baz::' key in Foo::Bar's symbol table | |
2a577e53 | 40 | my $stash = _getstash($_[0])||{}; |
41 | return 1 if grep +(!ref($_) and *$_{CODE}), values %$stash; | |
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 { |
575ba24c | 62 | return mro::get_linear_isa($_[0]); |
63 | } | |
64 | ||
65 | sub _install_coderef { | |
66 | *{_getglob($_[0])} = _name_coderef(@_); | |
67 | } | |
68 | ||
69 | sub _name_coderef { | |
70 | can_haz_subname ? Sub::Name::subname(@_) : $_[1]; | |
3c739397 | 71 | } |
72 | ||
59812c87 | 73 | sub STANDARD_DESTROY { |
74 | my $self = shift; | |
75 | ||
76 | my $e = do { | |
77 | local $?; | |
78 | local $@; | |
79 | eval { | |
6b90ff03 | 80 | $self->DEMOLISHALL(in_global_destruction); |
59812c87 | 81 | }; |
82 | $@; | |
83 | }; | |
84 | ||
85 | no warnings 'misc'; | |
86 | die $e if $e; # rethrow | |
87 | } | |
88 | ||
6c74d087 | 89 | 1; |