From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 19:42:11 +0000 (+0000)
Subject: I realized that all the "with caller" wrapper stuff is pointless. We
X-Git-Tag: 0_55_01~43^2~24
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2f29843cdf35144014ed085f226ccd053adc6067;p=gitmo%2FMoose.git

I realized that all the "with caller" wrapper stuff is pointless. We
can get the caller via caller().

This greatly simplifies lots of things.
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 2edbffe..e67c48b 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -27,7 +27,7 @@ use Moose::Util::TypeConstraints;
 use Moose::Util ();
 
 sub extends {
-    my $class = shift;
+    my $class = caller();
 
     croak "Must derive at least one class" unless @_;
 
@@ -50,12 +50,12 @@ sub extends {
 }
 
 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 = @_;
@@ -64,17 +64,17 @@ sub has {
 }
 
 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', \@_);
 }
 
@@ -83,7 +83,7 @@ sub super {
 }
 
 sub override {
-    my $class = shift;
+    my $class = caller();
     my ( $name, $method ) = @_;
     $class->meta->add_override_method_modifier( $name => $method );
 }
@@ -103,24 +103,21 @@ sub inner {
 }
 
 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,
     ],
diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 2ebb697..43ed882 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -24,7 +24,8 @@ sub build_import_methods {
     );
 
     my $import = $class->_make_import_sub(
-        $exporting_package, $args{init_meta_args},
+        $exporting_package,
+        $args{init_meta_args},
         $exporter
     );
 
@@ -44,20 +45,8 @@ sub _build_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];
@@ -69,6 +58,8 @@ sub _build_exporter {
         }
 
         $exports{$name} = sub { $sub };
+
+        push @exported_names, $name;
     }
 
     my $exporter = Sub::Exporter::build_exporter(
@@ -107,8 +98,8 @@ sub _make_import_sub {
 
         if ( $exporting_package->can('_init_meta') ) {
             $exporting_package->_init_meta(
+                %{ $init_meta_args || {} },
                 for_class => $caller,
-                %{ $init_meta_args || {} }
             );
         }
 
@@ -144,3 +135,94 @@ sub _make_unimport_sub {
 }
 
 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
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 93727ef..8a7bc4f 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -24,23 +24,27 @@ sub extends {
 }
 
 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 = @_;
@@ -49,7 +53,8 @@ sub has {
 }
 
 sub before {
-    my $meta = shift->meta();
+    my $role = caller();
+    my $meta = $role->meta();
     my $code = pop @_;
 
     for (@_) {
@@ -62,7 +67,8 @@ sub before {
 }
 
 sub after {
-    my $meta = shift->meta();
+    my $role = caller();
+    my $meta = $role->meta();
 
     my $code = pop @_;
     for (@_) {
@@ -75,7 +81,8 @@ sub after {
 }
 
 sub around {
-    my $meta = shift->meta();
+    my $role = caller();
+    my $meta = $role->meta();
     my $code = pop @_;
     for (@_) {
         croak "Moose::Role do not currently support "
@@ -93,7 +100,8 @@ sub super {
 }
 
 sub override {
-    my $meta = shift->meta();
+    my $role = caller();
+    my $meta = $role->meta();
     my ( $name, $code ) = @_;
     $meta->add_override_method_modifier( $name, $code );
 }
@@ -107,11 +115,8 @@ sub augment {
 }
 
 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,
     ],