From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 23 Mar 2016 13:05:10 +0000 (+0100)
Subject: Store collapser source in the resultset private metadata as well
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5bcb167324052d051f5ab7313dac37815e53e02e;p=dbsrgits%2FDBIx-Class-Historic.git

Store collapser source in the resultset private metadata as well

After 05a5ca4b the deparse of the row-parser coderef is incomprehensible at
best. Add the source to the private cache structure to aid debugging if it
ever becomes necessary (fingercross it won't be). Aside from the explicit
evaluation package name, and the slight change of the return of _mk_row_parser
there are no functional changes

Read under -w
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index cc5b398..0fc240c 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1423,17 +1423,27 @@ sub _construct_results {
       :                                           'classic_nonpruning'
     ;
 
-    # $args and $attrs to _mk_row_parser are separated to delineate what is
-    # core collapser stuff and what is dbic $rs specific
-    $self->{_row_parser}{$parser_type}{cref} = $rsrc->_mk_row_parser({
-      eval => 1,
-      inflate_map => $infmap,
-      collapse => $attrs->{collapse},
-      premultiplied => $attrs->{_main_source_premultiplied},
-      hri_style => $self->{_result_inflator}{is_hri},
-      prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
-    }, $attrs) unless $self->{_row_parser}{$parser_type}{cref};
+    unless( $self->{_row_parser}{$parser_type}{cref} ) {
+
+      # $args and $attrs to _mk_row_parser are separated to delineate what is
+      # core collapser stuff and what is dbic $rs specific
+      $self->{_row_parser}{$parser_type}{src} = $rsrc->_mk_row_parser({
+        inflate_map => $infmap,
+        collapse => $attrs->{collapse},
+        premultiplied => $attrs->{_main_source_premultiplied},
+        hri_style => $self->{_result_inflator}{is_hri},
+        prune_null_branches => $self->{_result_inflator}{is_hri} || $self->{_result_inflator}{is_core_row},
+      }, $attrs);
+
+      $self->{_row_parser}{$parser_type}{cref} = do {
+        package # hide form PAUSE
+          DBIx::Class::__GENERATED_ROW_PARSER__;
+
+        eval $self->{_row_parser}{$parser_type}{src};
+      } || die $@;
+    }
 
+    # this needs to close over the *current* cursor, hence why it is not cached above
     my $next_cref = ($did_fetch_all or ! $attrs->{collapse})
       ? undef
       : sub {
diff --git a/lib/DBIx/Class/ResultSource/RowParser.pm b/lib/DBIx/Class/ResultSource/RowParser.pm
index 4683e15..12e309b 100644
--- a/lib/DBIx/Class/ResultSource/RowParser.pm
+++ b/lib/DBIx/Class/ResultSource/RowParser.pm
@@ -148,9 +148,7 @@ sub _mk_row_parser {
   utf8::upgrade($src)
     if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
 
-  return (
-    $args->{eval} ? ( eval "sub $src" || die $@ ) : $src,
-  );
+  $src;
 }
 
 
diff --git a/lib/DBIx/Class/ResultSource/RowParser/Util.pm b/lib/DBIx/Class/ResultSource/RowParser/Util.pm
index 0409c1a..68f7e6b 100644
--- a/lib/DBIx/Class/ResultSource/RowParser/Util.pm
+++ b/lib/DBIx/Class/ResultSource/RowParser/Util.pm
@@ -18,7 +18,7 @@ our @EXPORT_OK = qw(
 our $null_branch_class = 'DBIx::ResultParser::RelatedNullBranch';
 
 sub __wrap_in_strictured_scope {
-  "  { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n  }"
+  "sub { use strict; use warnings; use warnings FATAL => 'uninitialized';\n$_[0]\n  }"
 }
 
 sub assemble_simple_parser {
diff --git a/t/resultset/rowparser_internals.t b/t/resultset/rowparser_internals.t
index 2c593e7..67215eb 100644
--- a/t/resultset/rowparser_internals.t
+++ b/t/resultset/rowparser_internals.t
@@ -1457,7 +1457,7 @@ sub is_same_src { SKIP: {
 
   $expect =~ s/__NBC__/perlstring($DBIx::Class::ResultSource::RowParser::Util::null_branch_class)/ge;
 
-  $expect = "  { use strict; use warnings FATAL => 'uninitialized';\n$expect\n  }";
+  $expect = "sub { use strict; use warnings FATAL => 'uninitialized';\n$expect\n  }";
 
   my @normalized = map {
     my $cref = eval "sub { $_ }" or do {