lib/Moose/Exporter.pm

   1 package Moose::Exporter;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Class::MOP;
   7 use namespace::clean 0.08 ();
   8 use Sub::Exporter;
   9
  10
  11 # This variable gets closed over in each export _generator_. Then in
  12 # the generator we grab the value and close over it _again_ in the
  13 # real export, so it gets captured each time the generator runs.
  14 #
  15 # In the meantime, we arrange for the import method we generate to set
  16 # this variable to the caller each time it is called.
  17 #
  18 # This is all a bit confusing, but it works.
  19 my $CALLER;
  20
  21 my %EXPORT_SPEC;
  22
  23 sub build_import_methods {
  24     my $class = shift;
  25     my %args  = @_;
  26
  27     my $exporting_package = caller();
  28
  29     $EXPORT_SPEC{$exporting_package} = \%args;
  30
  31     my $exports = $class->_process_exports(
  32         exporting_package => $exporting_package,
  33         %args,
  34     );
  35
  36     my $exporter = Sub::Exporter::build_exporter(
  37         {
  38             exports => $exports,
  39             groups  => { default => [':all'] }
  40         }
  41     );
  42
  43     my $import = $class->_make_import_sub(
  44         $exporter,
  45         $args{init_meta_args},
  46     );
  47
  48     my $unimport = $class->_make_unimport_sub( [ keys %{$exports} ] );
  49
  50     no strict 'refs';
  51     *{ $exporting_package . '::import' }   = $import;
  52     *{ $exporting_package . '::unimport' } = $unimport;
  53 }
  54
  55 sub _process_exports {
  56     my $class = shift;
  57     my %args  = @_;
  58
  59     my $exporting_package = $args{exporting_package};
  60
  61     my %exports;
  62     for my $name ( @{ $args{with_caller} } ) {
  63         my $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
  64
  65         # We need to set the package at import time, so that when
  66         # package Foo imports has(), we capture "Foo" as the
  67         # package. This lets other packages call Foo::has() and get
  68         # the right package. This is done for backwards compatibility
  69         # with existing production code, not because this is a good
  70         # idea ;)
  71         $exports{$name} = sub {
  72             my $caller = $CALLER;
  73             Class::MOP::subname( $exporting_package . '::'
  74                     . $name => sub { $sub->( $caller, @_ ) } );
  75         };
  76     }
  77
  78     for my $name ( @{ $args{as_is} } ) {
  79         my $sub;
  80
  81         if ( ref $name ) {
  82             $sub  = $name;
  83             $name = ( Class::MOP::get_code_info($name) )[1];
  84         }
  85         else {
  86             $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
  87         }
  88
  89         $exports{$name} = sub { $sub };
  90     }
  91
  92     return \%exports;
  93 }
  94
  95 sub _make_import_sub {
  96     my $class             = shift;
  97     my $exporter          = shift;
  98     my $init_meta_args    = shift;
  99
 100     return sub {
 101         # It's important to leave @_ as-is for the benefit of
 102         # Sub::Exporter.
 103         my $class = $_[0];
 104
 105         $CALLER = Moose::Exporter::_get_caller(@_);
 106
 107         # this works because both pragmas set $^H (see perldoc perlvar)
 108         # which affects the current compilation - i.e. the file who use'd
 109         # us - which is why we don't need to do anything special to make
 110         # it affect that file rather than this one (which is already compiled)
 111
 112         strict->import;
 113         warnings->import;
 114
 115         # we should never export to main
 116         if ( $CALLER eq 'main' ) {
 117             warn
 118                 qq{$class does not export its sugar to the 'main' package.\n};
 119             return;
 120         }
 121
 122         if ( $class->can('_init_meta') ) {
 123             $class->_init_meta(
 124                 for_class => $CALLER,
 125                 %{ $init_meta_args || {} }
 126             );
 127         }
 128
 129         goto $exporter;
 130     };
 131 }
 132
 133 sub _get_caller {
 134     # 1 extra level because it's called by import so there's a layer
 135     # of indirection
 136     my $offset = 1;
 137
 138     return
 139           ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
 140         : ( ref $_[1] && defined $_[1]->{into_level} )
 141         ? caller( $offset + $_[1]->{into_level} )
 142         : caller($offset);
 143 }
 144
 145 sub _make_unimport_sub {
 146     my $class    = shift;
 147     my $exported = shift;
 148
 149     # [12:24]  <mst> yes. that's horrible. I know. but it should work.
 150     #
 151     # This will hopefully be replaced in the future once
 152     # namespace::clean has an API for it.
 153     return sub {
 154         @_ = ( 'namespace::clean', @{$exported} );
 155
 156         goto &namespace::clean::import;
 157     };
 158 }
 159
 160 1;
 161
 162 __END__
 163
 164 =head1 NAME
 165
 166 Moose::Exporter - make an import() and unimport() just like Moose.pm
 167
 168 =head1 SYNOPSIS
 169
 170   package MyApp::Moose;
 171
 172   use strict;
 173   use warnings;
 174
 175   use Moose ();
 176   use Moose::Exporter;
 177
 178   Moose::Exporter->build_export_methods(
 179       export         => [ 'sugar1', 'sugar2', \&Some::Random::thing ],
 180       init_meta_args => { metaclass_class => 'MyApp::Meta::Class' ],
 181   );
 182
 183   # then later ...
 184   package MyApp::User;
 185
 186   use MyApp::Moose;
 187
 188   has 'name';
 189   sugar1 'do your thing';
 190   thing;
 191
 192   no MyApp::Moose;
 193
 194 =head1 DESCRIPTION
 195
 196 This module encapsulates the logic to export sugar functions like
 197 C<Moose.pm>. It does this by building custom C<import> and C<unimport>
 198 methods for your module, based on a spec your provide.
 199
 200 It also lets your "stack" Moose-alike modules so you can export
 201 Moose's sugar as well as your own, along with sugar from any random
 202 C<MooseX> module, as long as they all use C<Moose::Exporter>.
 203
 204 =head1 METHODS
 205
 206 This module provides exactly one public method:
 207
 208 =head2 Moose::Exporter->build_import_methods(...)
 209
 210 When you call this method, C<Moose::Exporter> build custom C<import>
 211 and C<unimport> methods for your module. The import method will export
 212 the functions you specify, and you can also tell it to export
 213 functions exported by some other module (like C<Moose.pm>).
 214
 215 The C<unimport> method cleans the callers namespace of all the
 216 exported functions.
 217
 218 This method accepts the following parameters:
 219
 220 =over 4
 221
 222 =item * with_caller => [ ... ]
 223
 224 This a list of function I<names only> to be exported wrapped and then
 225 exported. The wrapper will pass the name of the calling package as the
 226 first argument to the function. Many sugar functions need to know
 227 their caller so they can get the calling package's metaclass object.
 228
 229 =item * as_is => [ ... ]
 230
 231 This a list of function names or sub references to be exported
 232 as-is. You can identify a subroutine by reference, which is handy to
 233 re-export some other module's functions directly by reference
 234 (C<\&Some::Package::function>).
 235
 236 =item * init_meta_args
 237
 238 ...
 239
 240 =back
 241
 242 =head1 AUTHOR
 243
 244 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 245
 246 This is largely a reworking of code in Moose.pm originally written by
 247 Stevan Little and others.
 248
 249 =head1 COPYRIGHT AND LICENSE
 250
 251 Copyright 2008 by Infinity Interactive, Inc.
 252
 253 L<http://www.iinteractive.com>
 254
 255 This library is free software; you can redistribute it and/or modify
 256 it under the same terms as Perl itself.
 257
 258 =cut