From: Dave Rolsky <autarch@urth.org>
Date: Wed, 6 Aug 2008 19:09:52 +0000 (+0000)
Subject: Refactored the code so we have methods for making import &
X-Git-Tag: 0_55_01~43^2~25
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a601f52e60900dd15a728ca6276f2b4e7d0cc23;p=gitmo%2FMoose.git

Refactored the code so we have methods for making import &
unimport. Also tidied everything some more.
---

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 9c33377..2ebb697 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -8,19 +8,8 @@ use namespace::clean 0.08 ();
 use Sub::Exporter;
 
 
-sub get_caller {
-    # 1 extra level because it's called by import so there's a layer
-    # of indirection
-    my $offset = 1;
-
-    return
-          ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
-        : ( ref $_[1] && defined $_[1]->{into_level} )
-        ? caller( $offset + $_[1]->{into_level} )
-        : caller($offset);
-}
-
 my %EXPORT_SPEC;
+
 sub build_import_methods {
     my $class = shift;
     my %args  = @_;
@@ -29,50 +18,20 @@ sub build_import_methods {
 
     $EXPORT_SPEC{$exporting_package} = \%args;
 
-    my ( $exporter, $exported )
-        = $class->_build_exporter( exporting_package => $exporting_package,
-        %args );
-
-    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;
-        }
-
-        if ( $exporting_package->can('_init_meta') ) {
-            $exporting_package->_init_meta(
-                for_class => $caller,
-                %{ $args{init_meta_args} || {} }
-            );
-        }
-
-        goto $exporter;
-    };
+    my ( $exporter, $exported ) = $class->_build_exporter(
+        exporting_package => $exporting_package,
+        %args
+    );
 
-    # [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 {
-        @_ = ( 'namespace::clean', @{ $exported } );
+    my $import = $class->_make_import_sub(
+        $exporting_package, $args{init_meta_args},
+        $exporter
+    );
 
-        goto &namespace::clean::import;
-    };
+    my $unimport = $class->_make_unimport_sub($exported);
 
     no strict 'refs';
-    *{ $exporting_package . '::import' } = $import;
+    *{ $exporting_package . '::import' }   = $import;
     *{ $exporting_package . '::unimport' } = $unimport;
 }
 
@@ -122,4 +81,66 @@ sub _build_exporter {
     return $exporter, \@exported_names;
 }
 
+sub _make_import_sub {
+    my $class             = shift;
+    my $exporting_package = shift;
+    my $init_meta_args    = shift;
+    my $exporter          = shift;
+
+    return 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;
+        }
+
+        if ( $exporting_package->can('_init_meta') ) {
+            $exporting_package->_init_meta(
+                for_class => $caller,
+                %{ $init_meta_args || {} }
+            );
+        }
+
+        goto $exporter;
+    };
+}
+
+sub _get_caller {
+    # 1 extra level because it's called by import so there's a layer
+    # of indirection
+    my $offset = 1;
+
+    return
+          ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
+        : ( ref $_[1] && defined $_[1]->{into_level} )
+        ? caller( $offset + $_[1]->{into_level} )
+        : caller($offset);
+}
+
+sub _make_unimport_sub {
+    my $class    = shift;
+    my $exported = shift;
+
+    # [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.
+    return sub {
+        @_ = ( 'namespace::clean', @{$exported} );
+
+        goto &namespace::clean::import;
+    };
+}
+
 1;