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 f80fd7d..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(
@@ -152,8 +154,14 @@ sub assemble_collapsing_parser {
   my @idcol_args = $no_rowid_container ? ('', '') : (
     ', %cur_row_ids', # only declare the variable if we'll use it
     join ("\n", map {
-      qq(\$cur_row_ids{$_} = defined(\$cur_row_data->[$_]) ? \$cur_row_data->[$_] : "\0NULL\xFF\$rows_pos\xFF$_\0";)
-    } sort { $a <=> $b } keys %{ $stats->{idcols_seen} } )
+      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||[]} ) );
@@ -173,7 +181,9 @@ sub assemble_collapsing_parser {
     ( $_[1] and $rows_pos = -1 and $_[1]->() )
   ) ) {
 
-    # this code exists only when we are *not* assembling direct to HRI
+    # 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
@@ -250,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 || '{}',
     );
   }
@@ -259,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" : '',
       );
@@ -291,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;