view release on metacpan or  search on metacpan

lib/DBIx/Lite/ResultSet.pm  view on Meta::CPAN

        # would return the wrong values
        $self = $self->select_also(@pk);
    }
    
    return $self->select_sth;
}

sub insert_sql {
    my $self = shift;
    my $insert_cols = shift;
    ref $insert_cols eq 'HASH' or croak "insert_sql() requires a hashref";
    
    if (@{$self->{joins}}) {
        warn "Attempt to call ->insert() after joining other tables\n";
    }
    
    if (!%$insert_cols && $self->{dbix_lite}->driver_name eq 'Pg') {
        # Postgres doesn't support the VALUES () syntax
        return sprintf "INSERT INTO %s DEFAULT VALUES",
            $self->{dbix_lite}->_quote($self->{table}{name});
    }
    
    return $self->{dbix_lite}->{abstract}->insert(
        $self->{table}{name}, $insert_cols,
    );
}

sub insert_sth {
    my $self = shift;
    my $insert_cols = shift;
    ref $insert_cols eq 'HASH' or croak "insert_sth() requires a hashref";
    
    my ($sql, @bind) = $self->insert_sql($insert_cols);
    return $self->{dbix_lite}->dbh->prepare($sql) || undef, @bind;
}

sub insert {
    my $self = shift;
    my $insert_cols = shift;
    ref $insert_cols eq 'HASH' or croak "insert() requires a hashref";
    
    # perform operation
    my $res;
    $self->{dbix_lite}->dbh_do(sub {
        my ($sth, @bind) = $self->insert_sth($insert_cols);
        $res = $sth->execute(@bind);
    });
    return undef if !$res;
    
    # populate the autopk field if any
    if (my $pk = $self->{table}->autopk) {
        $insert_cols = clone $insert_cols;
        $insert_cols->{$pk} = $self->{dbix_lite}->_autopk($self->{table}{name})
            if !exists $insert_cols->{$pk};
    }
    
    # return a DBIx::Lite::Row object with the inserted values
    return $self->_inflate_row($insert_cols);
}

sub update_sql {
    my $self = shift;
    my $update_cols = shift;
    ref $update_cols eq 'HASH' or croak "update_sql() requires a hashref";
    
    my $update_where = { -and => $self->{where} };
    
    if ($self->{cur_table}{name} ne $self->{table}{name}) {
        my @pk = $self->{cur_table}->pk
            or croak "No primary key defined for " . $self->{cur_table}{name} . "; cannot update using relationships";
        @pk == 1
            or croak "Update across relationships is not allowed with multi-column primary keys";
        
        my $fq_pk = $self->_table_alias($self->{cur_table}{name}, 'update') . "." . $pk[0];
        $update_where = {
            $fq_pk => {
                -in => \[ $self->select($pk[0])->select_sql ],
            },
        };
    }
    
    return $self->{dbix_lite}->{abstract}->update(
        -table  => $self->_table_alias_expr($self->{cur_table}{name}, 'update'),
        -set    => $update_cols,
        -where  => $update_where,
    );
}

sub update_sth {
    my $self = shift;
    my $update_cols = shift;
    ref $update_cols eq 'HASH' or croak "update_sth() requires a hashref";
    
    my ($sql, @bind) = $self->update_sql($update_cols);
    return $self->{dbix_lite}->dbh->prepare($sql) || undef, @bind;
}

sub update {
    my $self = shift;
    my $update_cols = shift;
    ref $update_cols eq 'HASH' or croak "update() requires a hashref";
    
    my $affected_rows;
    $self->{dbix_lite}->dbh_do(sub {
        my ($sth, @bind) = $self->update_sth($update_cols);
        $affected_rows = $sth->execute(@bind);
    });
    return $affected_rows;
}

sub find_or_insert {
    my $self = shift;
    my $cols = shift;
    ref $cols eq 'HASH' or croak "find_or_insert() requires a hashref";
    
    my $sub;
    my $object;

    my $driver_name = $self->{dbix_lite}->driver_name;

    # does the database support the PosttgreSQL "ON CONFLICT ... DO
    # ..." UPSERT clause as well as the RETURNING clause
    my $pg_upsert =
      ( $driver_name eq 'Pg' && $self->{dbix_lite}->dbh->{pg_server_version} > 10_00_00 )
      ||
      ($driver_name eq 'SQLite' && DBD::SQLite::Constants::SQLITE_VERSION_NUMBER() >= 3_035_000 );

    if ( $pg_upsert ) {
        $sub = sub {
            my ( $sql, @bind ) = $self->insert_sql( $cols );
            $sql .= ' on conflict do nothing returning *';
            my $sth = $self->{dbix_lite}->dbh->prepare( $sql );
            return if !$sth->execute( @bind );
            my $hash = $sth->fetchrow_hashref;
            $object = $hash ? $self->_inflate_row( $hash ) : $self->find( $cols );
        };
    }
    else {
        $sub = sub {
            if (!($object = $self->find($cols))) {
                $object = $self->insert($cols);
            }
        };
    }
    $self->{dbix_lite}->txn( $sub );
    return $object;
}

sub delete_sql {
    my $self = shift;
    
    my $delete_where = { -and => $self->{where} };
    
    if ($self->{cur_table}{name} ne $self->{table}{name}) {
        my @pk = $self->{cur_table}->pk
            or croak "No primary key defined for " . $self->{cur_table}{name} . "; cannot delete using relationships";
        @pk == 1
            or croak "Delete across relationships is not allowed with multi-column primary keys";