lib/Import/Into.pm

   1 package Import::Into;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5
   6 our $VERSION = '1.001001'; # 1.1.1
   7
   8 sub _prelude {
   9   my $target = shift;
  10   my ($package, $file, $line, $level)
  11     = ref $target         ? @{$target}{qw(package filename line)}
  12     : $target =~ /[^0-9]/ ? ($target)
  13                           : (undef, undef, undef, $target);
  14   if (defined $level) {
  15     my ($p, $fn, $ln) = caller($level + 2);
  16     $package ||= $p;
  17     $file    ||= $fn;
  18     $line    ||= $ln;
  19   }
  20   qq{package $package;\n}
  21     . ($file ? "#line $line \"$file\"\n" : '')
  22 }
  23
  24 sub _make_action {
  25   my ($action, $target) = @_;
  26   my $version = ref $target && $target->{version};
  27   my $ver_check = $version ? '$_[0]->VERSION($version);' : '';
  28   eval _prelude($target).qq{sub { $ver_check shift->$action(\@_) }}
  29     or die "Failed to build action sub to ${action} for ${target}: $@";
  30 }
  31
  32 sub import::into {
  33   my ($class, $target, @args) = @_;
  34   _make_action(import => $target)->($class, @args);
  35 }
  36
  37 sub unimport::out_of {
  38   my ($class, $target, @args) = @_;
  39   _make_action(unimport => $target)->($class, @args);
  40 }
  41
  42 1;
  43
  44 =head1 NAME
  45
  46 Import::Into - import packages into other packages
  47
  48 =head1 SYNOPSIS
  49
  50   package My::MultiExporter;
  51
  52   use Import::Into;
  53
  54   use Thing1 ();
  55   use Thing2 ();
  56   use Thing3 ();
  57
  58   sub import {
  59     my $target = caller;
  60     Thing1->import::into($target);
  61     Thing2->import::into($target, qw(import arguments));
  62     Thing3->import::into(1); # import to level
  63   }
  64
  65 Note: you don't need to do anything more clever than this provided you
  66 document that people wanting to re-export your module should also be using
  67 L<Import::Into>. In fact, for a single module you can simply do:
  68
  69   sub import {
  70     ...
  71     Thing1->import::into(scalar caller);
  72   }
  73
  74 Notably, this works:
  75
  76   use base qw(Exporter);
  77
  78   sub import {
  79     shift->export_to_level(1);
  80     Thing1->import::into(scalar caller);
  81   }
  82
  83 Note 2: You do B<not> need to do anything to Thing1 to be able to call
  84 C<import::into> on it. This is a global method, and is callable on any
  85 package (and in fact on any object as well, although it's rarer that you'd
  86 want to do that).
  87
  88 If you provide C<import::into> with an integer instead of a package name, it
  89 will be used as the number of stack frames to skip to find where to export to.
  90 This has the advantage of preserving the apparent filename and line number
  91 being exported to, which some modules (L<autodie>, L<strictures>) check.
  92
  93 Finally, we also provide an C<unimport::out_of> to allow the exporting of the
  94 effect of C<no>:
  95
  96   # unimport::out_of was added in 1.1.0 (1.001000)
  97   sub unimport {
  98     Moose->unimport::out_of(scalar caller); # no MyThing == no Moose
  99   }
 100
 101 If how and why this all works is of interest to you, please read on to the
 102 description immediately below.
 103
 104 =head1 DESCRIPTION
 105
 106 Writing exporters is a pain. Some use L<Exporter>, some use L<Sub::Exporter>,
 107 some use L<Moose::Exporter>, some use L<Exporter::Declare> ... and some things
 108 are pragmas.
 109
 110 If you want to re-export other things, you have to know which is which.
 111 L<Exporter> subclasses provide export_to_level, but if they overrode their
 112 import method all bets are off. L<Sub::Exporter> provides an into parameter
 113 but figuring out something used it isn't trivial. Pragmas need to have
 114 their C<import> method called directly since they affect the current unit of
 115 compilation.
 116
 117 It's ... annoying.
 118
 119 However, there is an approach that actually works for all of these types.
 120
 121   eval "package $target; use $thing;"
 122
 123 will work for anything checking caller, which is everything except pragmas.
 124 But it doesn't work for pragmas - pragmas need:
 125
 126   $thing->import;
 127
 128 because they're designed to affect the code currently being compiled - so
 129 within an eval, that's the scope of the eval itself, not the module that
 130 just C<use>d you - so
 131
 132   sub import {
 133     eval "use strict;"
 134   }
 135
 136 doesn't do what you wanted, but
 137
 138   sub import {
 139     strict->import;
 140   }
 141
 142 will apply L<strict> to the calling file correctly.
 143
 144 Of course, now you have two new problems - first, that you still need to
 145 know if something's a pragma, and second that you can't use either of
 146 these approaches alone on something like L<Moose> or L<Moo> that's both
 147 an exporter and a pragma.
 148
 149 So, a solution for that is:
 150
 151   my $sub = eval "package $target; sub { shift->import(\@_) }";
 152   $sub->($thing, @import_args);
 153
 154 which means that import is called from the right place for pragmas to take
 155 effect, and from the right package for caller checking to work - and so
 156 behaves correctly for all types of exporter, for pragmas, and for hybrids.
 157
 158 Additionally, some import routines check the filename they are being imported
 159 to.  This can be dealt with by generating a L<#line directive|perlsyn/Plain
 160 Old Comments (Not!)> in the eval, which will change what C<caller> reports for
 161 the filename when called in the importer. The filename and line number to use
 162 in the directive then need to be fetched using C<caller>:
 163
 164   my ($target, $file, $line) = caller(1);
 165   my $sub = eval qq{
 166     package $target;
 167   #line $line "$file"
 168     sub { shift->import(\@_) }
 169   };
 170   $sub->($thing, @import_args);
 171
 172 Remembering all this, however, is excessively irritating. So I wrote a module
 173 so I didn't have to anymore. Loading L<Import::Into> creates a global method
 174 C<import::into> which you can call on any package to import it into another
 175 package. So now you can simply write:
 176
 177   use Import::Into;
 178
 179   $thing->import::into($target, @import_args);
 180
 181 This works because of how perl resolves method calls - a call to a simple
 182 method name is resolved against the package of the class or object, so
 183
 184   $thing->method_name(@args);
 185
 186 is roughly equivalent to:
 187
 188   my $code_ref = $thing->can('method_name');
 189   $code_ref->($thing, @args);
 190
 191 while if a C<::> is found, the lookup is made relative to the package name
 192 (i.e. everything before the last C<::>) so
 193
 194   $thing->Package::Name::method_name(@args);
 195
 196 is roughly equivalent to:
 197
 198   my $code_ref = Package::Name->can('method_name');
 199   $code_ref->($thing, @args);
 200
 201 So since L<Import::Into> defines a method C<into> in package C<import>
 202 the syntax reliably calls that.
 203
 204 For more craziness of this order, have a look at the article I wrote at
 205 L<http://shadow.cat/blog/matt-s-trout/madness-with-methods> which covers
 206 coderef abuse and the C<${\...}> syntax.
 207
 208 Final note: You do still need to ensure that you already loaded C<$thing> - if
 209 you're receiving this from a parameter, I recommend using L<Module::Runtime>:
 210
 211   use Import::Into;
 212   use Module::Runtime qw(use_module);
 213
 214   use_module($thing)->import::into($target, @import_args);
 215
 216 And that's it.
 217
 218 =head1 ACKNOWLEDGEMENTS
 219
 220 Thanks to Getty for asking "how can I get C<< use strict; use warnings; >>
 221 turned on for all consumers of my code?" and then "why is this not a
 222 module?!".
 223
 224 =head1 AUTHOR
 225
 226 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 227
 228 =head1 CONTRIBUTORS
 229
 230 haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
 231
 232 =head1 COPYRIGHT
 233
 234 Copyright (c) 2012 the Import::Into L</AUTHOR> and L</CONTRIBUTORS>
 235 as listed above.
 236
 237 =head1 LICENSE
 238
 239 This library is free software and may be distributed under the same terms
 240 as perl itself.