view release on metacpan or  search on metacpan

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

  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->();

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

    $guard->commit if $txn_wrap;

    return $ret;
  }

  return $self->_update_body($upd);
}

# Core update logic, extracted so OnColumnChange (above) can wrap it
# with before/around/after callbacks without mutual recursion.
sub _update_body {
  my ($self, $upd) = @_;

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

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

  $self->throw_exception( "Not in database" ) unless $self->in_storage;

  my $rows = $self->result_source->storage->update(
    $self->result_source, \%to_update, $self->_storage_ident_condition
  );
  if ($rows == 0) {
    $self->throw_exception( "Can't update ${self}: row not found" );
  } elsif ($rows > 1) {
    $self->throw_exception("Can't update ${self}: updated more than one row");
  }
  $self->{_dirty_columns} = {};
  $self->{related_resultsets} = {};
  delete $self->{_column_data_in_storage};

  # StorageValues (integrated helper): refresh snapshot post-UPDATE.
  $self->store_storage_values if @{$self->storage_value_columns};

  return $self;
}


sub delete {
  my $self = shift;
  if (ref $self) {
    $self->throw_exception( "Not in database" ) unless $self->in_storage;

    $self->result_source->storage->delete(
      $self->result_source, $self->_storage_ident_condition
    );

    delete $self->{_column_data_in_storage};
    $self->in_storage(0);
  }
  else {
    my $rsrc = try { $self->result_source_instance }
      or $self->throw_exception("Can't do class delete without a ResultSource instance");

    my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
    my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
    $rsrc->resultset->search(@_)->delete;
  }
  return $self;
}


sub get_column {
  my ($self, $column) = @_;
  $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;

  return $self->{_column_data}{$column}
    if exists $self->{_column_data}{$column};

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

Re-selects the row from the database, losing any changes that had
been made. Throws an exception if a proper C<WHERE> clause identifying
the database row can not be constructed (i.e. if the original object
does not contain its entire
L<primary key|DBIO::Manual::Intro/The Significance and Importance of Primary Keys>).

This method can also be used to refresh from storage, retrieving any
changes made since the row was last read from storage.

$attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
second argument to C<< $resultset->search($cond, $attrs) >>;

Note: If you are using L<DBIO::Replicated::Storage> as your storage, a default of
C<< { force_pool => 'master' } >> is automatically set for
you. Prior to C<< DBIO 0.08109 >> (before 2010) one would have been
required to explicitly wrap the entire operation in a transaction to guarantee
that up-to-date results are read from the master database.

=head2 throw_exception

See L<DBIO::Schema/throw_exception>.

=head2 TO_JSON

  my $hashref = $row->TO_JSON;

Returns a hashref of the row's column values suitable for JSON
serialization. Automatically excludes C<text>, C<ntext>, and C<blob>
columns unless C<< is_serializable => 1 >> is set in the column info.
Numeric columns are numified for correct JSON output.

=head2 self_rs

  my $rs = $row->self_rs;

Returns a ResultSet containing only this row, useful for applying
ResultSet methods to a single row.

=head2 StorageValues

Per-column opt-in snapshot of the values as last seen in storage.
Mark a column with C<< keep_storage_value => 1 >> and DBIO will record
its current stored value at C<new>, C<insert>, C<update> and
C<inflate_result> time. The snapshot uses the column accessor, so
inflated / filtered values are captured rather than raw storage values.

  __PACKAGE__->add_column(title => {
    data_type          => 'varchar',
    keep_storage_value => 1,
  });

  $row->title('New');
  $row->get_storage_value('title'); # the old value
  $row->update;
  $row->get_storage_value('title'); # now 'New'

=head2 OnColumnChange

Register C<before_column_change>, C<after_column_change>, and
C<around_column_change> callbacks on a Result class. Callbacks fire
from L</update> only if the named column is actually dirty. The "old"
value comes from L</get_storage_value>, so pair this with
C<< keep_storage_value => 1 >> on the column if you need a real
previous value; otherwise it will be C<undef>.

  __PACKAGE__->before_column_change(
    amount => { method => 'bank_transfer', txn_wrap => 1 },
  );

Callback signatures:

  before: $self->$method($old, $new)
  after:  $self->$method($old, $new)   # $old may now equal $new
  around: $self->$method($next, $old, $new)

C<before> callbacks fire in definition order, C<after> callbacks fire
in reverse order, C<around> callbacks wrap in definition order (the
innermost being the first declared). If any registered arg has
C<< txn_wrap => 1 >> the whole update is wrapped in a
C<txn_scope_guard>.

See L<DBIx::Class::Helper::Row::OnColumnChange/on_column_change_allow_override_args>
for C<on_column_change_allow_override_args> semantics.

=head2 ProxyResultSetMethod

Expose a C<with_foo> ResultSet method as a row accessor with a
transparent fallback: if the column was already selected via the
ResultSet method it is returned from the cached row data; otherwise
the ResultSet method is re-run for this row.

  package MyApp::Schema::ResultSet::Foo;
  sub with_friend_count { ... }

  package MyApp::Schema::Result::Foo;
  __PACKAGE__->proxy_resultset_method('friend_count');

  $foo_rs->first->friend_count;           # lazy fetch
  $foo_rs->with_friend_count->first->friend_count;  # cached

The generated accessor stores the fetched value under the slot name in
C<_column_data> as a cache. Proxied slots are excluded from C<copy>
and C<update> so they are never written as actual columns.

=head2 id

  my @pk = $result->id;

=over

=item Arguments: none

=item Returns: A list of primary key values

=back

Returns the primary key(s) for a row. Can't be called as a class method.
Actually implemented in L<DBIO::PK>

=head1 AUTHOR

DBIO & DBIx::Class Authors

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2026 DBIO Authors
Portions Copyright (C) 2005-2025 DBIx::Class Authors
Based on DBIx::Class, heavily modified.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut