From: Dave Rolsky Date: Thu, 7 Aug 2008 02:30:01 +0000 (+0000) Subject: Merged tests for export currying from trunk. X-Git-Tag: 0_55_01~43^2~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f5324ccad16a743ca8483156e6db6db8360b2f74;p=gitmo%2FMoose.git Merged tests for export currying from trunk. Finally got Moose::Exporter passing all tests, including the export currying tests. --- f5324ccad16a743ca8483156e6db6db8360b2f74 diff --cc lib/Moose/Exporter.pm index c4f19a2,0000000..9b7fea9 mode 100644,000000..100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@@ -1,259 -1,0 +1,258 @@@ +package Moose::Exporter; + +use strict; +use warnings; + +use Class::MOP; +use namespace::clean 0.08 (); +use Sub::Exporter; + + ++# This variable gets closed over in each export _generator_. Then in ++# the generator we grab the value and close over it _again_ in the ++# real export, so it gets captured each time the generator runs. ++# ++# In the meantime, we arrange for the import method we generate to set ++# this variable to the caller each time it is called. ++# ++# This is all a bit confusing, but it works. ++my $CALLER; ++ +my %EXPORT_SPEC; + +sub build_import_methods { + my $class = shift; + my %args = @_; + + my $exporting_package = caller(); + + $EXPORT_SPEC{$exporting_package} = \%args; + - my ( $exporter, $exported ) = $class->_build_exporter( ++ my $exports = $class->_process_exports( + exporting_package => $exporting_package, - %args ++ %args, ++ ); ++ ++ my $exporter = Sub::Exporter::build_exporter( ++ { ++ exports => $exports, ++ groups => { default => [':all'] } ++ } + ); + + my $import = $class->_make_import_sub( - $exporting_package, $args{init_meta_args}, - $exporter ++ $exporter, ++ $args{init_meta_args}, + ); + - my $unimport = $class->_make_unimport_sub($exported); ++ my $unimport = $class->_make_unimport_sub( [ keys %{$exports} ] ); + + no strict 'refs'; + *{ $exporting_package . '::import' } = $import; + *{ $exporting_package . '::unimport' } = $unimport; +} + - my %EXPORTED; - sub _build_exporter { ++sub _process_exports { + my $class = shift; + my %args = @_; + + my $exporting_package = $args{exporting_package}; + - my @exported_names; + my %exports; + for my $name ( @{ $args{with_caller} } ) { + my $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } }; + + # We need to set the package at import time, so that when + # package Foo imports has(), we capture "Foo" as the + # package. This lets other packages call Foo::has() and get + # the right package. This is done for backwards compatibility + # with existing production code, not because this is a good + # idea ;) + $exports{$name} = sub { - my $caller; - - my $x = 0; - do - { - $caller = scalar caller($x++) - } - while ( $caller eq 'Sub::Exporter' ); - ++ my $caller = $CALLER; + Class::MOP::subname( $exporting_package . '::' + . $name => sub { $sub->( $caller, @_ ) } ); + }; - - push @exported_names, $name; + } + + for my $name ( @{ $args{as_is} } ) { + my $sub; + + if ( ref $name ) { + $sub = $name; + $name = ( Class::MOP::get_code_info($name) )[1]; + } + else { + $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } }; - - push @exported_names, $name; + } + + $exports{$name} = sub { $sub }; + } + - my $exporter = Sub::Exporter::build_exporter( - { - exports => \%exports, - groups => { default => [':all'] } - } - ); - - return $exporter, \@exported_names; ++ return \%exports; +} + +sub _make_import_sub { + my $class = shift; - my $exporting_package = shift; - my $init_meta_args = shift; + my $exporter = shift; ++ my $init_meta_args = shift; + + return sub { - my $caller = Moose::Exporter->_get_caller(@_); ++ # It's important to leave @_ as-is for the benefit of ++ # Sub::Exporter. ++ my $class = $_[0]; ++ ++ $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' ) { ++ if ( $CALLER eq 'main' ) { + warn - qq{$exporting_package does not export its sugar to the 'main' package.\n}; ++ qq{$class does not export its sugar to the 'main' package.\n}; + return; + } + - if ( $exporting_package->can('_init_meta') ) { - $exporting_package->_init_meta( - for_class => $caller, ++ if ( $class->can('_init_meta') ) { ++ $class->_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] 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; + +__END__ + +=head1 NAME + +Moose::Exporter - make an import() and unimport() just like Moose.pm + +=head1 SYNOPSIS + + package MyApp::Moose; + + use strict; + use warnings; + + use Moose (); + use Moose::Exporter; + + Moose::Exporter->build_export_methods( + export => [ 'sugar1', 'sugar2', \&Some::Random::thing ], + init_meta_args => { metaclass_class => 'MyApp::Meta::Class' ], + ); + + # then later ... + package MyApp::User; + + use MyApp::Moose; + + has 'name'; + sugar1 'do your thing'; + thing; + + no MyApp::Moose; + +=head1 DESCRIPTION + +This module encapsulates the logic to export sugar functions like +C. It does this by building custom C and C +methods for your module, based on a spec your provide. + +It also lets your "stack" Moose-alike modules so you can export +Moose's sugar as well as your own, along with sugar from any random +C module, as long as they all use C. + +=head1 METHODS + +This module provides exactly one public method: + +=head2 Moose::Exporter->build_import_methods(...) + +When you call this method, C build custom C +and C methods for your module. The import method will export +the functions you specify, and you can also tell it to export +functions exported by some other module (like C). + +The C method cleans the callers namespace of all the +exported functions. + +This method accepts the following parameters: + +=over 4 + +=item * with_caller => [ ... ] + +This a list of function I to be exported wrapped and then +exported. The wrapper will pass the name of the calling package as the +first argument to the function. Many sugar functions need to know +their caller so they can get the calling package's metaclass object. + +=item * as_is => [ ... ] + +This a list of function names or sub references to be exported +as-is. You can identify a subroutine by reference, which is handy to +re-export some other module's functions directly by reference +(C<\&Some::Package::function>). + +=item * init_meta_args + +... + +=back + +=head1 AUTHOR + +Dave Rolsky Eautarch@urth.orgE + +This is largely a reworking of code in Moose.pm originally written by +Stevan Little and others. + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut