Fix incorrect collapser source being generated due to unicode collapse points

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource / RowParser / Util.pm

diff --git a/lib/DBIx/Class/ResultSource/RowParser/Util.pm b/lib/DBIx/Class/ResultSource/RowParser/Util.pm
index 83ec733..3cf4aee 100644 (file)
--- a/lib/DBIx/Class/ResultSource/RowParser/Util.pm
+++ b/lib/DBIx/Class/ResultSource/RowParser/Util.pm
@@ -5,7 +5,9 @@ use strict;
 use warnings;
 
 use List::Util 'first';
-use B 'perlstring';
+use DBIx::Class::_Util 'perlstring';
+
+use constant HAS_DOR => ( $] < 5.010 ? 0 : 1 );
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
@@ -65,7 +67,7 @@ sub __visit_infmap_simple {
         sort { $a <=> $b } values %{$rel_cols->{$rel}}
       ;
 
-      if ($args->{hri_style}) {
+      if ($args->{prune_null_branches}) {
         $rel_struct = sprintf ( '( (%s) ? undef : %s )',
           $branch_null_checks,
           $rel_struct,
@@ -109,7 +111,7 @@ sub assemble_collapsing_parser {
   my $args = shift;
 
   # it may get unset further down
-  my $no_rowid_container = $args->{hri_style};
+  my $no_rowid_container = $args->{prune_null_branches};
 
   my ($top_node_key, $top_node_key_assembler);
 
@@ -151,11 +153,15 @@ sub assemble_collapsing_parser {
 
   my @idcol_args = $no_rowid_container ? ('', '') : (
     ', %cur_row_ids', # only declare the variable if we'll use it
-
-    sprintf( <<'EOS', join ', ', sort { $a <=> $b } keys %{ $stats->{idcols_seen} } ),
-  $cur_row_ids{$_} = defined($cur_row_data->[$_]) ? $cur_row_data->[$_] : "\0NULL\xFF$rows_pos\xFF$_\0"
-    for (%s);
-EOS
+    join ("\n", map {
+      my $quoted_null_val = qq( "\0NULL\xFF\${rows_pos}\xFF${_}\0" );
+      qq(\$cur_row_ids{$_} = ) . (
+        # in case we prune - we will never hit these undefs
+        $args->{prune_null_branches} ? qq( \$cur_row_data->[$_]; )
+        : HAS_DOR                    ? qq( \$cur_row_data->[$_] // $quoted_null_val; )
+        :                              qq( defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : $quoted_null_val; )
+      )
+    } sort { $a <=> $b } keys %{ $stats->{idcols_seen} } ),
   );
 
   my $parser_src = sprintf (<<'EOS', @idcol_args, $top_node_key_assembler||'', $top_node_key, join( "\n", @{$data_assemblers||[]} ) );
@@ -169,27 +175,30 @@ EOS
   # result can be rather large - we reuse the same already allocated
   # array, since the collapsed prefetch is smaller by definition.
   # At the end we cut the leftovers away and move on.
-  while ($cur_row_data =
-    ( ( $rows_pos >= 0 and $_[0][$rows_pos++] ) or do { $rows_pos = -1; undef } )
-      ||
-    ($_[1] and $_[1]->())
-  ) {
-    # this code exists only when we are *not* assembling direct to HRI
+  while ($cur_row_data = (
+    ( $rows_pos >= 0 and $_[0][$rows_pos++] )
+      or
+    ( $_[1] and $rows_pos = -1 and $_[1]->() )
+  ) ) {
+
+    # this code exists only when we are using a cur_row_ids
+    # furthermore the undef checks may or may not be there
+    # depending on whether we prune or not
     #
     # due to left joins some of the ids may be NULL/undef, and
     # won't play well when used as hash lookups
     # we also need to differentiate NULLs on per-row/per-col basis
     # (otherwise folding of optional 1:1s will be greatly confused
-    %2$s
+%2$s
 
     # in the case of an underdefined root - calculate the virtual id (otherwise no code at all)
-    %3$s
+%3$s
 
     # if we were supplied a coderef - we are collapsing lazily (the set
     # is ordered properly)
     # as long as we have a result already and the next result is new we
     # return the pre-read data and bail
-    $_[1] and $result_pos and ! $collapse_idx[0]%4$s and (unshift @{$_[2]}, $cur_row_data) and last;
+$_[1] and $result_pos and ! $collapse_idx[0]%4$s and (unshift @{$_[2]}, $cur_row_data) and last;
 
     # the rel assemblers
 %5$s
@@ -251,8 +260,9 @@ sub __visit_infmap_collapse {
   my @src;
 
   if ($cur_node_idx == 0) {
-    push @src, sprintf( '%s ||= $_[0][$result_pos++] = %s;',
+    push @src, sprintf( '%s %s $_[0][$result_pos++] = %s;',
       $node_idx_slot,
+      (HAS_DOR ? '//=' : '||='),
       $me_struct || '{}',
     );
   }
@@ -260,12 +270,13 @@ sub __visit_infmap_collapse {
     my $parent_attach_slot = sprintf( '$collapse_idx[%d]%s%s{%s}',
       @{$args}{qw/-parent_node_idx -parent_node_key/},
       $args->{hri_style} ? '' : '[1]',
-      perlstring($args->{-node_relname}),
+      perlstring($args->{-node_rel_name}),
     );
 
     if ($args->{collapse_map}->{-is_single}) {
-      push @src, sprintf ( '%s ||= %s%s;',
+      push @src, sprintf ( '%s %s %s%s;',
         $parent_attach_slot,
+        (HAS_DOR ? '//=' : '||='),
         $node_idx_slot,
         $me_struct ? " = $me_struct" : '',
       );
@@ -292,7 +303,7 @@ sub __visit_infmap_collapse {
       collapse_map => $relinfo,
       -parent_node_idx => $cur_node_idx,
       -parent_node_key => $node_key,
-      -node_relname => $rel,
+      -node_rel_name => $rel,
     });
 
     my $rel_src_pos = $#src + 1;
@@ -307,14 +318,15 @@ sub __visit_infmap_collapse {
       )
     ) {
 
-      if ($args->{hri_style}) {
+      if ($args->{prune_null_branches}) {
 
         # start of wrap of the entire chain in a conditional
-        splice @src, $rel_src_pos, 0, sprintf "( ! defined %s )\n  ? %s{%s} = %s\n  : do {",
+        splice @src, $rel_src_pos, 0, sprintf "( ! defined %s )\n  ? %s%s{%s} = %s\n  : do {",
           "'\xFF__VALPOS__${first_distinct_child_idcol}__\xFF'",
           $node_idx_slot,
+          $args->{hri_style} ? '' : '[1]',
           perlstring($rel),
-          $relinfo->{-is_single} ? 'undef' : '[]'
+          ($args->{hri_style} && $relinfo->{-is_single}) ? 'undef' : '[]'
         ;
 
         # end of wrap