correctly remove %INC entries

[gitmo/MooseX-Antlers.git] / lib / MooseX / Antlers / StealImport.pm

package MooseX::Antlers::StealImport;

use strict;
use warnings FATAL => 'all';

my %saved_import;
my %saved_inc;

sub import {
  my ($class, %steal_classes) = @_;
  foreach my $to_steal (keys %steal_classes) {
    (my $pm_file = $to_steal) =~ s/::/\//g;
    if (exists $INC{"${pm_file}.pm"}) {
      $saved_inc{$to_steal} = $INC{"${pm_file}.pm"}
    }
    $INC{"${pm_file}.pm"} = __FILE__;
    my %steal_methods = %{$steal_classes{$to_steal}};
    {
      no strict 'refs';
      no warnings 'redefine';
      $saved_import{$to_steal} = $to_steal->can('import');
      my $do = delete $steal_methods{-do};
      *{"${to_steal}::import"} = sub {
        my $targ = caller;
        $do->(@_) if $do;
        foreach my $meth (keys %steal_methods) {
          *{"${targ}::${meth}"} = $steal_methods{$meth};
        }
      };
    }
  }
}

sub unimport {
  my ($class, @unsteal_classes) = @_;
  foreach my $unsteal (@unsteal_classes) {
    (my $pm_file = $unsteal) =~ s/::/\//g;
    if (exists $saved_inc{$unsteal}) {
      $INC{"${pm_file}.pm"} = delete $saved_inc{$unsteal};
    } else {
      delete $INC{"${pm_file}.pm"};
    }
    if (defined $saved_import{$unsteal}) {
      {
        no strict 'refs';
        no warnings 'redefine';
        *{"${unsteal}::import"} = delete $saved_import{$unsteal};
      }
    } else {
      {
        no strict 'refs';
        delete ${"${unsteal}::"}{import};
      }
    }
  }
}

1;