lib/DBIx/Class/ResultSource/RowParser.pm

   1 package # hide from the pauses
   2   DBIx::Class::ResultSource::RowParser;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base 'DBIx::Class';
   8
   9 use DBIx::Class::ResultSource::RowParser::Util qw(
  10   assemble_simple_parser
  11   assemble_collapsing_parser
  12 );
  13 use DBIx::Class::_Util 'DUMMY_ALIASPAIR';
  14
  15 use DBIx::Class::Carp;
  16
  17 use namespace::clean;
  18
  19 # Accepts a prefetch map (one or more relationships for the current source),
  20 # returns a set of select/as pairs for each of those relationships. Columns
  21 # are fully qualified inflation_slot names
  22 sub _resolve_selection_from_prefetch {
  23   my ($self, $pre, $alias_map, $pref_path) = @_;
  24
  25   # internal recursion marker
  26   $pref_path ||= [];
  27
  28   if (not defined $pre or not length $pre) {
  29     return ();
  30   }
  31   elsif( ref $pre eq 'ARRAY' ) {
  32     map { $self->_resolve_selection_from_prefetch( $_, $alias_map, [ @$pref_path ] ) }
  33       @$pre;
  34   }
  35   elsif( ref $pre eq 'HASH' ) {
  36     map {
  37       $self->_resolve_selection_from_prefetch($_, $alias_map, [ @$pref_path ] ),
  38       $self->related_source($_)->_resolve_selection_from_prefetch(
  39          $pre->{$_}, $alias_map, [ @$pref_path, $_] )
  40     } keys %$pre;
  41   }
  42   elsif( ref $pre ) {
  43     $self->throw_exception(
  44       "don't know how to resolve prefetch reftype ".ref($pre));
  45   }
  46   else {
  47     my $p = $alias_map;
  48     $p = $p->{$_} for @$pref_path, $pre;
  49
  50     $self->throw_exception (
  51       "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: "
  52       . join (' -> ', @$pref_path, $pre)
  53     ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
  54
  55     # this shift() is critical - it is what allows prefetch => [ (foo) x 2 ] to work
  56     my $src_alias = shift @{$p->{-join_aliases}};
  57
  58     # ordered [select => as] pairs
  59     map { [
  60       "${src_alias}.$_" => join ( '.',
  61         @$pref_path,
  62         $pre,
  63         $_,
  64       )
  65     ] } $self->related_source($pre)->columns;
  66   }
  67 }
  68
  69 sub _resolve_prefetch {
  70   carp_unique(
  71     'There is no good reason to call this internal deprecated method - '
  72   . 'please open a ticket detailing your usage, so that a better plan can '
  73   . 'be devised for your case. In either case _resolve_prefetch() is '
  74   . 'deprecated in favor of _resolve_selection_from_prefetch(), which has '
  75   . 'a greatly simplified arglist.'
  76   );
  77
  78   $_[0]->_resolve_selection_from_prefetch( $_[1], $_[3] );
  79 }
  80
  81
  82 # Takes an arrayref of {as} dbic column aliases and the collapse and select
  83 # attributes from the same $rs (the selector requirement is a temporary
  84 # workaround... I hope), and returns a coderef capable of:
  85 # my $me_pref_clps = $coderef->([$rs->cursor->next/all])
  86 # Where the $me_pref_clps arrayref is the future argument to inflate_result()
  87 #
  88 # For an example of this coderef in action (and to see its guts) look at
  89 # t/resultset/rowparser_internals.t
  90 #
  91 # This is a huge performance win, as we call the same code for every row
  92 # returned from the db, thus avoiding repeated method lookups when traversing
  93 # relationships
  94 #
  95 # Also since the coderef is completely stateless (the returned structure is
  96 # always fresh on every new invocation) this is a very good opportunity for
  97 # memoization if further speed improvements are needed
  98 #
  99 # The way we construct this coderef is somewhat fugly, although the result is
 100 # really worth it. The final coderef does not perform any kind of recursion -
 101 # the entire nested structure constructor is rolled out into a single scope.
 102 #
 103 # In any case - the output of this thing is meticulously micro-tested, so
 104 # any sort of adjustment/rewrite should be relatively easy (fsvo relatively)
 105 #
 106 sub _mk_row_parser {
 107   # $args and $attrs are separated to delineate what is core collapser stuff and
 108   # what is dbic $rs specific
 109   my ($self, $args, $attrs) = @_;
 110
 111   die "HRI without pruning makes zero sense"
 112   if ( $args->{hri_style} && ! $args->{prune_null_branches} );
 113
 114   my %common = (
 115     hri_style => $args->{hri_style},
 116     prune_null_branches => $args->{prune_null_branches},
 117     val_index => { map
 118       { $args->{inflate_map}[$_] => $_ }
 119       ( 0 .. $#{$args->{inflate_map}} )
 120     },
 121   );
 122
 123   my $src = (! $args->{collapse} ) ? assemble_simple_parser(\%common) : do {
 124     my $collapse_map = $self->_resolve_collapse ({
 125       # FIXME
 126       # only consider real columns (not functions) during collapse resolution
 127       # this check shouldn't really be here, as fucktards are not supposed to
 128       # alias random crap to existing column names anyway, but still - just in
 129       # case
 130       # FIXME !!!! - this does not yet deal with unbalanced selectors correctly
 131       # (it is now trivial as the attrs specify where things go out of sync
 132       # needs MOAR tests)
 133       as => { map
 134         { ref $attrs->{select}[$common{val_index}{$_}] ? () : ( $_ => $common{val_index}{$_} ) }
 135         keys %{$common{val_index}}
 136       },
 137       premultiplied => $args->{premultiplied},
 138     });
 139
 140     assemble_collapsing_parser({
 141       %common,
 142       collapse_map => $collapse_map,
 143     });
 144   };
 145
 146   utf8::upgrade($src)
 147     if DBIx::Class::_ENV_::STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE;
 148
 149   $src;
 150 }
 151
 152
 153 # Takes an arrayref selection list and generates a collapse-map representing
 154 # row-object fold-points. Every relationship is assigned a set of unique,
 155 # non-nullable columns (which may *not even be* from the same resultset)
 156 # and the collapser will use this information to correctly distinguish
 157 # data of individual to-be-row-objects. See t/resultset/rowparser_internals.t
 158 # for extensive RV examples
 159 sub _resolve_collapse {
 160   my ($self, $args, $common_args) = @_;
 161
 162   # for comprehensible error messages put ourselves at the head of the relationship chain
 163   $args->{_rel_chain} ||= [ $self->source_name ];
 164
 165   # record top-level fully-qualified column index, signify toplevelness
 166   unless ($common_args->{_as_fq_idx}) {
 167     $common_args->{_as_fq_idx} = { %{$args->{as}} };
 168     $args->{_is_top_level} = 1;
 169   };
 170
 171   my ($my_cols, $rel_cols, $native_cols);
 172   for (keys %{$args->{as}}) {
 173     if ($_ =~ /^ ([^\.]+) \. (.+) /x) {
 174       $rel_cols->{$1}{$2} = 1;
 175     }
 176     else {
 177       $native_cols->{$_} = $my_cols->{$_} = {};  # important for ||='s below
 178     }
 179   }
 180
 181   my $relinfo;
 182   # run through relationships, collect metadata
 183   for my $rel (keys %$rel_cols) {
 184     my $inf = $self->relationship_info ($rel);
 185
 186     $relinfo->{$rel} = {
 187       is_single => ( $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi' ),
 188       is_inner => ( ( $inf->{attrs}{join_type} || '' ) !~ /^left/i),
 189       rsrc => $self->related_source($rel),
 190       fk_map => $self->_resolve_relationship_condition(
 191         rel_name => $rel,
 192
 193         # an API where these are optional would be too cumbersome,
 194         # instead always pass in some dummy values
 195         DUMMY_ALIASPAIR,
 196       )->{identity_map},
 197     };
 198   }
 199
 200   # inject non-left fk-bridges from *INNER-JOINED* children (if any)
 201   for my $rel (grep { $relinfo->{$_}{is_inner} } keys %$relinfo) {
 202     my $ri = $relinfo->{$rel};
 203     for (keys %{$ri->{fk_map}} ) {
 204       # need to know source from *our* pov, hence $rel.col
 205       $my_cols->{$_} ||= { via_fk => "$rel.$ri->{fk_map}{$_}" }
 206         if defined $rel_cols->{$rel}{$ri->{fk_map}{$_}} # in fact selected
 207     }
 208   }
 209
 210   # if the parent is already defined *AND* we have an inner reverse relationship
 211   # (i.e. do not exist without it) , assume all of its related FKs are selected
 212   # (even if they in fact are NOT in the select list). Keep a record of what we
 213   # assumed, and if any such phantom-column becomes part of our own collapser,
 214   # throw everything assumed-from-parent away and replace with the collapser of
 215   # the parent (whatever it may be)
 216   my $assumed_from_parent;
 217   if ( ! $args->{_parent_info}{underdefined} and ! $args->{_parent_info}{rev_rel_is_optional} ) {
 218     for my $col ( values %{$args->{_parent_info}{rel_condition} || {}} ) {
 219       next if exists $my_cols->{$col};
 220       $my_cols->{$col} = {};
 221       $assumed_from_parent->{columns}{$col}++;
 222     }
 223   }
 224
 225   # get colinfo for everything
 226   if ($my_cols) {
 227     my $ci = $self->columns_info;
 228     $my_cols->{$_}{colinfo} = $ci->{$_} for keys %$my_cols;
 229   }
 230
 231   my $collapse_map;
 232
 233   # first try to reuse the parent's collapser (i.e. reuse collapser over 1:1)
 234   # (makes for a leaner coderef later)
 235   if(
 236     ! $collapse_map->{-identifying_columns}
 237       and
 238     $args->{_parent_info}{collapser_reusable}
 239   ) {
 240     $collapse_map->{-identifying_columns} = $args->{_parent_info}{collapse_on_idcols}
 241   }
 242
 243   # Still don't know how to collapse - in case we are a *single* relationship
 244   # AND our parent is defined AND we have any *native* non-nullable pieces: then
 245   # we are still good to go
 246   # NOTE: it doesn't matter if the nonnullable set is unique or not - it will be
 247   # made unique by the parents identifying cols
 248   if(
 249     ! $collapse_map->{-identifying_columns}
 250       and
 251     $args->{_parent_info}{is_single}
 252       and
 253     @{ $args->{_parent_info}{collapse_on_idcols} }
 254       and
 255     ( my @native_nonnull_cols = grep {
 256       $native_cols->{$_}{colinfo}
 257         and
 258       ! $native_cols->{$_}{colinfo}{is_nullable}
 259     } keys %$native_cols )
 260   ) {
 261
 262     $collapse_map->{-identifying_columns} = [ __unique_numlist(
 263       @{ $args->{_parent_info}{collapse_on_idcols}||[] },
 264
 265       # FIXME - we don't really need *all* of the columns, $our_nonnull_cols[0]
 266       # is sufficient. However map the entire thing to engage the extra nonnull
 267       # explicit checks, just to be on the safe side
 268       # Remove some day in the future
 269       (map
 270         {
 271           $common_args->{_as_fq_idx}{join ('.',
 272             @{$args->{_rel_chain}}[1 .. $#{$args->{_rel_chain}}],
 273             $_,
 274           )}
 275         }
 276         @native_nonnull_cols
 277       ),
 278     )];
 279   }
 280
 281   # Still don't know how to collapse - try to resolve based on our columns (plus already inserted FK bridges)
 282   if (
 283     ! $collapse_map->{-identifying_columns}
 284       and
 285     $my_cols
 286       and
 287     my $idset = $self->_identifying_column_set ({map { $_ => $my_cols->{$_}{colinfo} } keys %$my_cols})
 288   ) {
 289     # see if the resulting collapser relies on any implied columns,
 290     # and fix stuff up if this is the case
 291     my @reduced_set = grep { ! $assumed_from_parent->{columns}{$_} } @$idset;
 292
 293     $collapse_map->{-identifying_columns} = [ __unique_numlist(
 294       @{ $args->{_parent_info}{collapse_on_idcols}||[] },
 295
 296       (map
 297         {
 298           my $fqc = join ('.',
 299             @{$args->{_rel_chain}}[1 .. $#{$args->{_rel_chain}}],
 300             ( $my_cols->{$_}{via_fk} || $_ ),
 301           );
 302
 303           $common_args->{_as_fq_idx}->{$fqc};
 304         }
 305         @reduced_set
 306       ),
 307     )];
 308   }
 309
 310   # Stil don't know how to collapse - keep descending down 1:1 chains - if
 311   # a related non-LEFT 1:1 is resolvable - its condition will collapse us
 312   # too
 313   unless ($collapse_map->{-identifying_columns}) {
 314     my @candidates;
 315
 316     for my $rel (keys %$relinfo) {
 317       next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner});
 318
 319       if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse ({
 320         as => $rel_cols->{$rel},
 321         _rel_chain => [ @{$args->{_rel_chain}}, $rel ],
 322         _parent_info => { underdefined => 1 },
 323       }, $common_args)) {
 324         push @candidates, $rel_collapse->{-identifying_columns};
 325       }
 326     }
 327
 328     # get the set with least amount of columns
 329     # FIXME - maybe need to implement a data type order as well (i.e. prefer several ints
 330     # to a single varchar)
 331     if (@candidates) {
 332       ($collapse_map->{-identifying_columns}) = sort { scalar @$a <=> scalar @$b } (@candidates);
 333     }
 334   }
 335
 336   # Stil don't know how to collapse, and we are the root node. Last ditch
 337   # effort in case we are *NOT* premultiplied.
 338   # Run through *each multi* all the way down, left or not, and all
 339   # *left* singles (a single may become a multi underneath) . When everything
 340   # gets back see if all the rels link to us definitively. If this is the
 341   # case we are good - either one of them will define us, or if all are NULLs
 342   # we know we are "unique" due to the "non-premultiplied" check
 343   if (
 344     ! $collapse_map->{-identifying_columns}
 345       and
 346     ! $args->{premultiplied}
 347       and
 348     $args->{_is_top_level}
 349   ) {
 350     my (@collapse_sets, $uncollapsible_chain);
 351
 352     for my $rel (keys %$relinfo) {
 353
 354       # we already looked at these higher up
 355       next if ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner});
 356
 357       if (my $clps = $relinfo->{$rel}{rsrc}->_resolve_collapse ({
 358         as => $rel_cols->{$rel},
 359         _rel_chain => [ @{$args->{_rel_chain}}, $rel ],
 360         _parent_info => { underdefined => 1 },
 361       }, $common_args) ) {
 362
 363         # for singles use the idcols wholesale (either there or not)
 364         if ($relinfo->{$rel}{is_single}) {
 365           push @collapse_sets, $clps->{-identifying_columns};
 366         }
 367         elsif (! $relinfo->{$rel}{fk_map}) {
 368           $uncollapsible_chain = 1;
 369           last;
 370         }
 371         else {
 372           my $defined_cols_parent_side;
 373
 374           for my $fq_col ( grep { /^$rel\.[^\.]+$/ } keys %{$args->{as}} ) {
 375             my ($col) = $fq_col =~ /([^\.]+)$/;
 376
 377             $defined_cols_parent_side->{$_} = $args->{as}{$fq_col} for grep
 378               { $relinfo->{$rel}{fk_map}{$_} eq $col }
 379               keys %{$relinfo->{$rel}{fk_map}}
 380             ;
 381           }
 382
 383           if (my $set = $self->_identifying_column_set([ keys %$defined_cols_parent_side ]) ) {
 384             push @collapse_sets, [ sort map { $defined_cols_parent_side->{$_} } @$set ];
 385           }
 386           else {
 387             $uncollapsible_chain = 1;
 388             last;
 389           }
 390         }
 391       }
 392       else {
 393         $uncollapsible_chain = 1;
 394         last;
 395       }
 396     }
 397
 398     unless ($uncollapsible_chain) {
 399       # if we got here - we are good to go, but the construction is tricky
 400       # since our children will want to include our collapse criteria - we
 401       # don't give them anything (safe, since they are all collapsible on their own)
 402       # in addition we record the individual collapse possibilities
 403       # of all left children node collapsers, and merge them in the rowparser
 404       # coderef later
 405       $collapse_map->{-identifying_columns} = [];
 406       $collapse_map->{-identifying_columns_variants} = [ sort {
 407         (scalar @$a) <=> (scalar @$b)
 408           or
 409         (
 410           # Poor man's max()
 411           ( sort { $b <=> $a } @$a )[0]
 412             <=>
 413           ( sort { $b <=> $a } @$b )[0]
 414         )
 415       } @collapse_sets ];
 416     }
 417   }
 418
 419   # stop descending into children if we were called by a parent for first-pass
 420   # and don't despair if nothing was found (there may be other parallel branches
 421   # to dive into)
 422   if ($args->{_parent_info}{underdefined}) {
 423     return $collapse_map->{-identifying_columns} ? $collapse_map : undef
 424   }
 425   # nothing down the chain resolved - can't calculate a collapse-map
 426   elsif (! $collapse_map->{-identifying_columns}) {
 427     $self->throw_exception ( sprintf
 428       "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns",
 429       $self->source_name,
 430       @{$args->{_rel_chain}} > 1
 431         ? sprintf (' (last member of the %s chain)', join ' -> ', @{$args->{_rel_chain}} )
 432         : ''
 433       ,
 434     );
 435   }
 436
 437   # If we got that far - we are collapsable - GREAT! Now go down all children
 438   # a second time, and fill in the rest
 439
 440   $collapse_map->{-identifying_columns} = [ __unique_numlist(
 441     @{ $args->{_parent_info}{collapse_on_idcols}||[] },
 442     @{ $collapse_map->{-identifying_columns} },
 443   )];
 444
 445   for my $rel (sort keys %$relinfo) {
 446
 447     $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ({
 448       as => { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) },
 449       _rel_chain => [ @{$args->{_rel_chain}}, $rel],
 450       _parent_info => {
 451         # shallow copy
 452         collapse_on_idcols => [ @{$collapse_map->{-identifying_columns}} ],
 453
 454         rel_condition => $relinfo->{$rel}{fk_map},
 455
 456         is_optional => ! $relinfo->{$rel}{is_inner},
 457
 458         is_single => $relinfo->{$rel}{is_single},
 459
 460         # if there is at least one *inner* reverse relationship ( meaning identity-only )
 461         # we can safely assume that the child can not exist without us
 462         rev_rel_is_optional => (
 463           ( grep {
 464             ($_->{attrs}{join_type}||'') !~ /^left/i
 465           } values %{ $self->reverse_relationship_info($rel) } )
 466             ? 0
 467             : 1
 468         ),
 469
 470         # if this is a 1:1 our own collapser can be used as a collapse-map
 471         # (regardless of left or not)
 472         collapser_reusable => (
 473           $relinfo->{$rel}{is_single}
 474             &&
 475           $relinfo->{$rel}{is_inner}
 476             &&
 477           @{$collapse_map->{-identifying_columns}}
 478         ) ? 1 : 0,
 479       },
 480     }, $common_args );
 481
 482     $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single};
 483     $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner};
 484   }
 485
 486   return $collapse_map;
 487 }
 488
 489 # adding a dep on MoreUtils *just* for this is retarded
 490 sub __unique_numlist {
 491   sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }}
 492 }
 493
 494 1;