From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 18 Aug 2009 23:48:43 +0000 (-0500)
Subject: warn (and skip) when trying to export a nonexistent sub
X-Git-Tag: 0.89_02~34
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e6a5040f8afb239e1c5fae3158f7af768827f1a5;p=gitmo%2FMoose.git

warn (and skip) when trying to export a nonexistent sub
---

diff --git a/Changes b/Changes
index f6b74d4..0ac1da7 100644
--- a/Changes
+++ b/Changes
@@ -22,6 +22,11 @@ for, noteworthy changes.
     * Moose
       - Correct POD for builder to point to Recipe8, not 9. (gphat)
 
+    * Moose::Exporter
+      - When a nonexistent sub name is passed to as_is, with_caller, or
+        with_meta, throw a warning and skip the exporting, rather than
+        installing a broken sub. (doy)
+
 0.89 Thu Aug 13, 2009
     * Moose::Manual::Attributes
       - Clarify "is", include discussion of "bare". (Sartak)
diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 5598101..9bbc4ab 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -130,6 +130,12 @@ sub _make_sub_exporter_params {
                 \&{ $package . '::' . $name };
             };
 
+            if ( !defined(&$sub) ) {
+                Carp::cluck
+                    "Trying to export undefined sub ${package}::${name}";
+                next;
+            }
+
             my $fq_name = $package . '::' . $name;
 
             $exports{$name} = $class->_make_wrapped_sub(
@@ -147,6 +153,12 @@ sub _make_sub_exporter_params {
                 \&{ $package . '::' . $name };
             };
 
+            if ( !defined(&$sub) ) {
+                Carp::cluck
+                    "Trying to export undefined sub ${package}::${name}";
+                next;
+            }
+
             my $fq_name = $package . '::' . $name;
 
             $exports{$name} = $class->_make_wrapped_sub_with_meta(
@@ -159,7 +171,7 @@ sub _make_sub_exporter_params {
         }
 
         for my $name ( @{ $args->{as_is} } ) {
-            my $sub;
+            my ($sub, $coderef_name);
 
             if ( ref $name ) {
                 $sub  = $name;
@@ -175,9 +187,10 @@ sub _make_sub_exporter_params {
                 # really want to keep these subs or not, we err on the
                 # safe side and leave them in.
                 my $coderef_pkg;
-                ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name);
+                ( $coderef_pkg, $coderef_name )
+                    = Class::MOP::get_code_info($name);
 
-                $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0;
+                $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
             }
             else {
                 $sub = do {
@@ -185,12 +198,19 @@ sub _make_sub_exporter_params {
                     \&{ $package . '::' . $name };
                 };
 
+                if ( !defined(&$sub) ) {
+                    Carp::cluck
+                        "Trying to export undefined sub ${package}::${name}";
+                    next;
+                }
+
                 $is_removable{$name} = 1;
+                $coderef_name = $name;
             }
 
             $export_recorder->{$sub} = 1;
 
-            $exports{$name} = sub {$sub};
+            $exports{$coderef_name} = sub {$sub};
         }
 
         for my $name ( keys %{ $args->{groups} } ) {
diff --git a/t/010_basics/022_moose_exporter_groups.t b/t/010_basics/022_moose_exporter_groups.t
index 11b901f..589883a 100755
--- a/t/010_basics/022_moose_exporter_groups.t
+++ b/t/010_basics/022_moose_exporter_groups.t
@@ -85,6 +85,8 @@ use Test::Exception;
 
     sub exgroups2_as_is { 3 }
 
+    sub exgroups2_with_caller { 4 }
+
     sub generate_group {
         my ($caller, $group_name, $args, $context) = @_;
 
diff --git a/t/050_metaclasses/012_moose_exporter.t b/t/050_metaclasses/012_moose_exporter.t
index bb474fd..52aabf2 100644
--- a/t/050_metaclasses/012_moose_exporter.t
+++ b/t/050_metaclasses/012_moose_exporter.t
@@ -8,7 +8,7 @@ use Test::Exception;
 BEGIN {
     eval "use Test::Output;";
     plan skip_all => "Test::Output is required for this test" if $@;
-    plan tests => 47;
+    plan tests => 49;
 }
 
 
@@ -291,3 +291,25 @@ BEGIN {
     ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
 }
 
+{
+    package NonExistentExport;
+
+    use Moose ();
+
+    ::stderr_like {
+        Moose::Exporter->setup_import_methods(
+            also => ['Moose'],
+            with_caller => ['does_not_exist'],
+        );
+    } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/,
+      "warns when a non-existent method is requested to be exported";
+}
+
+{
+    package WantsNonExistentExport;
+
+    NonExistentExport->import;
+
+    ::ok(!__PACKAGE__->can('does_not_exist'),
+         "undefined subs do not get exported");
+}