X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FAccessor%2FGrouped.pm;h=522808923a32311dc22c6e98e184cfda194fc9f4;hb=9c66ea907188034fb834df1704c7a90e207e16d6;hp=d392a48ae636bc8766d0ecbb8229c20512457261;hpb=5808b2245979b6d4c0582c10892e8526aa00d673;p=p5sagit%2FClass-Accessor-Grouped.git

diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm
index d392a48..5228089 100644
--- a/lib/Class/Accessor/Grouped.pm
+++ b/lib/Class/Accessor/Grouped.pm
@@ -15,12 +15,12 @@ BEGIN {
   }
 }
 
-our $VERSION = '0.10009';
-$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
+our $VERSION = '0.10013_01';
+$VERSION =~ tr/_//d; # numify for warning-free dev releases
 
 # when changing minimum version don't forget to adjust Makefile.PL as well
 our $__minimum_xsa_version;
-BEGIN { $__minimum_xsa_version = '1.15' }
+BEGIN { $__minimum_xsa_version = '1.19' }
 
 our $USE_XS;
 # the unless defined is here so that we can override the value
@@ -68,16 +68,10 @@ BEGIN {
   constant->import( TRACK_UNDEFER_FAIL => (
     $INC{'Test/Builder.pm'} || $INC{'Test/Builder2.pm'}
       and
-    $0 =~ m|^ x?t / .+ \.t $|x
+    $0 =~ m{ ^ (?: \. \/ )? x?t / .+ \.t $}x
   ) ? 1 : 0 );
 
-  require B;
-  # a perl 5.6 kludge
-  unless (B->can('perlstring')) {
-    require Data::Dumper;
-    my $d = Data::Dumper->new([])->Indent(0)->Purity(0)->Pad('')->Useqq(1)->Terse(1)->Freezer('')->Toaster('');
-    *B::perlstring = sub { $d->Values([shift])->Dump };
-  }
+  sub perlstring ($) { q{"}. quotemeta( shift ). q{"} };
 }
 
 # Yes this method is undocumented
@@ -105,7 +99,7 @@ sub _mk_group_accessors {
       if ($name =~ /\0/) {
         Carp::croak(sprintf
           "Illegal accessor name %s - nulls should never appear in stash keys",
-          B::perlstring($name),
+          __CAG_ENV__::perlstring($name),
         );
       }
       elsif (! $ENV{CAG_ILLEGAL_ACCESSOR_NAME_OK} ) {
@@ -126,7 +120,7 @@ sub _mk_group_accessors {
         # idiot, there is now a ton of DBIC code out there that attempts
         # to create column accessors with illegal names. In the interest
         # of not cluttering the logs of unsuspecting victims (unsuspecting
-        # because these accessors are unusuable anyway) we provide an
+        # because these accessors are unusable anyway) we provide an
         # explicit "do not warn at all" escape, until all such code is
         # fixed (this will be a loooooong time >:(
         $ENV{CAG_ILLEGAL_ACCESSOR_NAME_OK} ne 'DO_NOT_WARN'
@@ -703,7 +697,7 @@ my $maker_templates = {
     cxsa_call => 'accessors',
     pp_generator => sub {
       # my ($group, $fieldname) = @_;
-      my $quoted_fieldname = B::perlstring($_[1]);
+      my $quoted_fieldname = __CAG_ENV__::perlstring($_[1]);
       sprintf <<'EOS', ($_[0], $quoted_fieldname) x 2;
 
 @_ > 1
@@ -717,7 +711,7 @@ EOS
     cxsa_call => 'getters',
     pp_generator => sub {
       # my ($group, $fieldname) = @_;
-      my $quoted_fieldname = B::perlstring($_[1]);
+      my $quoted_fieldname = __CAG_ENV__::perlstring($_[1]);
       sprintf  <<'EOS', $_[0], $quoted_fieldname;
 
 @_ > 1
@@ -737,7 +731,7 @@ EOS
     cxsa_call => 'setters',
     pp_generator => sub {
       # my ($group, $fieldname) = @_;
-      my $quoted_fieldname = B::perlstring($_[1]);
+      my $quoted_fieldname = __CAG_ENV__::perlstring($_[1]);
       sprintf  <<'EOS', $_[0], $quoted_fieldname;
 
 @_ > 1
@@ -788,6 +782,14 @@ my $original_simple_setter = __PACKAGE__->can ('set_simple');
 
 my ($resolved_methods, $cag_produced_crefs);
 
+sub CLONE {
+  my @crefs = grep { defined $_ } values %{$cag_produced_crefs||{}};
+  $cag_produced_crefs = @crefs
+    ? { map { $_ => $_ } @crefs }
+    : undef
+  ;
+}
+
 # Note!!! Unusual signature
 $gen_accessor = sub {
   my ($type, $class, $group, $field, $methname) = @_;