From: Dave Rolsky Date: Thu, 7 Aug 2008 15:50:55 +0000 (+0000) Subject: Added the "also" param to Moose::Exporter, which allows you to say you X-Git-Tag: 0_55_01~43^2~18 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4403da902109164d2674c1169055c369500080ec;p=gitmo%2FMoose.git Added the "also" param to Moose::Exporter, which allows you to say you want to export what some other package(s) are exporting. Wrote a bunch of tests for this. Renamed the old extending & embedding test to indicate that it's just for back compat now. --- diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index a6eb924..c49bc0b 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -5,6 +5,7 @@ use warnings; use Class::MOP; use namespace::clean 0.08 (); +use List::MoreUtils qw( uniq ); use Sub::Exporter; @@ -18,10 +19,10 @@ sub build_import_methods { $EXPORT_SPEC{$exporting_package} = \%args; - my $exports = $class->_process_exports( - exporting_package => $exporting_package, - %args, - ); + my @exports_from = $class->_follow_also( $exporting_package ); + + my $exports + = $class->_process_exports( $exporting_package, @exports_from ); my $exporter = Sub::Exporter::build_exporter( { @@ -42,36 +43,81 @@ sub build_import_methods { *{ $exporting_package . '::unimport' } = $unimport; } -sub _process_exports { - my $class = shift; - my %args = @_; +{ + my %seen; - my $exporting_package = $args{exporting_package}; + sub _follow_also { + my $class = shift; + my $exporting_package = shift; - my %exports; - for my $name ( @{ $args{with_caller} } ) { - my $sub - = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } }; + %seen = ( $exporting_package => 1 ); - $exports{$name} - = $class->_make_wrapped_sub( $exporting_package, $name, $sub ); + return uniq( _follow_also_real($exporting_package) ); } - for my $name ( @{ $args{as_is} } ) { - my $sub; + sub _follow_also_real { + my $exporting_package = shift; + + die "Package in also ($exporting_package) does not seem to use MooseX::Exporter" + unless exists $EXPORT_SPEC{$exporting_package}; + + my $also = $EXPORT_SPEC{$exporting_package}{also}; + + return unless defined $also; + + my @also = ref $also ? @{$also} : $also; + + for my $package (@also) + { + die "Circular reference in also parameter to MooseX::Exporter between $exporting_package and $package" + if $seen{$package}; - if ( ref $name ) { - $sub = $name; - $name = ( Class::MOP::get_code_info($name) )[1]; + $seen{$package} = 1; } - else { - $sub = do { + + return @also, map { _follow_also_real($_) } @also; + } +} + +sub _process_exports { + my $class = shift; + my @packages = @_; + + my %exports; + + for my $package (@packages) { + my $args = $EXPORT_SPEC{$package} + or die "The $package package does not use Moose::Exporter\n"; + + for my $name ( @{ $args->{with_caller} } ) { + my $sub = do { no strict 'refs'; - \&{ $exporting_package . '::' . $name }; + \&{ $package . '::' . $name }; }; + + $exports{$name} = $class->_make_wrapped_sub( + $package, + $name, + $sub + ); } - $exports{$name} = sub {$sub}; + 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'; + \&{ $package . '::' . $name }; + }; + } + + $exports{$name} = sub {$sub}; + } } return \%exports; diff --git a/t/050_metaclasses/010_extending_and_embedding.t b/t/050_metaclasses/010_extending_and_embedding_back_compat.t similarity index 100% rename from t/050_metaclasses/010_extending_and_embedding.t rename to t/050_metaclasses/010_extending_and_embedding_back_compat.t diff --git a/t/050_metaclasses/012_moose_exporter.t b/t/050_metaclasses/012_moose_exporter.t new file mode 100644 index 0000000..efeb1d6 --- /dev/null +++ b/t/050_metaclasses/012_moose_exporter.t @@ -0,0 +1,182 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More 'no_plan'; +use Test::Exception; + +# All the BEGIN blocks are necessary to emulate the behavior of +# loading modules via use and the similar compile-time effect of "no +# ..." +{ + package MooseX::Empty; + + use Moose (); + BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); } +} + +{ + package WantsMoose; + + BEGIN { MooseX::Empty->import(); } + + sub foo { 1 } + + BEGIN { + ::can_ok( 'WantsMoose', 'has' ); + ::can_ok( 'WantsMoose', 'with' ); + ::can_ok( 'WantsMoose', 'foo' ); + } + + BEGIN{ MooseX::Empty->unimport();} +} + +{ + ok( ! WantsMoose->can('has'), 'WantsMoose::has() has been cleaned' ); + ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' ); + can_ok( 'WantsMoose', 'foo' ); +} + +{ + package MooseX::Sugar; + + use Moose (); + + sub wrapped1 { + my $caller = shift; + return $caller . ' called wrapped1'; + } + + BEGIN { + Moose::Exporter->build_import_methods( + with_caller => ['wrapped1'], + also => 'Moose', + ); + } +} + +{ + package WantsSugar; + + BEGIN { MooseX::Sugar->import() } + + sub foo { 1 } + + BEGIN { + ::can_ok( 'WantsSugar', 'has' ); + ::can_ok( 'WantsSugar', 'with' ); + ::can_ok( 'WantsSugar', 'wrapped1' ); + ::can_ok( 'WantsSugar', 'foo' ); + ::is( wrapped1(), 'WantsSugar called wrapped1', + 'wrapped1 identifies the caller correctly' ); + } + + BEGIN{ MooseX::Sugar->unimport();} +} + +{ + ok( ! WantsSugar->can('has'), 'WantsSugar::has() has been cleaned' ); + ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' ); + ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' ); + can_ok( 'WantsSugar', 'foo' ); +} + +{ + package MooseX::MoreSugar; + + use Moose (); + + sub wrapped2 { + my $caller = shift; + return $caller . ' called wrapped2'; + } + + sub as_is1 { + return 'as_is1'; + } + + BEGIN { + Moose::Exporter->build_import_methods( + with_caller => ['wrapped2'], + as_is => ['as_is1'], + also => 'MooseX::Sugar', + ); + } +} + +{ + package WantsMoreSugar; + + BEGIN { MooseX::MoreSugar->import() } + + sub foo { 1 } + + BEGIN { + ::can_ok( 'WantsMoreSugar', 'has' ); + ::can_ok( 'WantsMoreSugar', 'with' ); + ::can_ok( 'WantsMoreSugar', 'wrapped1' ); + ::can_ok( 'WantsMoreSugar', 'wrapped2' ); + ::can_ok( 'WantsMoreSugar', 'as_is1' ); + ::can_ok( 'WantsMoreSugar', 'foo' ); + ::is( wrapped1(), 'WantsMoreSugar called wrapped1', + 'wrapped1 identifies the caller correctly' ); + ::is( wrapped2(), 'WantsMoreSugar called wrapped2', + 'wrapped2 identifies the caller correctly' ); + ::is( as_is1(), 'as_is1', + 'as_is1 works as expected' ); + } + + BEGIN{ MooseX::MoreSugar->unimport();} +} + +{ + ok( ! WantsMoreSugar->can('has'), 'WantsMoreSugar::has() has been cleaned' ); + ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' ); + ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' ); + ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' ); + ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' ); + can_ok( 'WantsMoreSugar', 'foo' ); +} + +{ + package MooseX::CircularAlso; + + use Moose (); + + ::dies_ok( + sub { + Moose::Exporter->build_import_methods( + also => [ 'Moose', 'MooseX::CircularAlso' ], + ); + }, + 'a circular reference in also dies with an error' + ); + + ::like( + $@, + qr/\QCircular reference in also parameter to MooseX::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/, + 'got the expected error from circular reference in also' + ); +} + +{ + package MooseX::CircularAlso; + + use Moose (); + + ::dies_ok( + sub { + Moose::Exporter->build_import_methods( + also => [ 'NoSuchThing' ], + ); + }, + 'a package which does not use Moose::Exporter in also dies with an error' + ); + + ::like( + $@, + qr/\QPackage in also (NoSuchThing) does not seem to use MooseX::Exporter/, + 'got the expected error from a reference in also to a package which does not use Moose::Exporter' + ); +}