From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 17:15:05 +0000 (+0000)
Subject: Step 2: eliminate the need for import and unimport in users of
X-Git-Tag: 0_55_01~43^2~33
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a5c426fc6d2e353f115051322044234efeca3b66;p=gitmo%2FMoose.git

Step 2: eliminate the need for import and unimport in users of
Moose::Exporter, just build it all on the fly
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 7aff9ec..701362b 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -115,7 +115,7 @@ sub make_immutable {
     $class->meta->make_immutable(@_);
 }
 
-my $exporter = Moose::Exporter->build_exporter(
+my $exporter = Moose::Exporter->build_import_methods(
     with_caller => [
         qw( extends with has before after around override augment make_immutable )
     ],
@@ -124,30 +124,9 @@ my $exporter = Moose::Exporter->build_exporter(
         \&Carp::confess,
         \&Scalar::Util::blessed,
     ],
+    also => sub { init_meta( shift, 'Moose::Object' ); },
 );
 
-sub import {
-    my $caller = Moose::Exporter->get_caller(@_);
-
-    # this works because both pragmas set $^H (see perldoc perlvar)
-    # which affects the current compilation - i.e. the file who use'd
-    # us - which is why we don't need to do anything special to make
-    # it affect that file rather than this one (which is already compiled)
-
-    strict->import;
-    warnings->import;
-
-    # we should never export to main
-    if ($caller eq 'main') {
-        warn qq{Moose does not export its sugar to the 'main' package.\n};
-        return;
-    }
-
-    init_meta($caller, 'Moose::Object');
-
-    goto $exporter;
-}
-
 # NOTE:
 # This is for special use by 
 # some modules and stuff, I 
@@ -163,15 +142,6 @@ sub __CURRY_EXPORTS_FOR_CLASS__ {
 #    return map { $_ => $exports{$_}->() } (@_ ? @_ : keys %exports);
 }
 
-sub unimport {
-    my $caller = Moose::Exporter->get_caller(@_);
-
-    Moose::Exporter->remove_keywords(
-        source => __PACKAGE__,
-        from   => $caller,
-    );
-}
-
 sub init_meta {
     my ( $class, $base_class, $metaclass ) = @_;
     $base_class = 'Moose::Object'      unless defined $base_class;
diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 4862563..7d843b8 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -19,23 +19,70 @@ sub get_caller{
                     : caller($offset);
 }
 
+sub build_import_methods {
+    my $class = shift;
+    my %args  = @_;
+
+    my $exporting_package = caller();
+
+    my $exporter = $class->_build_exporter( exporting_package => $exporting_package, %args );
+
+    my $also = $args{also};
+
+    my $import = sub {
+        my $caller = Moose::Exporter->get_caller(@_);
+
+        # this works because both pragmas set $^H (see perldoc perlvar)
+        # which affects the current compilation - i.e. the file who use'd
+        # us - which is why we don't need to do anything special to make
+        # it affect that file rather than this one (which is already compiled)
+
+        strict->import;
+        warnings->import;
+
+        # we should never export to main
+        if ( $caller eq 'main' ) {
+            warn
+                qq{$exporting_package does not export its sugar to the 'main' package.\n};
+            return;
+        }
+
+        $also->($caller) if $also;
+
+        goto $exporter;
+    };
+
+    my $unimport = sub {
+        my $caller = Moose::Exporter->get_caller(@_);
+
+        Moose::Exporter->remove_keywords(
+            source => $exporting_package,
+            from   => $caller,
+        );
+    };
+
+    no strict 'refs';
+    *{ $exporting_package . '::import' } = $import;
+    *{ $exporting_package . '::unimport' } = $unimport;
+}
+
 my %EXPORTED;
-sub build_exporter {
+sub _build_exporter {
     my $class = shift;
     my %args  = @_;
 
-    my $exporting_pkg = caller();
+    my $exporting_package = $args{exporting_package};
 
     my %exports;
     for my $name ( @{ $args{with_caller} } ) {
-        my $sub = do { no strict 'refs'; \&{ $exporting_pkg . '::' . $name } };
+        my $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
 
         my $wrapped = Class::MOP::subname(
-            $exporting_pkg . '::' . $name => sub { $sub->( scalar caller(), @_ ) } );
+            $exporting_package . '::' . $name => sub { $sub->( scalar caller(), @_ ) } );
 
         $exports{$name} = sub { $wrapped };
 
-        push @{ $EXPORTED{$exporting_pkg} }, $name;
+        push @{ $EXPORTED{$exporting_package} }, $name;
     }
 
     for my $name ( @{ $args{as_is} } ) {
@@ -46,9 +93,9 @@ sub build_exporter {
             $name = ( Class::MOP::get_code_info($name) )[1];
         }
         else {
-            $sub = do { no strict 'refs'; \&{ $exporting_pkg . '::' . $name } };
+            $sub = do { no strict 'refs'; \&{ $exporting_package . '::' . $name } };
 
-            push @{ $EXPORTED{$exporting_pkg} }, $name;
+            push @{ $EXPORTED{$exporting_package} }, $name;
         }
 
         $exports{$name} = sub { $sub };
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 98b322c..4c6ae21 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -106,7 +106,7 @@ sub augment {
     croak "Moose::Role cannot support 'augment'";
 }
 
-my $exporter = Moose::Exporter->build_exporter(
+my $exporter = Moose::Exporter->build_import_methods(
     with_caller => [
         qw( with requires excludes has before after around override make_immutable )
     ],
@@ -115,39 +115,9 @@ my $exporter = Moose::Exporter->build_exporter(
         \&Carp::confess,
         \&Scalar::Util::blessed,
     ],
+    also => sub { init_meta(shift) },
 );
 
-sub import {
-    my $caller = Moose::Exporter->get_caller(@_);
-
-    # this works because both pragmas set $^H (see perldoc perlvar)
-    # which affects the current compilation - i.e. the file who use'd
-    # us - which is why we don't need to do anything special to make
-    # it affect that file rather than this one (which is already compiled)
-
-    strict->import;
-    warnings->import;
-
-    # we should never export to main
-    if ($caller eq 'main') {
-        warn qq{Moose::Role does not export its sugar to the 'main' package.\n};
-        return;
-    }
-
-    init_meta($caller);
-
-    goto $exporter;
-}
-
-sub unimport {
-    my $caller = Moose::Exporter->get_caller(@_);
-
-    Moose::Exporter->remove_keywords(
-        source => __PACKAGE__,
-        from   => $caller,
-    );
-}
-
 {
     my %METAS;