Merged CMOP into Moose

[gitmo/Moose.git] / lib / Moose / Exporter.pm

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 1064050..15a918c 100644 (file)
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -3,23 +3,24 @@ package Moose::Exporter;
 use strict;
 use warnings;
 
-our $VERSION = '1.14';
-our $XS_VERSION = $VERSION;
-$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
+use XSLoader;
+
+BEGIN {
+    XSLoader::load(
+        'Moose',
+        $Moose::{VERSION} ? $Moose::{VERSION} : ()
+    );
+}
+
 use Class::MOP;
 use List::MoreUtils qw( first_index uniq );
-use Moose::Deprecated;
 use Moose::Util::MetaRole;
 use Scalar::Util qw(reftype);
 use Sub::Exporter 0.980;
 use Sub::Name qw(subname);
 
-use XSLoader;
-
-XSLoader::load( 'Moose', $XS_VERSION );
-
 my %EXPORT_SPEC;
 
 sub setup_import_methods {
@@ -51,12 +52,7 @@ sub build_import_methods {
         $is_reexport,
     );
 
-    my $exporter = Sub::Exporter::build_exporter(
-        {
-            exports => $exports,
-            groups  => { default => [':all'] }
-        }
-    );
+    my $exporter = $class->_make_exporter($exports, $is_reexport);
 
     my %methods;
     $methods{import} = $class->_make_import_sub(
@@ -90,6 +86,49 @@ sub build_import_methods {
     return ( $methods{import}, $methods{unimport}, $methods{init_meta} );
 }
 
+sub _make_exporter {
+    my ($class, $exports, $is_reexport) = @_;
+
+    return Sub::Exporter::build_exporter(
+        {
+            exports   => $exports,
+            groups    => { default => [':all'] },
+            installer => sub {
+                my ($arg, $to_export) = @_;
+                my $meta = Class::MOP::class_of($arg->{into});
+
+                goto &Sub::Exporter::default_installer unless $meta;
+
+                # don't overwrite existing symbols with our magically flagged
+                # version of it if we would install the same sub that's already
+                # in the importer
+
+                my @filtered_to_export;
+                my %installed;
+                for (my $i = 0; $i < @{ $to_export }; $i += 2) {
+                    my ($as, $cv) = @{ $to_export }[$i, $i + 1];
+
+                    next if !ref($as)
+                         && $meta->has_package_symbol('&' . $as)
+                         && $meta->get_package_symbol('&' . $as) == $cv;
+
+                    push @filtered_to_export, $as, $cv;
+                    $installed{$as} = 1 unless ref $as;
+                }
+
+                Sub::Exporter::default_installer($arg, \@filtered_to_export);
+
+                for my $name ( keys %{$is_reexport} ) {
+                    no strict 'refs';
+                    no warnings 'once';
+                    next unless exists $installed{$name};
+                    _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } );
+                }
+            },
+        }
+    );
+}
+
 {
     my $seen = {};
 
@@ -357,8 +396,8 @@ sub _make_import_sub {
             = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass )
             if defined $metaclass && length $metaclass;
 
-        my $no_meta;
-        ( $no_meta, @_ ) = _strip_no_meta(@_);
+        my $meta_name;
+        ( $meta_name, @_ ) = _strip_meta_name(@_);
 
         # Normally we could look at $_[0], but in some weird cases
         # (involving goto &Moose::import), $_[0] ends as something
@@ -386,7 +425,7 @@ sub _make_import_sub {
             $c->init_meta(
                 for_class => $CALLER,
                 metaclass => $metaclass,
-                no_meta   => $no_meta,
+                meta_name => $meta_name,
             );
             $did_init_meta = 1;
         }
@@ -416,17 +455,11 @@ sub _make_import_sub {
         }
 
         $class->$exporter( $extra, @args );
-
-        for my $name ( keys %{$is_reexport} ) {
-            no strict 'refs';
-            no warnings 'once';
-            _flag_as_reexport( \*{ join q{::}, $CALLER, $name } );
-        }
     };
 }
 
 sub _strip_traits {
-    my $idx = first_index { $_ eq '-traits' } @_;
+    my $idx = first_index { ( $_ || '' ) eq '-traits' } @_;
 
     return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
 
@@ -440,7 +473,7 @@ sub _strip_traits {
 }
 
 sub _strip_metaclass {
-    my $idx = first_index { $_ eq '-metaclass' } @_;
+    my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_;
 
     return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
 
@@ -451,16 +484,16 @@ sub _strip_metaclass {
     return ( $metaclass, @_ );
 }
 
-sub _strip_no_meta {
-    my $idx = first_index { $_ eq '-no_meta' } @_;
+sub _strip_meta_name {
+    my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_;
 
-    return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
+    return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
 
-    my $no_meta = $_[ $idx + 1 ];
+    my $meta_name = $_[ $idx + 1 ];
 
     splice @_, $idx, 2;
 
-    return ( $no_meta, @_ );
+    return ( $meta_name, @_ );
 }
 
 sub _apply_meta_traits {
@@ -619,11 +652,9 @@ sub import {
 
 1;
 
-__END__
+# ABSTRACT: make an import() and unimport() just like Moose.pm
 
-=head1 NAME
-
-Moose::Exporter - make an import() and unimport() just like Moose.pm
+__END__
 
 =head1 SYNOPSIS
 
@@ -727,7 +758,7 @@ to keep it.
 
 =item * trait_aliases => [ ... ]
 
-This is a list of package names which should have shortened alias exported,
+This is a list of package names which should have shortened aliases exported,
 similar to the functionality of L<aliased>. Each element in the list can be
 either a package name, in which case the export will be named as the last
 namespace component of the package, or an arrayref, whose first element is the
@@ -833,20 +864,4 @@ a metaclass for the caller is an error.
 
 See L<Moose/BUGS> for details on reporting bugs.
 
-=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 2009 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