use Sub::Exporter;
-sub get_caller {
- # 1 extra level because it's called by import so there's a layer
- # of indirection
- my $offset = 1;
-
- return
- ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
- : ( ref $_[1] && defined $_[1]->{into_level} )
- ? caller( $offset + $_[1]->{into_level} )
- : caller($offset);
-}
-
my %EXPORT_SPEC;
+
sub build_import_methods {
my $class = shift;
my %args = @_;
$EXPORT_SPEC{$exporting_package} = \%args;
- my ( $exporter, $exported )
- = $class->_build_exporter( exporting_package => $exporting_package,
- %args );
-
- my $import = sub {
- my $caller = Moose::Exporter->get_caller(@_);
-
- # this works because both pragmas set $^H (see perldoc perlvar)
- # which affects the current compilation - i.e. the file who use'd
- # us - which is why we don't need to do anything special to make
- # it affect that file rather than this one (which is already compiled)
-
- strict->import;
- warnings->import;
-
- # we should never export to main
- if ( $caller eq 'main' ) {
- warn
- qq{$exporting_package does not export its sugar to the 'main' package.\n};
- return;
- }
-
- if ( $exporting_package->can('_init_meta') ) {
- $exporting_package->_init_meta(
- for_class => $caller,
- %{ $args{init_meta_args} || {} }
- );
- }
-
- goto $exporter;
- };
+ my ( $exporter, $exported ) = $class->_build_exporter(
+ exporting_package => $exporting_package,
+ %args
+ );
- # [12:24] <mst> yes. that's horrible. I know. but it should work.
- #
- # This will hopefully be replaced in the future once
- # namespace::clean has an API for it.
- my $unimport = sub {
- @_ = ( 'namespace::clean', @{ $exported } );
+ my $import = $class->_make_import_sub(
+ $exporting_package, $args{init_meta_args},
+ $exporter
+ );
- goto &namespace::clean::import;
- };
+ my $unimport = $class->_make_unimport_sub($exported);
no strict 'refs';
- *{ $exporting_package . '::import' } = $import;
+ *{ $exporting_package . '::import' } = $import;
*{ $exporting_package . '::unimport' } = $unimport;
}
return $exporter, \@exported_names;
}
+sub _make_import_sub {
+ my $class = shift;
+ my $exporting_package = shift;
+ my $init_meta_args = shift;
+ my $exporter = shift;
+
+ return sub {
+ my $caller = Moose::Exporter->_get_caller(@_);
+
+ # this works because both pragmas set $^H (see perldoc perlvar)
+ # which affects the current compilation - i.e. the file who use'd
+ # us - which is why we don't need to do anything special to make
+ # it affect that file rather than this one (which is already compiled)
+
+ strict->import;
+ warnings->import;
+
+ # we should never export to main
+ if ( $caller eq 'main' ) {
+ warn
+ qq{$exporting_package does not export its sugar to the 'main' package.\n};
+ return;
+ }
+
+ if ( $exporting_package->can('_init_meta') ) {
+ $exporting_package->_init_meta(
+ for_class => $caller,
+ %{ $init_meta_args || {} }
+ );
+ }
+
+ goto $exporter;
+ };
+}
+
+sub _get_caller {
+ # 1 extra level because it's called by import so there's a layer
+ # of indirection
+ my $offset = 1;
+
+ return
+ ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
+ : ( ref $_[1] && defined $_[1]->{into_level} )
+ ? caller( $offset + $_[1]->{into_level} )
+ : caller($offset);
+}
+
+sub _make_unimport_sub {
+ my $class = shift;
+ my $exported = shift;
+
+ # [12:24] <mst> yes. that's horrible. I know. but it should work.
+ #
+ # This will hopefully be replaced in the future once
+ # namespace::clean has an API for it.
+ return sub {
+ @_ = ( 'namespace::clean', @{$exported} );
+
+ goto &namespace::clean::import;
+ };
+}
+
1;