Commit | Line | Data |
b1eebd55 |
1 | package Moo::_Utils; |
6c74d087 |
2 | |
119014a7 |
3 | sub _getglob { \*{$_[0]} } |
5ed7d68a |
4 | sub _getstash { \%{"$_[0]::"} } |
119014a7 |
5 | |
6c74d087 |
6 | use strictures 1; |
7 | use base qw(Exporter); |
8 | |
fb5074f6 |
9 | our @EXPORT = qw(_getglob _install_modifier _load_module _maybe_load_module); |
6c74d087 |
10 | |
6c74d087 |
11 | sub _install_modifier { |
6c74d087 |
12 | my ($into, $type, $name, $code) = @_; |
a165a07f |
13 | |
dccea57d |
14 | if (my $to_modify = $into->can($name)) { # CMM will throw for us if not |
15 | require Sub::Defer; |
16 | Sub::Defer::undefer_sub($to_modify); |
17 | } |
a165a07f |
18 | |
6c74d087 |
19 | Class::Method::Modifiers::install_modifier(@_); |
20 | } |
21 | |
daa05b62 |
22 | our %MAYBE_LOADED; |
23 | |
fb5074f6 |
24 | sub _load_module { |
fb5074f6 |
25 | (my $proto = $_[0]) =~ s/::/\//g; |
5ed7d68a |
26 | return 1 if $INC{"${proto}.pm"}; |
27 | # can't just ->can('can') because a sub-package Foo::Bar::Baz |
28 | # creates a 'Baz::' key in Foo::Bar's symbol table |
29 | return 1 if grep !/::$/, keys %{_getstash($_[0])||{}}; |
fb5074f6 |
30 | require "${proto}.pm"; |
31 | return 1; |
32 | } |
33 | |
daa05b62 |
34 | sub _maybe_load_module { |
35 | return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]}; |
36 | (my $proto = $_[0]) =~ s/::/\//g; |
37 | if (eval { require "${proto}.pm"; 1 }) { |
38 | $MAYBE_LOADED{$_[0]} = 1; |
39 | } else { |
40 | if (exists $INC{"${proto}.pm"}) { |
41 | warn "$_[0] exists but failed to load with error: $@"; |
42 | } |
43 | $MAYBE_LOADED{$_[0]} = 0; |
44 | } |
45 | return $MAYBE_LOADED{$_[0]}; |
46 | } |
47 | |
6c74d087 |
48 | 1; |