From: Matt S Trout 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?p=p5sagit%2FImport-Into.git;a=commitdiff_plain;h=2afb5246467e98519cbc8df4025dd6e4a929a85d 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) + +=head1 COPYRIGHT + +Copyright (c) 2010-2011 the Import::Into L and L +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;