view release on metacpan or  search on metacpan

lib/DBIO/Sybase/Storage/ASE.pm  view on Meta::CPAN

  my $need_dumb_last_insert_id = (
    $self->_perform_autoinc_retrieval
      &&
    ($self->_identity_method||'') ne '@@IDENTITY'
  );

  my $next = $self->next::can;

  # we are already in a transaction, or there are no blobs
  # and we don't need the PK - just (try to) do it
  if ($self->{transaction_depth}
        || (!$blob_cols && !$need_dumb_last_insert_id)
  ) {
    return $self->_insert (
      $next, $source, $to_insert, $blob_cols, $identity_col, \%lob_values,
      \%defaulted
    );
  }

  # otherwise use the _writer_storage to do the insert+transaction on another
  # connection
  my $guard = $self->_writer_storage->txn_scope_guard;

  my $updated_cols = $self->_writer_storage->_insert (
    $next, $source, $to_insert, $blob_cols, $identity_col, \%lob_values,
    \%defaulted
  );

  $self->_identity($self->_writer_storage->_identity);

  $guard->commit;

  return $updated_cols;
}

sub _insert {
  my ($self, $next, $source, $to_insert, $blob_cols, $identity_col, $lob_values, $defaulted) = @_;

  my $updated_cols = $self->$next ($source, $to_insert);

  my $final_row = {
    ($identity_col ?
      ($identity_col => $self->last_insert_id($source, $identity_col)) : ()),
    %$to_insert,
    %$updated_cols,
  };

  $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;

  # the values of the TEXT/IMAGE columns, not their placeholders: see insert
  @{$updated_cols}{ keys %$lob_values } = values %$lob_values;

  # The DEFAULT literals insert wrote for an empty insert are not values of the
  # row: the object holds the primary key and reads the rest on demand, as
  # after create({}) on every other driver (karr k84).
  delete @{$updated_cols}{ keys %{ $defaulted || {} } };

  return $updated_cols;
}

sub update {
  my $self = shift;

  # the writer storage is made by _init, at the first connect (karr k67)
  $self->_get_dbh;

  my ($source, $fields, $where, @rest) = @_;

  # The hash is the caller's: _remove_blob_cols and the delete below work on a
  # copy, which is also what next::method gets (karr k83).
  $fields = { %$fields };
  @_ = ($source, $fields, $where, @rest);

  #
  # When *updating* identities, ASE requires SET IDENTITY_UPDATE called
  #
  if (my $blob_cols = $self->_remove_blob_cols($source, $fields)) {

    # If there are any blobs in $where, Sybase will return a descriptive error
    # message.
    # XXX blobs can still be used with a LIKE query, and this should be handled.

    # update+blob update(s) done atomically on separate connection
    $self = $self->_writer_storage;

    my $guard = $self->txn_scope_guard;

    # First update the blob columns to be updated to '' (taken from $fields, where
    # it is originally put by _remove_blob_cols .)
    my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols;

    # We can't only update NULL blobs, because blobs cannot be in the WHERE clause.
    # Its row count is the one to return when no other column is left to set:
    # $where hit that many rows, and the content write below is aimed at the
    # same rows with the same $where, so it has no count of its own (it returns
    # none). DBIO::Row::update takes a false count for "row not found" (k82).
    my $rv = $self->next::method($source, \%blobs_to_empty, $where, @rest);

    # Now update the blobs before the other columns in case the update of other
    # columns makes the search condition invalid.
    $self->_update_blobs($source, $blob_cols, $where);

    if (keys %$fields) {

      # Now set the identity update flags for the actual update
      local $self->{_autoinc_supplied_for_op} = grep
        { $_->{is_auto_increment} }
        values %{ $source->columns_info([ keys %$fields ]) }
      ;

      my $next = $self->next::can;
      my $args = \@_;
      return preserve_context {
        $self->$next(@$args);
      } after => sub { $guard->commit };
    }
    else {
      $guard->commit;
      return $rv;
    }
  }