view release on metacpan or  search on metacpan

lib/DBIx/QuickORM/Handle.pm  view on Meta::CPAN

    unless ($do_cache) {
        my $sth = $self->_make_sth($sql, no_rows => 1);
        $con->state_delete_row(source => $source, row => $row) if $row;
        return $sync ? () : $sth;
    }

    my $done = 0;
    my $rows;
    my $finish = sub {
        return if $done++;

        my ($dbh, $sth) = @_;
        my $source = $self->{+SOURCE};

        if ($rows) {
            $con->state_delete_row(source => $source, fetched => $_) for @$rows;
            return;
        }

        if ($row) {
            $con->state_delete_row(source => $source, row => $row);
            return;
        }

        if ($has_ret) {
            while (my $r = $sth->fetchrow_hashref) {
                $con->state_delete_row(source => $source, fetched => $r);
            }

            return;
        }

        confess "This error should be unreachable, please report it along with this dump:\n==== start ====\n" . debug($self) . "\n==== stop ====\n";
    };

    my $sth;
    if ($has_ret || $row) {
        $sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1);
    }
    else {
        croak "Cannot do an async delete without a specific row to delete on a database that does not support 'returning on delete'" unless $sync;

        $self->_internal_txn(
            sub {
                my $row_sql = $self->sql_builder->qorm_select(%$builder_args, fields => $has_pk);
                my ($row_sth, $row_res) = $self->_execute($self->{+CONNECTION}->dbh, $row_sql);
                $rows = $row_sth->fetchall_arrayref({});
                $sth = $self->_make_sth($sql, on_ready => $finish, no_rows => 1);
            },
            die => "Cannot delete without a specific row on a database that does not support 'returning on delete' when internal transactions are disabled",
        );
    }

    return $sth unless $sync;

    $finish->($sth->dbh, $sth->sth);

    return undef;
}

sub update {
    my $changes;
    my $self = shift->_row_or_hashref(sub {$changes = pop; $_[0]}, @_);

    my $con = $self->{+CONNECTION};
    $con->pid_and_async_check;

    croak "update() with data_only set is not currently supported"        if $self->{+DATA_ONLY};
    croak "update() with a 'limit' clause is not currently supported"     if $self->{+LIMIT};
    croak "update() with an 'order_by' clause is not currently supported" if $self->{+ORDER_BY};

    my $row = $self->{+ROW};
    if ($changes) {
        if ($row) {
            if (my $pending = $row->pending_data) {
                croak "Attempt to update row with pending changes and additional changes"
                    if $changes && $pending && keys(%$changes) && keys(%$pending);
            }
        }
    }
    elsif ($row) {
        $changes = $row->pending_data;
    }

    croak "No changes for update"                    unless $changes;
    croak "Changes must be a hashref (got $changes)" unless ref($changes) eq 'HASH';
    croak "Changes may not be empty"                 unless keys %$changes;

    my $sync              = $self->is_sync;
    my $dialect           = $self->dialect;
    my $pk_fields         = $self->_has_pk;
    my $builder_args      = $self->_builder_args;
    my $source            = $self->{+SOURCE};
    my $do_cache          = $pk_fields && @$pk_fields && $con->state_does_cache;
    my $changes_pk_fields = $pk_fields ? (grep { $changes->{$_} } @$pk_fields) : ();

    my $sql = $self->sql_builder->qorm_update(%$builder_args, update => $changes);

    # No cache, or not cachable, just do the update
    unless ($do_cache) {
        my $sth = $self->_make_sth($sql, no_rows => 1);
        return $sth unless $sync;
        return;
    }

    my $handle_row = sub {
        my ($row) = @_;

        my ($old_pk, $new_pk, $fetched);
        if (blessed($row)) {
            $old_pk = $changes_pk_fields ? [ $row->primary_key_value_list ] : undef;
            $fetched = { %{$row->stored_data}, %$changes};
        }
        else {
            $old_pk = $changes_pk_fields ? [ map { $row->{$_} } @$pk_fields ] : undef;
            $fetched = { %$row, %$changes };
        }

        $new_pk = $changes_pk_fields ? [ map { $fetched->{$_} } @$pk_fields ] : undef;

        $con->state_update_row(old_primary_key => $old_pk, new_primary_key => $new_pk, fetched => $fetched, source => $source);