Commit | Line | Data |
064721e6 |
1 | package MooseX::Antlers::StealImport; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | my %saved_import; |
7 | my %saved_inc; |
8 | |
9 | sub import { |
10 | my ($class, %steal_classes) = @_; |
11 | foreach my $to_steal (keys %steal_classes) { |
12 | (my $pm_file = $to_steal) =~ s/::/\//g; |
13 | if (exists $INC{"${pm_file}.pm"}) { |
14 | $saved_inc{$to_steal} = $INC{"${pm_file}.pm"} |
15 | } |
16 | $INC{"${pm_file}.pm"} = __FILE__; |
17 | my %steal_methods = %{$steal_classes{$to_steal}}; |
18 | { |
19 | no strict 'refs'; |
20 | no warnings 'redefine'; |
21 | $saved_import{$to_steal} = $to_steal->can('import'); |
22 | my $do = delete $steal_methods{-do}; |
23 | *{"${to_steal}::import"} = sub { |
24 | my $targ = caller; |
25 | $do->(@_) if $do; |
26 | foreach my $meth (keys %steal_methods) { |
27 | *{"${targ}::${meth}"} = $steal_methods{$meth}; |
28 | } |
29 | }; |
30 | } |
31 | } |
32 | } |
33 | |
34 | sub unimport { |
35 | my ($class, @unsteal_classes) = @_; |
36 | foreach my $unsteal (@unsteal_classes) { |
1fe11d3f |
37 | (my $pm_file = $unsteal) =~ s/::/\//g; |
064721e6 |
38 | if (exists $saved_inc{$unsteal}) { |
064721e6 |
39 | $INC{"${pm_file}.pm"} = delete $saved_inc{$unsteal}; |
1fe11d3f |
40 | } else { |
41 | delete $INC{"${pm_file}.pm"}; |
064721e6 |
42 | } |
43 | if (defined $saved_import{$unsteal}) { |
44 | { |
45 | no strict 'refs'; |
46 | no warnings 'redefine'; |
47 | *{"${unsteal}::import"} = delete $saved_import{$unsteal}; |
48 | } |
49 | } else { |
50 | { |
51 | no strict 'refs'; |
52 | delete ${"${unsteal}::"}{import}; |
53 | } |
54 | } |
55 | } |
56 | } |
57 | |
58 | 1; |