From: Dagfinn Ilmari Mannsåker <ilmari@photobox.com>
Date: Tue, 31 Jul 2012 16:18:00 +0000 (+0100)
Subject: throw an error on invalid builder names as well (RT#78479)
X-Git-Tag: v1.000002~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5a1cfeaac93cc99bb25f45e7f68b400bad1a6bac;p=gitmo%2FMoo.git

throw an error on invalid builder names as well (RT#78479)
---

diff --git a/Changes b/Changes
index d4f729a..11a9588 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,4 @@
-  - throw an error on non-string builder (RT#78479)
+  - throw an error on invalid builder (RT#78479)
   - require D::GD 0.07 to avoid prototype mismatch errors
   - fix stupid typo in new Sub::Quote section
 
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index c644919..bfecf26 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -36,8 +36,9 @@ sub generate_method {
     die "Unknown is ${is}";
   }
   $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
-  die "Invalid builder for $into->$name - not a string"
-    if exists $spec->{builder} and ref $spec->{builder};
+  die "Invalid builder for $into->$name - not a valid method name"
+    if exists $spec->{builder} and (ref $spec->{builder}
+      or $spec->{builder} !~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/);
   if (($spec->{predicate}||0) eq 1) {
     $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}";
   }
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index 22d88af..256cc5c 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -78,6 +78,16 @@ like(
   qr/Invalid builder/, 'builder - coderef rejected'
 );
 
+like(
+  exception { $gen->generate_method('Foo' => 'twelve' => { is => 'ro', builder => 'build:twelve' }) },
+  qr/Invalid builder/, 'builder - invalid name rejected',
+);
+
+is(
+  exception { $gen->generate_method('Foo' => 'thirteen' => { is => 'ro', builder => 'build::thirteen' }) },
+  undef, 'builder - fully-qualified name accepted',
+);
+
 my $foo = Foo->new(one => 1);
 
 is($foo->one, 1, 'ro reads');