X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2F_Util.pm;h=d7b1ce24d50b1a2ca93a5cc9a1339de86684f816;hb=dc71574729e5f45defc433ca2e11b7c2377eaf95;hp=f4bda73466ad5d47a9b76f8960c830cfd035e8c1;hpb=1cf2ad8b03a2b1ad34183905475d1d9afd614aba;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index f4bda73..d7b1ce2 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -23,6 +23,9 @@ BEGIN {
 
     BROKEN_GOTO => ( "$]" < 5.008003 ) ? 1 : 0,
 
+    # perl -MScalar::Util=weaken -e 'weaken( $hash{key} = \"value" )'
+    BROKEN_WEAK_SCALARREF_VALUES => ( "$]" < 5.008003 ) ? 1 : 0,
+
     HAS_ITHREADS => $Config{useithreads} ? 1 : 0,
 
     UNSTABLE_DOLLARAT => ( "$]" < 5.013002 ) ? 1 : 0,
@@ -182,6 +185,7 @@ BEGIN {
   Sub::Quote->VERSION(2.002);
 }
 # Override forcing no_defer, and adding naming consistency checks
+our %refs_closed_over_by_quote_sub_installed_crefs;
 sub quote_sub {
   Carp::confess( "Anonymous quoting not supported by the DBIC sub_quote override - supply a sub name" ) if
     @_ < 2
@@ -214,6 +218,22 @@ sub quote_sub {
     no_defer => 1,
   };
 
+  weaken (
+    # just use a growing counter, no need to perform neither compaction
+    # nor any special ithread-level handling
+    $refs_closed_over_by_quote_sub_installed_crefs
+     { scalar keys %refs_closed_over_by_quote_sub_installed_crefs }
+      = $_
+  ) for grep {
+    length ref $_
+      and
+    (
+      ! DBIx::Class::_ENV_::BROKEN_WEAK_SCALARREF_VALUES
+        or
+      ref $_ ne 'SCALAR'
+    )
+  } values %{ $_[2] || {} };
+
   my $cref = Sub::Quote::quote_sub( $_[0], $_[1], $_[2]||{}, $sq_opts );
 
   # FIXME FIXME FIXME
@@ -727,17 +747,12 @@ sub modver_gt_or_eq_and_lt ($$$) {
       # efficiently operate over the query_cache directly
       describe_class_methods($_) for reverse @full_ISA;
 
-      my $current_node_refaddr;
       no strict 'refs';
 
       # combine full ISA-order inherited and local method list into a
       # "shadowing stack"
 
       (
-        $current_node_refaddr = refaddr($_)
-
-          and
-
         unshift @{ $slot->{methods}{$_->{name}} }, $_
 
           and