\&Carp::confess,
\&Scalar::Util::blessed,
],
- also => sub { init_meta( shift, 'Moose::Object' ); },
);
-# NOTE:
-# This is for special use by
-# some modules and stuff, I
-# dont know if it is sane enough
-# to document actually.
-# - SL
-sub __CURRY_EXPORTS_FOR_CLASS__ {
- my $caller = shift;
- ($caller ne 'Moose')
- || croak "_import_into must be called a function, not a method";
- ($caller->can('meta') && $caller->meta->isa('Class::MOP::Class'))
- || croak "Cannot call _import_into on a package ($caller) without a metaclass";
-# return map { $_ => $exports{$_}->() } (@_ ? @_ : keys %exports);
-}
-
+# This exists for backwards compat
sub init_meta {
my ( $class, $base_class, $metaclass ) = @_;
- $base_class = 'Moose::Object' unless defined $base_class;
- $metaclass = 'Moose::Meta::Class' unless defined $metaclass;
+
+ __PACKAGE__->_init_meta( for_class => $class,
+ object_base_class => $base_class,
+ metaclass_class => $metaclass,
+ );
+}
+
+sub _init_meta {
+ shift;
+ my %args = @_;
+
+ my $class = $args{for_class}
+ or confess "Cannot call _init_meta without specifying a for_class";
+ my $base_class = $args{object_base_class} || 'Moose::Object';
+ my $metaclass = $args{metaclass_class} || 'Moose::Meta::Class';
confess
"The Metaclass $metaclass must be a subclass of Moose::Meta::Class."
use warnings;
use Class::MOP;
+use namespace::clean ();
use Sub::Exporter;
: caller($offset);
}
+my %EXPORT_SPEC;
sub build_import_methods {
my $class = shift;
my %args = @_;
my $exporting_package = caller();
- my $exporter = $class->_build_exporter( exporting_package => $exporting_package, %args );
+ $EXPORT_SPEC{$exporting_package} = \%args;
- my $also = $args{also};
+ my ( $exporter, $exported )
+ = $class->_build_exporter( exporting_package => $exporting_package,
+ %args );
my $import = sub {
my $caller = Moose::Exporter->get_caller(@_);
return;
}
- $also->($caller) if $also;
+ if ( $exporting_package->can('_init_meta') ) {
+ $exporting_package->_init_meta(
+ for_class => $caller,
+ %{ $args{init_meta_args} || {} }
+ );
+ }
goto $exporter;
};
+ # [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 {
- my $caller = Moose::Exporter->get_caller(@_);
+ @_ = ( 'namespace::clean', @{ $exported } );
- Moose::Exporter->remove_keywords(
- source => $exporting_package,
- from => $caller,
- );
+ goto &namespace::clean::import;
};
no strict 'refs';
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 } };
$exports{$name} = sub { $wrapped };
- push @{ $EXPORTED{$exporting_package} }, $name;
+ push @exported_names, $name;
}
for my $name ( @{ $args{as_is} } ) {
else {
$sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
- push @{ $EXPORTED{$exporting_package} }, $name;
+ push @exported_names, $name;
}
$exports{$name} = sub { $sub };
}
- return Sub::Exporter::build_exporter(
+ my $exporter = Sub::Exporter::build_exporter(
{
exports => \%exports,
groups => { default => [':all'] }
}
);
-}
-
-sub remove_keywords {
- my $class = shift;
- my %args = @_;
- no strict 'refs';
-
- for my $name ( @{ $EXPORTED{ $args{source} } } ) {
- if ( defined &{ $args{from} . '::' . $name } ) {
- my $keyword = \&{ $args{from} . '::' . $name };
-
- # make sure it is from us
- my ($pkg_name) = Class::MOP::get_code_info($keyword);
- next if $pkg_name ne $args{source};
-
- # and if it is from us, then undef the slot
- delete ${ $args{from} . '::' }{$name};
- }
- }
+ return $exporter, \@exported_names;
}
1;