view release on metacpan or  search on metacpan

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

  return $self;
}

# Row-level mirror of DBIO::ResultSet::_rs_run_async (ADR 0030/0031): route to a
# live embedded backend, degrade synchronously in the 'immediate' mode, or croak
# on a sync instance.
sub _row_run_async {
  my ($self, $name, $backend_build, $sync_run) = @_;

  my $storage = $self->result_source->storage;
  my $fc = $storage->future_class;

  if (my $backend = $storage->_async_storage) {
    return $backend_build->($backend, $fc);
  }

  $self->throw_exception(
    "not an async connection -- connect with { async => ... } to use ${name}_async"
  ) unless defined $storage->_async_mode;

  my @r = eval { $sync_run->() };
  return $@ ? $fc->fail($@) : $fc->done(@r);
}


sub insert_async {
  my $self = shift;

  return $self->_row_run_async('insert',
    sub {
      my ($backend, $fc) = @_;

      my $rsrc = $self->result_source;
      $self->throw_exception("No result_source set on this object; can't insert")
        unless $rsrc;

      return $fc->done($self) if $self->in_storage;

      # Related-object multi-create is a multi-statement (and transactional)
      # cascade, not a single insert_async; run it synchronously and resolve.
      if ( %{ $self->{_relationship_data} || {} }
             or
           %{ $self->{_inflated_column} || {} } ) {
        my $r = eval { $self->insert };
        return $@ ? $fc->fail($@) : $fc->done($r);
      }

      my %current_rowdata = $self->get_columns;
      return $backend->insert_async( $rsrc, { %current_rowdata } )->then(sub {
        my ($returned_cols) = @_;
        $self->_store_inserted_columns(\%current_rowdata, $returned_cols);
        $self->store_storage_values if @{$self->storage_value_columns};
        return $self;
      });
    },
    sub { $self->insert },
  );
}


sub update {
  my ($self, $upd) = @_;

  # ProxyResultSetMethod (integrated helper): strip proxy slots from the
  # dirty-column set so UPDATE statements never include them. "delete
  # local" localises the deletion for the scope of this sub, so the
  # original dirty flags are restored when update returns.
  $self->{_dirty_columns} ||= {};
  delete local @{$self->{_dirty_columns}}{@{$self->_proxy_slots||[]}};

  # OnColumnChange (integrated helper): short-circuit when nothing is
  # registered. When callbacks exist, build the before/around/after
  # chain, then delegate to _update_body via around-wrapper; the whole
  # orchestration is a no-op if none of the registered columns are dirty.
  my $has_change_cbs =
       $self->_before_change
    || $self->_around_change
    || $self->_after_change;

  if ($has_change_cbs) {
    $self->set_inflated_columns($upd) if $upd;

    my %dirty = $self->get_dirty_columns
      or return $self;

    my @all_before = @{$self->_before_change || []};
    my @all_around = @{$self->_around_change || []};
    my @all_after  = @{$self->_after_change  || []};

    my @before = grep { defined $dirty{$_->{column}} } @all_before;
    my @around = grep { defined $dirty{$_->{column}} } @all_around;
    my @after  = grep { defined $dirty{$_->{column}} } @all_after;

    my $allow_override = $self->on_column_change_allow_override_args;
    my $final = $allow_override
      ? sub { $self->_update_body }
      : sub { $self->_update_body($upd) };

    for (reverse @around) {
      my $fn  = $_->{method};
      my $old = $self->get_storage_value($_->{column});
      my $new = $dirty{$_->{column}};
      my $old_final = $final;
      $final = sub { $self->$fn($old_final, $old, $new) };
    }

    my $txn_wrap = List::Util::first {
      defined $dirty{$_->{column}} && $_->{txn_wrap}
    } @all_before, @all_around, @all_after;

    my $guard;
    $guard = $self->result_source->schema->txn_scope_guard if $txn_wrap;

    for (@before) {
      my $fn  = $_->{method};
      my $old = $self->get_storage_value($_->{column});
      my $new = $dirty{$_->{column}};
      $self->$fn($old, $new);
    }

    my $ret = $final->();

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

        if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$rel_name}[0] || {}} ) {
          $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
          $rel_name,
          $colname,
        }

        $rsrc->throw_exception($err);
      };

      $class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
        unless $relinfo->{attrs}{accessor};

      my $rel_rs = $new->related_resultset($rel_name);

      my @rel_objects;
      if (
        @{ $prefetch->{$rel_name} || [] }
          and
        ref($prefetch->{$rel_name}) ne $DBIO::ResultSource::RowParser::Util::null_branch_class
      ) {

        if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
          my $rel_rsrc = $rel_rs->result_source;
          my $rel_class = $rel_rs->result_class;
          my $rel_inflator = $rel_class->can('inflate_result');
          @rel_objects = map
            { $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
            @{$prefetch->{$rel_name}}
          ;
        }
        else {
          @rel_objects = $rel_rs->result_class->inflate_result(
            $rel_rs->result_source, @{$prefetch->{$rel_name}}
          );
        }
      }

      if ($relinfo->{attrs}{accessor} eq 'single') {
        $new->{_relationship_data}{$rel_name} = $rel_objects[0];
      }
      elsif ($relinfo->{attrs}{accessor} eq 'filter') {
        $new->{_inflated_column}{$rel_name} = $rel_objects[0];
      }

      $rel_rs->set_cache(\@rel_objects);
    }
  }

  $new->in_storage (1);

  # StorageValues (integrated helper): snapshot freshly-inflated values.
  $new->store_storage_values if @{$new->storage_value_columns};

  return $new;
}


sub insert_or_update { shift->update_or_insert(@_) }


sub update_or_insert {
  my $self = shift;
  return ($self->in_storage ? $self->update : $self->insert);
}


sub is_changed {
  return keys %{shift->{_dirty_columns} || {}};
}


sub is_column_changed {
  my( $self, $col ) = @_;
  return exists $self->{_dirty_columns}->{$col};
}


sub result_source {
  $_[0]->throw_exception( 'result_source can be called on instances only' )
    unless ref $_[0];

  @_ > 1
    ? $_[0]->{_result_source} = $_[1]

    # note this is a || not a ||=, the difference is important
    : $_[0]->{_result_source} || do {
        my $class = ref $_[0];
        $_[0]->can('result_source_instance')
          ? $_[0]->result_source_instance
          : $_[0]->throw_exception(
            "No result source instance registered for $class, did you forget to call $class->table(...) ?"
          )
      }
  ;
}


sub register_column {
  my ($class, $col, $info) = @_;
  my $acc = $col;
  if (exists $info->{accessor}) {
    return unless defined $info->{accessor};
    $acc = [ $info->{accessor}, $col ];
  }
  $class->mk_group_accessors('column' => $acc);
}


sub get_from_storage {
    my $self = shift @_;
    my $attrs = shift @_;
    my $resultset = $self->result_source->resultset;

    if(defined $attrs) {
      $resultset = $resultset->search(undef, $attrs);
    }

    return $resultset->find($self->_storage_ident_condition);
}