use Moose::Util ();
sub extends {
- my $class = shift;
+ my $class = caller();
croak "Must derive at least one class" unless @_;
}
sub with {
- my $class = shift;
+ my $class = caller();
Moose::Util::apply_all_roles($class->meta, @_);
}
sub has {
- my $class = shift;
+ my $class = caller();
my $name = shift;
croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
my %options = @_;
}
sub before {
- my $class = shift;
+ my $class = caller();
Moose::Util::add_method_modifier($class, 'before', \@_);
}
sub after {
- my $class = shift;
+ my $class = caller();
Moose::Util::add_method_modifier($class, 'after', \@_);
}
sub around {
- my $class = shift;
+ my $class = caller();
Moose::Util::add_method_modifier($class, 'around', \@_);
}
}
sub override {
- my $class = shift;
+ my $class = caller();
my ( $name, $method ) = @_;
$class->meta->add_override_method_modifier( $name => $method );
}
}
sub augment {
- my $class = shift;
+ my $class = caller();
my ( $name, $method ) = @_;
$class->meta->add_augment_method_modifier( $name => $method );
}
sub make_immutable {
- my $class = shift;
+ my $class = caller();
cluck "The make_immutable keyword has been deprecated, " .
"please go back to __PACKAGE__->meta->make_immutable\n";
$class->meta->make_immutable(@_);
}
my $exporter = Moose::Exporter->build_import_methods(
- with_caller => [
- qw( extends with has before after around override augment make_immutable )
- ],
- as_is => [
- qw( super inner ),
+ export => [
+ qw( extends with has before after around override augment make_immutable super inner ),
\&Carp::confess,
\&Scalar::Util::blessed,
],
);
my $import = $class->_make_import_sub(
- $exporting_package, $args{init_meta_args},
+ $exporting_package,
+ $args{init_meta_args},
$exporter
);
my @exported_names;
my %exports;
- for my $name ( @{ $args{with_caller} } ) {
- my $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
-
- my $wrapped = Class::MOP::subname(
- $exporting_package . '::' . $name => sub { $sub->( scalar caller(), @_ ) } );
-
- $exports{$name} = sub { $wrapped };
-
- push @exported_names, $name;
- }
-
- for my $name ( @{ $args{as_is} } ) {
+ for my $name ( @{ $args{export} } ) {
my $sub;
-
if ( ref $name ) {
$sub = $name;
$name = ( Class::MOP::get_code_info($name) )[1];
}
$exports{$name} = sub { $sub };
+
+ push @exported_names, $name;
}
my $exporter = Sub::Exporter::build_exporter(
if ( $exporting_package->can('_init_meta') ) {
$exporting_package->_init_meta(
+ %{ $init_meta_args || {} },
for_class => $caller,
- %{ $init_meta_args || {} }
);
}
}
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<Moose.pm>. It does this by building custom C<import> and C<unimport>
+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<MooseX> module, as long as they all use C<Moose::Exporter>.
+
+=head1 METHODS
+
+This module provides exactly one public method:
+
+=head2 Moose::Exporter->build_import_methods(...)
+
+When you call this method, C<Moose::Exporter> build custom C<import>
+and C<unimport> 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<Moose.pm>).
+
+The C<unimport> method cleans the callers namespace of all the
+exported functions.
+
+This method accepts the following parameters:
+
+=over 4
+
+=item * export => [ ... ]
+
+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 E<lt>autarch@urth.orgE<gt>
+
+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<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
}
sub with {
- Moose::Util::apply_all_roles( shift->meta(), @_ );
+ my $role = caller();
+ Moose::Util::apply_all_roles( $role->meta(), @_ );
}
sub requires {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
croak "Must specify at least one method" unless @_;
$meta->add_required_methods(@_);
}
sub excludes {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
croak "Must specify at least one role" unless @_;
$meta->add_excluded_roles(@_);
}
sub has {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
my $name = shift;
croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
my %options = @_;
}
sub before {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
my $code = pop @_;
for (@_) {
}
sub after {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
my $code = pop @_;
for (@_) {
}
sub around {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
my $code = pop @_;
for (@_) {
croak "Moose::Role do not currently support "
}
sub override {
- my $meta = shift->meta();
+ my $role = caller();
+ my $meta = $role->meta();
my ( $name, $code ) = @_;
$meta->add_override_method_modifier( $name, $code );
}
}
my $exporter = Moose::Exporter->build_import_methods(
- with_caller => [
- qw( with requires excludes has before after around override make_immutable )
- ],
- as_is => [
- qw( extends super inner augment ),
+ export => [
+ qw( with requires excludes has before after around override extends super inner augment ),
\&Carp::confess,
\&Scalar::Util::blessed,
],
projects / gitmo/Moose.git / commitdiff