this, sort of, works

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

diff --git a/lib/MooseX/Antlers/StealImport.pm b/lib/MooseX/Antlers/StealImport.pm
new file mode 100644 (file)
index 0000000..b961452
--- /dev/null
+++ b/lib/MooseX/Antlers/StealImport.pm
@@ -0,0 +1,56 @@
+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) {
+    if (exists $saved_inc{$unsteal}) {
+      (my $pm_file = $unsteal) =~ s/::/\//g;
+      $INC{"${pm_file}.pm"} = delete $saved_inc{$unsteal};
+    }
+    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;