From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 2 Nov 2012 17:02:58 +0000 (+0100)
Subject: Improve text of ro/wo violation exceptions
X-Git-Tag: v0.10007~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=da609a465417b66a52918e7e2be3c38309bdc21f;p=p5sagit%2FClass-Accessor-Grouped.git

Improve text of ro/wo violation exceptions
---

diff --git a/Changes b/Changes
index 45b9eb1..fee1fd9 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,7 @@ Revision history for Class::Accessor::Grouped.
       dependency on Class::Inspector
     - Simplify superclass traversal done by the 'inherited' group type
     - Fix incorrect quoting of unusual hash keys (fieldnames)
+    - Improve text of ro/wo violation exceptions
 
 0.10006 2011-12-30 03:52 (UTC)
     - Silence warnings resulting from incomplete can() overrides
diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm
index c60ef7f..f7bc475 100644
--- a/lib/Class/Accessor/Grouped.pm
+++ b/lib/Class/Accessor/Grouped.pm
@@ -603,15 +603,14 @@ EOS
     pp_code => sub {
       # my ($group, $fieldname) = @_;
       my $quoted_fieldname = $perlstring->($_[1]);
-      sprintf  <<'EOS', $quoted_fieldname, $_[0], $quoted_fieldname;
+      sprintf  <<'EOS', $_[0], $quoted_fieldname;
 
 @_ > 1
   ? do {
-    my $caller = caller;
+    my ($meth) = (caller(0))[3] =~ /([^\:]+)$/;
     my $class = length( ref($_[0]) ) ? ref($_[0]) : $_[0];
-    Carp::croak(sprintf
-      "'%%s' cannot alter the value of '%%s' (read-only attribute of class '%%s')",
-      $caller, %s, $class
+    Carp::croak(
+      "'$meth' cannot alter its value (read-only attribute of class $class)"
     );
   }
   : shift->get_%s(%s)
@@ -624,16 +623,15 @@ EOS
     pp_code => sub {
       # my ($group, $fieldname) = @_;
       my $quoted_fieldname = $perlstring->($_[1]);
-      sprintf  <<'EOS', $_[0], ($quoted_fieldname) x 2;
+      sprintf  <<'EOS', $_[0], $quoted_fieldname;
 
 @_ > 1
   ? shift->set_%s(%s, @_)
   : do {
-    my $caller = caller;
+    my ($meth) = (caller(0))[3] =~ /([^\:]+)$/;
     my $class = length( ref($_[0]) ) ? ref($_[0]) : $_[0];
-    Carp::croak(sprintf
-      "'%%s' cannot access the value of '%%s' (write-only attribute of class '%%s')",
-      $caller, %s, $class
+    Carp::croak(
+      "'$meth' cannot access its value (write-only attribute of class $class)"
     );
   }
 EOS
diff --git a/t/accessors_ro.t b/t/accessors_ro.t
index 7b385a2..ca372a6 100644
--- a/t/accessors_ro.t
+++ b/t/accessors_ro.t
@@ -80,7 +80,7 @@ for my $name (sort keys %$test_accessors) {
 
   my $ro_regex = $test_accessors->{$name}{is_xs}
     ? qr/Usage\:.+$name.*\(self\)/
-    : qr/cannot alter the value of '\Q$field\E'/
+    : qr/$name(:?_accessor)?\Q' cannot alter its value (read-only attribute of class AccessorGroupsRO)/
   ;
 
   {
diff --git a/t/accessors_wo.t b/t/accessors_wo.t
index 39c5d7a..5f996e5 100644
--- a/t/accessors_wo.t
+++ b/t/accessors_wo.t
@@ -77,7 +77,7 @@ for my $name (sort keys %$test_accessors) {
 
   my $wo_regex = $test_accessors->{$name}{is_xs}
     ? qr/Usage\:.+$name.*\(self, newvalue\)/
-    : qr/cannot access the value of '\Q$field\E'/
+    : qr/$name(:?_accessor)?\Q' cannot access its value (write-only attribute of class AccessorGroupsWO)/
   ;
 
   # die on get via name/alias