From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 18:55:40 +0000 (+0000)
Subject: Removed __CURRY_EXPORTS_FOR_CLASS__
X-Git-Tag: 0_55_01~43^2~30
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0338a41154d38a6fb6b6452a1245044f12fc40d6;p=gitmo%2FMoose.git

Removed __CURRY_EXPORTS_FOR_CLASS__

Renamed init_meta to _init_meta and have it automatically called from
Moose::Exporter's generated import. Left in Moose::init_meta for
backwards compat.

Use namespace::clean to remove exported sugar functions, per hack from
mst.
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 701362b..2edbffe 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -124,28 +124,26 @@ my $exporter = Moose::Exporter->build_import_methods(
         \&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."
diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 7d843b8..38d9c83 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Class::MOP;
+use namespace::clean ();
 use Sub::Exporter;
 
 
@@ -19,15 +20,18 @@ sub get_caller{
                     : 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(@_);
@@ -47,18 +51,24 @@ sub build_import_methods {
             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';
@@ -73,6 +83,7 @@ sub _build_exporter {
 
     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 } };
@@ -82,7 +93,7 @@ sub _build_exporter {
 
         $exports{$name} = sub { $wrapped };
 
-        push @{ $EXPORTED{$exporting_package} }, $name;
+        push @exported_names, $name;
     }
 
     for my $name ( @{ $args{as_is} } ) {
@@ -95,38 +106,20 @@ sub _build_exporter {
         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;
diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 4c6ae21..93727ef 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -115,14 +115,18 @@ my $exporter = Moose::Exporter->build_import_methods(
         \&Carp::confess,
         \&Scalar::Util::blessed,
     ],
-    also => sub { init_meta(shift) },
 );
 
 {
     my %METAS;
 
-    sub init_meta {
-        my $role = shift;
+    sub _init_meta {
+        shift;
+        my %args = @_;
+
+        my $role = $args{for_class}
+            or confess
+            "Cannot call _init_meta without specifying a for_class";
 
         return $METAS{$role} if exists $METAS{$role};