view release on metacpan or  search on metacpan

lib/DBIO/ResultSet.pm  view on Meta::CPAN

              or
            ref $data->[$i]{$_} eq 'HASH'
              or
            ( defined blessed $data->[$i]{$_} and $data->[$i]{$_}->isa('DBIO::Row') )
          )
            and
          1
        )) {

          # moar sanity check... sigh
          for ( ref $data->[$i]{$_} eq 'ARRAY' ? @{$data->[$i]{$_}} : $data->[$i]{$_} ) {
            if ( defined blessed $_ and $_->isa('DBIO::Row' ) ) {
              carp_unique("Fast-path populate() with supplied related objects is not possible - falling back to regular create()");
              return my $throwaway = $self->populate(@_);
            }
          }

          push @$current_slice_seen_rel_infos, $rel_info->{$_};
        }
      }

      if ($current_slice_seen_rel_infos) {
        push @$slices_with_rels, $data->[$i];

        # this is needed further down to decide whether or not to fallback to create()
        $colinfo->{$_}{seen_null} ||= ! defined $data->[$i]{$_}
          for keys %{$data->[$i]};
      }
    }
    else {
      $self->throw_exception('Unexpected populate() data structure member type: ' . ref $data->[$i] );
    }

    if ( grep
      { $_->{attrs}{is_depends_on} }
      @{ $current_slice_seen_rel_infos || [] }
    ) {
      carp_unique("Fast-path populate() of belongs_to relationship data is not possible - falling back to regular create()");
      return my $throwaway = $self->populate(@_);
    }
  }

  if( $slices_with_rels ) {

    # need to exclude the rel "columns"
    $colnames = [ grep { ! $colinfo->{$_}{is_rel} } @$colnames ];

    # extra sanity check - ensure the main source is in fact identifiable
    # the localizing of nullability is insane, but oh well... the use-case is legit
    my $ci = $rsrc->columns_info($colnames);

    $ci->{$_} = { %{$ci->{$_}}, is_nullable => 0 }
      for grep { ! $colinfo->{$_}{seen_null} } keys %$ci;

    unless( $rsrc->_identifying_column_set($ci) ) {
      carp_unique("Fast-path populate() of non-uniquely identifiable rows with related data is not possible - falling back to regular create()");
      return my $throwaway = $self->populate(@_);
    }
  }

### inherit the data locked in the conditions of the resultset
  my ($rs_data) = $self->_merge_with_rscond({});
  delete @{$rs_data}{@$colnames};  # passed-in stuff takes precedence

  # if anything left - decompose rs_data
  my $rs_data_vals;
  if (keys %$rs_data) {
     push @$rs_data_vals, $rs_data->{$_}
      for sort keys %$rs_data;
  }

### start work
  my $guard;
  $guard = $rsrc->schema->storage->txn_scope_guard
    if $slices_with_rels;

### main source data
  # FIXME - need to switch entirely to a coderef-based thing,
  # so that large sets aren't copied several times... I think
  $rsrc->storage->_insert_bulk(
    $rsrc,
    [ @$colnames, sort keys %$rs_data ],
    [ map {
      ref $data->[$_] eq 'ARRAY'
      ? (
          $slices_with_rels ? [ @{$data->[$_]}[0..$#$colnames], @{$rs_data_vals||[]} ]  # the collist changed
        : $rs_data_vals     ? [ @{$data->[$_]}, @$rs_data_vals ]
        :                     $data->[$_]
      )
      : [ @{$data->[$_]}{@$colnames}, @{$rs_data_vals||[]} ]
    } $data_start .. $#$data ],
  );

### do the children relationships
  if ( $slices_with_rels ) {
    my @rels = grep { $colinfo->{$_}{is_rel} } keys %$colinfo
      or die 'wtf... please report a bug with DBIO_TRACE=1 output (stacktrace)';

    for my $sl (@$slices_with_rels) {

      my ($main_proto, $main_proto_rs);
      for my $rel (@rels) {
        next unless defined $sl->{$rel};

        $main_proto ||= {
          %$rs_data,
          (map { $_ => $sl->{$_} } @$colnames),
        };

        unless (defined $colinfo->{$rel}{rs}) {

          $colinfo->{$rel}{rs} = $rsrc->related_source($rel)->resultset;

          $colinfo->{$rel}{fk_map} = { reverse %{ $rsrc->_resolve_relationship_condition(
            rel_name => $rel,
            self_alias => "\xFE", # irrelevant
            foreign_alias => "\xFF", # irrelevant
          )->{identity_map} || {} } };

        }

lib/DBIO/ResultSet.pm  view on Meta::CPAN

    # since this is search_related, and we already slid the select window inwards
    # (the select/as attrs were deleted in the beginning), we need to flip all
    # left joins to inner, so we get the expected results
    # read the comment on top of the actual function to see what this does
    $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);


    #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
    delete @{$attrs}{qw(result_class alias)};

    my $rel_source = $rsrc->related_source($rel);

    my $new = do {

      # The reason we do this now instead of passing the alias to the
      # search_rs below is that if you wrap/overload resultset on the
      # source you need to know what alias it's -going- to have for things
      # to work sanely (e.g. RestrictWithObject wants to be able to add
      # extra query restrictions, and these may need to be $alias.)

      my $rel_attrs = $rel_source->resultset_attributes;
      local $rel_attrs->{alias} = $alias;

      $rel_source->resultset
                 ->search_rs(
                     undef, {
                       %$attrs,
                       where => $attrs->{where},
                   });
    };

    if (my $cache = $self->get_cache) {
      my @related_cache = map
        { $_->related_resultset($rel)->get_cache || () }
        @$cache
      ;

      $new->set_cache([ map @$_, @related_cache ]) if @related_cache == @$cache;
    }

    $new;
  };
}


sub current_source_alias {
  return (shift->{attrs} || {})->{alias} || 'me';
}


sub as_subselect_rs {
  my $self = shift;

  my $attrs = $self->_resolved_attrs;

  my $fresh_rs = (ref $self)->new (
    $self->result_source,
    {},
  );

  # these pieces will be locked in the subquery
  delete $fresh_rs->{cond};
  delete @{$fresh_rs->{attrs}}{qw/where bind/};

  return $fresh_rs->search( {}, {
    from => [{
      $attrs->{alias} => $self->as_query,
      -alias  => $attrs->{alias},
      -rsrc   => $self->result_source,
    }],
    alias => $attrs->{alias},
  });
}

# This code is called by search_related, and makes sure there
# is clear separation between the joins before, during, and
# after the relationship. This information is needed later
# in order to properly resolve prefetch aliases (any alias
# with a relation_chain_depth less than the depth of the
# current prefetch is not considered)
#
# The increments happen twice per join. An even number means a
# relationship specified via a search_related, whereas an odd
# number indicates a join/prefetch added via attributes
#
# Also this code will wrap the current resultset (the one we
# chain to) in a subselect IFF it contains limiting attributes
sub _chain_relationship {
  my ($self, $rel) = @_;
  my $source = $self->result_source;
  my $attrs = { %{$self->{attrs}||{}} };

  # we need to take the prefetch the attrs into account before we
  # ->_resolve_join as otherwise they get lost - captainL
  my $join = $self->_merge_joinpref_attr( $attrs->{join}, $attrs->{prefetch} );

  delete @{$attrs}{qw/join prefetch collapse group_by distinct _grouped_by_distinct select as columns +select +as +columns/};

  my $seen = { %{ (delete $attrs->{seen_join}) || {} } };

  my $from;
  my @force_subq_attrs = qw/offset rows group_by having/;

  if (
    ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
      ||
    $self->_has_resolved_attr (@force_subq_attrs)
  ) {
    # Nuke the prefetch (if any) before the new $rs attrs
    # are resolved (prefetch is useless - we are wrapping
    # a subquery anyway).
    my $rs_copy = $self->search;
    $rs_copy->{attrs}{join} = $self->_merge_joinpref_attr (
      $rs_copy->{attrs}{join},
      delete $rs_copy->{attrs}{prefetch},
    );

    $from = [{
      -rsrc   => $source,
      -alias  => $attrs->{alias},
      $attrs->{alias} => $rs_copy->as_query,