X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=15e81695f30371d00cbb726cf494bce3883eb530;hb=75d2da3428d70afc00efb0f295fd0656a05d6b9f;hp=b05fc7762c35d22aac59ea710b066a51799db9be;hpb=6daad0b9b4d1188e06c36d67968af3ee6eb07d83;p=gitmo%2FMoose.git diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index b05fc77..15e8169 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -3,11 +3,15 @@ package Moose::Exporter; use strict; use warnings; +our $VERSION = '0.77'; +$VERSION = eval $VERSION; +our $AUTHORITY = 'cpan:STEVAN'; + use Class::MOP; use List::MoreUtils qw( first_index uniq ); use Moose::Util::MetaRole; use Sub::Exporter; - +use Sub::Name qw(subname); my %EXPORT_SPEC; @@ -36,7 +40,7 @@ sub build_import_methods { my ( $exports, $is_removable ) = $class->_make_sub_exporter_params( - [ $exporting_package, @exports_from ], $export_recorder ); + [ @exports_from, $exporting_package ], $export_recorder ); my $exporter = Sub::Exporter::build_exporter( { @@ -161,103 +165,123 @@ sub _make_sub_exporter_params { return ( \%exports, \%is_removable ); } -{ - # 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; - - sub _make_wrapped_sub { - shift; - my $fq_name = shift; - my $sub = shift; - my $export_recorder = shift; - - - # 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 ;) - return sub { - my $caller = $CALLER; - - my $sub = Class::MOP::subname( $fq_name => sub { $sub->( $caller, @_ ) } ); +our $CALLER; - $export_recorder->{$sub} = 1; +sub _make_wrapped_sub { + my $self = shift; + my $fq_name = shift; + my $sub = shift; + my $export_recorder = shift; - return $sub; - }; - } + # 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 ;) + return sub { + my $caller = $CALLER; - sub _make_import_sub { - shift; - my $exporting_package = shift; - my $exporter = shift; - my $exports_from = shift; - my $export_to_main = shift; - - return sub { - # I think we could use Sub::Exporter's collector feature - # to do this, but that would be rather gross, since that - # feature isn't really designed to return a value to the - # caller of the exporter sub. - # - # Also, this makes sure we preserve backwards compat for - # _get_caller, so it always sees the arguments in the - # expected order. - my $traits; - ($traits, @_) = Moose::Exporter::_strip_traits(@_); - - # Normally we could look at $_[0], but in some weird cases - # (involving goto &Moose::import), $_[0] ends as something - # else (like Squirrel). - my $class = $exporting_package; - - $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' && ! $export_to_main ) { - warn - qq{$class does not export its sugar to the 'main' package.\n}; - return; - } + my $wrapper = $self->_make_wrapper($caller, $sub, $fq_name); - my $did_init_meta; - for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) { + my $sub = subname($fq_name => $wrapper); - $c->init_meta( for_class => $CALLER ); - $did_init_meta = 1; - } + $export_recorder->{$sub} = 1; - if ( $did_init_meta && @{$traits} ) { - _apply_meta_traits( $CALLER, $traits ); - } - elsif ( @{$traits} ) { - Moose->throw_error("Cannot provide traits when $class does not have an init_meta() method"); - } + return $sub; + }; +} - goto $exporter; - }; +sub _make_wrapper { + my $class = shift; + my $caller = shift; + my $sub = shift; + my $fq_name = shift; + + my $wrapper = sub { $sub->($caller, @_) }; + if (my $proto = prototype $sub) { + # XXX - Perl's prototype sucks. Use & to make set_prototype + # ignore the fact that we're passing a "provate variable" + &Scalar::Util::set_prototype($wrapper, $proto); } + return $wrapper; +} + +sub _make_import_sub { + shift; + my $exporting_package = shift; + my $exporter = shift; + my $exports_from = shift; + my $export_to_main = shift; + + return sub { + + # I think we could use Sub::Exporter's collector feature + # to do this, but that would be rather gross, since that + # feature isn't really designed to return a value to the + # caller of the exporter sub. + # + # Also, this makes sure we preserve backwards compat for + # _get_caller, so it always sees the arguments in the + # expected order. + my $traits; + ( $traits, @_ ) = _strip_traits(@_); + + my $metaclass; + ( $metaclass, @_ ) = _strip_metaclass(@_); + + # Normally we could look at $_[0], but in some weird cases + # (involving goto &Moose::import), $_[0] ends as something + # else (like Squirrel). + my $class = $exporting_package; + + $CALLER = _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' && !$export_to_main ) { + warn + qq{$class does not export its sugar to the 'main' package.\n}; + return; + } + + my $did_init_meta; + for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) { + # init_meta can apply a role, which when loaded uses + # Moose::Exporter, which in turn sets $CALLER, so we need + # to protect against that. + local $CALLER = $CALLER; + $c->init_meta( for_class => $CALLER, metaclass => $metaclass ); + $did_init_meta = 1; + } + + if ( $did_init_meta && @{$traits} ) { + # The traits will use Moose::Role, which in turn uses + # Moose::Exporter, which in turn sets $CALLER, so we need + # to protect against that. + local $CALLER = $CALLER; + _apply_meta_traits( $CALLER, $traits ); + } + elsif ( @{$traits} ) { + require Moose; + Moose->throw_error( + "Cannot provide traits when $class does not have an init_meta() method" + ); + } + + goto $exporter; + }; } + sub _strip_traits { my $idx = first_index { $_ eq '-traits' } @_; @@ -272,12 +296,24 @@ sub _strip_traits { return ( $traits, @_ ); } +sub _strip_metaclass { + my $idx = first_index { $_ eq '-metaclass' } @_; + + return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1; + + my $metaclass = $_[ $idx + 1 ]; + + splice @_, $idx, 2; + + return ( $metaclass, @_ ); +} + sub _apply_meta_traits { my ( $class, $traits ) = @_; return unless @{$traits}; - my $meta = $class->meta(); + my $meta = Class::MOP::class_of($class); my $type = ( split /::/, ref $meta )[-1] or Moose->throw_error( @@ -407,7 +443,9 @@ C module, as long as they all use C. This module provides two public methods: -=head2 Moose::Exporter->setup_import_methods(...) +=over 4 + +=item B<< Moose::Exporter->setup_import_methods(...) >> When you call this method, C build custom C and C methods for your module. The import method will export @@ -419,7 +457,7 @@ exported functions. This method accepts the following parameters: -=over 4 +=over 8 =item * with_caller => [ ... ] @@ -445,18 +483,23 @@ themselves, and therefore wants to keep it. This is a list of modules which contain functions that the caller wants to export. These modules must also use C. The most common use case will be to export the functions from C. +Functions specified by C or C take precedence over +functions exported by modules specified by C, so that a module +can selectively override functions exported by another module. C also makes sure all these functions get removed when C is called. =back -=head2 Moose::Exporter->build_import_methods(...) +=item B<< Moose::Exporter->build_import_methods(...) >> Returns two code refs, one for import and one for unimport. Used by C. +=back + =head1 IMPORTING AND init_meta If you want to set an alternative base object class or metaclass @@ -496,7 +539,7 @@ Stevan Little and others. =head1 COPYRIGHT AND LICENSE -Copyright 2008 by Infinity Interactive, Inc. +Copyright 2009 by Infinity Interactive, Inc. L