lib/MooseX/Antlers/StealImport.pm

   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) {
  37     (my $pm_file = $unsteal) =~ s/::/\//g;
  38     if (exists $saved_inc{$unsteal}) {
  39       $INC{"${pm_file}.pm"} = delete $saved_inc{$unsteal};
  40     } else {
  41       delete $INC{"${pm_file}.pm"};
  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;