my $export_recorder = {};
- my ( $exports, $is_removable, $groups )
+ my ( $exports, $is_removable )
= $class->_make_sub_exporter_params(
[ @exports_from, $exporting_package ], $export_recorder );
my $exporter = Sub::Exporter::build_exporter(
{
exports => $exports,
- groups => { default => [':all'], %$groups }
+ groups => { default => [':all'] }
}
);
my $packages = shift;
my $export_recorder = shift;
- my %groups;
my %exports;
my %is_removable;
my $args = $EXPORT_SPEC{$package}
or die "The $package package does not use Moose::Exporter\n";
- # one group for each 'also' package
- $groups{$package} = [
- @{ $args->{with_caller} || [] },
- @{ $args->{with_meta} || [] },
- @{ $args->{as_is} || [] },
- map ":$_",
- keys %{ $args->{groups} || {} }
- ];
-
- for my $name ( @{ $args->{with_caller} } ) {
+ for my $name ( @{ $args->{with_meta} } ) {
my $sub = do {
no strict 'refs';
\&{ $package . '::' . $name };
};
+ if ( !defined(&$sub) ) {
+ Carp::cluck
+ "Trying to export undefined sub ${package}::${name}";
+ next;
+ }
+
my $fq_name = $package . '::' . $name;
- $exports{$name} = $class->_make_wrapped_sub(
+ $exports{$name} = $class->_make_wrapped_sub_with_meta(
$fq_name,
$sub,
$export_recorder,
$is_removable{$name} = 1;
}
- for my $name ( @{ $args->{with_meta} } ) {
+ for my $name ( @{ $args->{with_caller} } ) {
my $sub = do {
no strict 'refs';
\&{ $package . '::' . $name };
};
+ if ( !defined(&$sub) ) {
+ Carp::cluck
+ "Trying to export undefined sub ${package}::${name}";
+ next;
+ }
+
my $fq_name = $package . '::' . $name;
- $exports{$name} = $class->_make_wrapped_sub_with_meta(
+ $exports{$name} = $class->_make_wrapped_sub(
$fq_name,
$sub,
$export_recorder,
}
for my $name ( @{ $args->{as_is} } ) {
- my $sub;
+ my ($sub, $coderef_name);
if ( ref $name ) {
$sub = $name;
# really want to keep these subs or not, we err on the
# safe side and leave them in.
my $coderef_pkg;
- ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
+ ( $coderef_pkg, $coderef_name )
+ = Class::MOP::get_code_info($name);
- $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
+ $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
}
else {
$sub = do {
\&{ $package . '::' . $name };
};
+ if ( !defined(&$sub) ) {
+ Carp::cluck
+ "Trying to export undefined sub ${package}::${name}";
+ next;
+ }
+
$is_removable{$name} = 1;
+ $coderef_name = $name;
}
$export_recorder->{$sub} = 1;
- $exports{$name} = sub {$sub};
+ $exports{$coderef_name} = sub {$sub};
}
-
- for my $name ( keys %{ $args->{groups} } ) {
- my $group = $args->{groups}{$name};
-
- if (ref $group eq 'CODE') {
- $groups{$name} = $class->_make_wrapped_group(
- $package,
- $group,
- $export_recorder,
- \%exports,
- \%is_removable
- );
- }
- elsif (ref $group eq 'ARRAY') {
- $groups{$name} = $group;
- }
- }
}
- return ( \%exports, \%is_removable, \%groups );
+ return ( \%exports, \%is_removable );
}
our $CALLER;
use Moose::Exporter;
Moose::Exporter->setup_import_methods(
- with_caller => [ 'has_rw', 'sugar2' ],
- as_is => [ 'sugar3', \&Some::Random::thing ],
- also => 'Moose',
+ with_meta => [ 'has_rw', 'sugar2' ],
+ as_is => [ 'sugar3', \&Some::Random::thing ],
+ also => 'Moose',
);
sub has_rw {
- my ($caller, $name, %options) = @_;
- Class::MOP::class_of($caller)->add_attribute($name,
+ my ( $meta, $name, %options ) = @_;
+ $meta->add_attribute(
+ $name,
is => 'rw',
%options,
);
=over 8
- =item * with_caller => [ ... ]
+ =item * with_meta => [ ... ]
This list of function I<names only> will be 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.
+ wrapper will pass the metaclass object for the caller as its first argument.
+
+ Many sugar functions will need to use this metaclass object to do something to
+ the calling package.
=item * as_is => [ ... ]
This is a list of modules which contain functions that the caller
wants to export. These modules must also use C<Moose::Exporter>. The
most common use case will be to export the functions from C<Moose.pm>.
- Functions specified by C<with_caller> or C<as_is> take precedence over
+ Functions specified by C<with_meta> or C<as_is> take precedence over
functions exported by modules specified by C<also>, so that a module
can selectively override functions exported by another module.
use Test::Exception;
{
+
package ExGroups1;
use Moose::Exporter;
use Moose ();
with_meta => ['with_meta1'],
with_caller => ['default_export1'],
as_is => ['default_export2'],
- groups => { all_group => [':all'],
- just_one => ['default_export1'] }
+ groups => {
+ all_group => [':all'],
+ just_one => ['default_export1']
+ }
);
- sub default_export1 { 1 }
- sub default_export2 { 2 }
+ sub default_export1 {1}
+ sub default_export2 {2}
sub with_meta1 (&) {
- my ($meta, $code) = @_;
+ my ( $meta, $code ) = @_;
return $meta;
}
}
{
+
package UseAllGroup;
-
+
ExGroups1->import(':all_group');
::can_ok( __PACKAGE__, 'with_meta1' );
my $meta;
eval q/$meta = with_meta1 { return 'coderef'; }/;
- ::is($@, '', 'calling with_meta1 with prototype is not an error');
+ ::is( $@, '', 'calling with_meta1 with prototype is not an error' );
::isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
- ::is( prototype( __PACKAGE__->can('with_meta1') ),
- prototype( ExGroups1->can('with_meta1') ),
- 'using correct prototype on with_meta function' );
+ ::is(
+ prototype( __PACKAGE__->can('with_meta1') ),
+ prototype( ExGroups1->can('with_meta1') ),
+ 'using correct prototype on with_meta function'
+ );
ExGroups1->unimport();
- ::ok( ! __PACKAGE__->can('with_meta1'), __PACKAGE__.'::with_meta1() has been cleaned' );
- ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
- ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() has been cleaned' );
- ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+ ::ok( !__PACKAGE__->can('with_meta1'),
+ __PACKAGE__ . '::with_meta1() has been cleaned' );
+ ::ok( !__PACKAGE__->can('default_export1'),
+ __PACKAGE__ . '::default_export1() has been cleaned' );
+ ::ok( !__PACKAGE__->can('default_export2'),
+ __PACKAGE__ . '::default_export2() has been cleaned' );
+ ::ok( !__PACKAGE__->can('has'),
+ __PACKAGE__ . '::has() has been cleaned' );
}
{
+
package UseJustOne;
ExGroups1->import(':just_one');
::can_ok( __PACKAGE__, 'default_export1' );
- ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() was not imported' );
- ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() was not imported' );
+ ::ok( !__PACKAGE__->can('default_export2'),
+ __PACKAGE__ . '::default_export2() was not imported' );
+ ::ok( !__PACKAGE__->can('has'),
+ __PACKAGE__ . '::has() was not imported' );
ExGroups1->unimport();
- ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleared' );
+ ::ok( !__PACKAGE__->can('default_export1'),
+ __PACKAGE__ . '::default_export1() has been cleared' );
}
{
+
package ExGroups2;
use Moose::Exporter;
-
+
Moose::Exporter->setup_import_methods(
also => ['ExGroups1'],
as_is => ['exgroups2_as_is'],
with_caller => ['exgroups2_with_caller'],
- groups => { default => ['exgroups2_as_is'],
- code_group => \&generate_group,
- parent1 => [qw(:ExGroups1 :code_group)],
- parent2 => [qw(:all)] }
+ groups => {
+ default => ['exgroups2_as_is'],
+ code_group => \&generate_group,
+ parent1 => [qw(:ExGroups1 :code_group)],
+ parent2 => [qw(:all)]
+ }
);
- sub exgroups2_as_is { 3 }
+ sub exgroups2_as_is {3}
+ sub exgroups2_with_caller { 4 }
+
sub generate_group {
- my ($caller, $group_name, $args, $context) = @_;
+ my ( $caller, $group_name, $args, $context ) = @_;
- ::is($group_name, 'code_group', 'original name is passed to group code');
- ::is($args->{install_as}, $caller . '_code', 'group code arguments match caller');
- ::is($context->{from}, __PACKAGE__, 'defined package name is passed to group code');
+ ::is( $group_name, 'code_group',
+ 'original name is passed to group code' );
+ ::is( $args->{install_as}, $caller . '_code',
+ 'group code arguments match caller' );
+ ::is( $context->{from}, __PACKAGE__,
+ 'defined package name is passed to group code' );
return { $args->{install_as} => \&exported_by_group };
}
sub exported_by_group (&) {
- my ($caller, $coderef) = @_;
+ my ( $caller, $coderef ) = @_;
return $caller;
}
}
{
+
package UseDefault;
-
+
ExGroups2->import;
::can_ok( __PACKAGE__, 'exgroups2_as_is' );
- ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), '"default" group is no longer "all"' );
+ ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
+ '"default" group is no longer "all"' );
}
{
+
package UseCodeGroup;
- ExGroups2->import(':code_group', { install_as => (my $export_name = __PACKAGE__.'_code') });
+ ExGroups2->import( ':code_group',
+ { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
::can_ok( __PACKAGE__, $export_name );
- ::ok( &UseCodeGroup_code() eq __PACKAGE__, 'code group exports act like "with_caller" subs' );
- ::lives_ok(sub { UseCodeCodeGroup_code { return 'code block'; } }, 'code group exports keep their prototypes');
+ ::ok( &UseCodeGroup_code() eq __PACKAGE__,
+ 'code group exports act like "with_caller" subs' );
+ ::lives_ok(
+ sub {
+ UseCodeCodeGroup_code { return 'code block'; };
+ },
+ 'code group exports keep their prototypes'
+ );
- ::ok( ! __PACKAGE__->can('exgroups2_as_is'), 'code group will not automatically export any symbols' );
+ ::ok( !__PACKAGE__->can('exgroups2_as_is'),
+ 'code group will not automatically export any symbols' );
ExGroups2->unimport;
-
- ::ok( ! __PACKAGE__->can($export_name),
- 'dynamically-named '. __PACKAGE__."::$export_name() has been cleared" );
+
+ ::ok(
+ !__PACKAGE__->can($export_name),
+ 'dynamically-named '
+ . __PACKAGE__
+ . "::$export_name() has been cleared"
+ );
}
{
+
package UseParent1;
- ExGroups2->import(':parent1', { install_as => (my $export_name = __PACKAGE__.'_code') });
+ ExGroups2->import( ':parent1',
+ { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
::can_ok( __PACKAGE__, $export_name );
::can_ok( __PACKAGE__, 'default_export1' );
ExGroups2->unimport;
- ::ok( ! __PACKAGE__->can($export_name), __PACKAGE__."::$export_name() has been cleared" );
- ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
- ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() has been cleaned' );
- ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+ ::ok( !__PACKAGE__->can($export_name),
+ __PACKAGE__ . "::$export_name() has been cleared" );
+ ::ok( !__PACKAGE__->can('default_export1'),
+ __PACKAGE__ . '::default_export1() has been cleaned' );
+ ::ok( !__PACKAGE__->can('default_export2'),
+ __PACKAGE__ . '::default_export2() has been cleaned' );
+ ::ok( !__PACKAGE__->can('has'),
+ __PACKAGE__ . '::has() has been cleaned' );
}
{
+
package UseParent2;
- ExGroups2->import(':parent2', { install_as => (my $export_name = __PACKAGE__.'_code') });
+ ExGroups2->import( ':parent2',
+ { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
- ::ok( ! __PACKAGE__->can($export_name), '"all" group will not call code groups' );
+ ::ok( !__PACKAGE__->can($export_name),
+ '"all" group will not call code groups' );
::can_ok( __PACKAGE__, 'exgroups2_as_is' );
::can_ok( __PACKAGE__, 'exgroups2_with_caller' );
::can_ok( __PACKAGE__, 'default_export1' );
ExGroups2->unimport;
- ::ok( ! __PACKAGE__->can('exgroups2_as_is'), __PACKAGE__.'::exgroups2_as_is() has been cleaned' );
- ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), __PACKAGE__.'::exgroups2_with_caller() has been cleaned' );
- ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
- ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+ ::ok( !__PACKAGE__->can('exgroups2_as_is'),
+ __PACKAGE__ . '::exgroups2_as_is() has been cleaned' );
+ ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
+ __PACKAGE__ . '::exgroups2_with_caller() has been cleaned' );
+ ::ok( !__PACKAGE__->can('default_export1'),
+ __PACKAGE__ . '::default_export1() has been cleaned' );
+ ::ok( !__PACKAGE__->can('has'),
+ __PACKAGE__ . '::has() has been cleaned' );
}
BEGIN {
eval "use Test::Output;";
plan skip_all => "Test::Output is required for this test" if $@;
- plan tests => 49;
- plan tests => 63;
++ plan tests => 65;
}
use Moose ();
sub wrapped1 {
- my $caller = shift;
- return $caller . ' called wrapped1';
+ my $meta = shift;
+ return $meta->name . ' called wrapped1';
}
Moose::Exporter->setup_import_methods(
- with_caller => ['wrapped1'],
- also => 'Moose',
+ with_meta => ['wrapped1'],
+ also => 'Moose',
);
}
}
{
+ package NonExistentExport;
+
+ use Moose ();
+
+ ::stderr_like {
+ Moose::Exporter->setup_import_methods(
+ also => ['Moose'],
+ with_caller => ['does_not_exist'],
+ );
+ } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/,
+ "warns when a non-existent method is requested to be exported";
+}
+
+{
+ package WantsNonExistentExport;
+
+ NonExistentExport->import;
+
+ ::ok(!__PACKAGE__->can('does_not_exist'),
+ "undefined subs do not get exported");
++
+ package AllOptions;
+ use Moose ();
+ use Moose::Exporter;
+
+ Moose::Exporter->setup_import_methods(
+ also => ['Moose'],
+ with_meta => [ 'with_meta1', 'with_meta2' ],
+ with_caller => [ 'with_caller1', 'with_caller2' ],
+ as_is => ['as_is1'],
+ );
+
+ sub with_caller1 {
+ return @_;
+ }
+
+ sub with_caller2 (&) {
+ return @_;
+ }
+
+ sub as_is1 {2}
+
+ sub with_meta1 {
+ return @_;
+ }
+
+ sub with_meta2 (&) {
+ return @_;
+ }
+ }
+
+ {
+ package UseAllOptions;
+
+ AllOptions->import();
+ }
+
+ {
+ can_ok( 'UseAllOptions', $_ )
+ for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
+
+ {
+ my ( $caller, $arg1 ) = UseAllOptions::with_caller1(42);
+ is( $caller, 'UseAllOptions', 'with_caller wrapped sub gets the right caller' );
+ is( $arg1, 42, 'with_caller wrapped sub returns argument it was passed' );
+ }
+
+ {
+ my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
+ isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
+ is( $arg1, 42, 'with_meta1 returns argument it was passed' );
+ }
+
+ is(
+ prototype( UseAllOptions->can('with_caller2') ),
+ prototype( AllOptions->can('with_caller2') ),
+ 'using correct prototype on with_meta function'
+ );
+
+ is(
+ prototype( UseAllOptions->can('with_meta2') ),
+ prototype( AllOptions->can('with_meta2') ),
+ 'using correct prototype on with_meta function'
+ );
+
+ {
+ package UseAllOptions;
+ AllOptions->unimport();
+ }
+
+ ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
+ for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
}
projects / gitmo/Moose.git / commitdiff