From: Matt S Trout <mst@shadowcat.co.uk>
Date: Thu, 3 May 2012 19:51:38 +0000 (+0000)
Subject: it works!
X-Git-Tag: v1.000000~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2afb5246467e98519cbc8df4025dd6e4a929a85d;p=p5sagit%2FImport-Into.git

it works!
---

2afb5246467e98519cbc8df4025dd6e4a929a85d
diff --git a/lib/Import/Into.pm b/lib/Import/Into.pm
new file mode 100644
index 0000000..a8a3ada
--- /dev/null
+++ b/lib/Import/Into.pm
@@ -0,0 +1,51 @@
+package Import::Into;
+
+use strict;
+use warnings FATAL => 'all';
+
+our $VERSION = '1.0';
+
+my %importers;
+
+sub import::into {
+  my ($class, $target, @args) = @_;
+  $class->${\(
+    $importers{$target} ||= eval qq{
+      package $target;
+      sub { shift->import(\@_) };
+    } or die "Couldn't build importer for $target: $@"
+  )}(@args);
+}
+
+1;
+ 
+=head1 NAME
+
+Import::Into - import packages into other packages 
+
+=head1 SYNOPSIS
+
+  package My::MultiExporter;
+
+  use Thing1 ();
+  use Thing2 ();
+
+  sub import {
+    my $target = caller;
+    Thing1->import::into($target);
+    Thing2->import::into($target, qw(import arguments));
+  }
+
+=head1 AUTHOR
+
+mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010-2011 the Import::Into L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
diff --git a/t/import_into.t b/t/import_into.t
new file mode 100644
index 0000000..504dcbe
--- /dev/null
+++ b/t/import_into.t
@@ -0,0 +1,52 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+BEGIN {
+
+  package MyExporter;
+
+  use base qw(Exporter);
+
+  our @EXPORT_OK = qw(thing);
+
+  sub thing { 'thing' }
+
+  package MultiExporter;
+
+  use Import::Into;
+
+  sub import {
+    my $target = caller;
+    warnings->import::into($target);
+    MyExporter->import::into($target, 'thing');
+  }
+
+  $INC{"MultiExporter.pm"} = 1;
+}
+
+BEGIN {
+
+  package TestPackage;
+
+  no warnings;
+
+  use MultiExporter;
+
+  sub test {
+    thing . undef
+  }
+}
+
+my @w;
+
+is(do {
+  local $SIG{__WARN__} = sub { push @w, @_; };
+  TestPackage::test;
+}, 'thing', 'returned thing ok');
+
+is(scalar @w, 1, 'Only one entry in @w');
+
+like($w[0], qr/uninitialized/, 'Correct warning');
+
+done_testing;