| icTableName | input | character | Database table name |
| icPrepare | input | character | Progress for each statement defining what record(s) must be updated. |
| icFieldList | input | character | Comma seperated list of field names to update. If this list is empty, the record(s) to update will be deleted. |
| icFieldListDataTypes | input | character | Comma seperated list of data type of each field in icFieldList. data type = c (character) d (decimal) i (integer) l (logical) t (date) |
| icAbsolute | input | character | chr(2) seperated list of absolute values to write to the fields of icFieldList. The same value(s) will be written to each record to update. Cannot be combined with icIncremental. |
| icIncremental | input | character | chr(2) seperated list of values to add to the fields of icFieldList. The same value(s) will be added in each record to update. Fields to update are restricted to data types integer and decimal. Cannot be combined with icAbsolute. |
| ihClass | input | handle | Handle to the class that is using the persistence layer. In most of the cases, this handle will be available in the preprocessor {&TARGETPROCEDURE}. |
| icUserLogin | input | character | |
| oiReturnStatus | output | integer | Return status of the method. |
BLF
QadFinancials
assign vgDebugTime = etime
viFields = num-entries(icFieldList).
create query vhQuery in widget-pool "non-persistent".
vhQuery:forward-only = yes.
create buffer vhBuffer for table icTableName in widget-pool "non-persistent".
vhQuery:set-buffers(vhBuffer).
assign vlOK = vhQuery:query-prepare (icPrepare) no-error.
if vlOK
then assign vlOK = vhQuery:query-open() no-error.
if not vlOK
then do:
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) + "FAILED":U, ?).
<M-26 run ErrorMessage
(input #T-3'Invalid database query ($1).':255(88)T-3# (icMessage),
input icPrepare (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
assign oiReturnStatus = -3.
return.
end.
if vlOK
then repeat transaction on error undo, throw: /* every record update is a single (sub)transaction */
if vlOK
then vhQuery:get-first(exclusive-lock,no-wait).
else vhQuery:get-next(exclusive-lock,no-wait).
vlOK = no.
viFcCount1 = 0.
do while vhBuffer:available and vhBuffer:locked:
viFcCount1 = viFcCount1 + 1.
if viFcCount1 > 5
then do:
/* error : record stays locked */
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) +
(if icFieldList = ""
then "Delete count="
else "Update count=") + string(viReadCount) + chr(10) +
"time(ms)=" + string(etime - vgDebugTime), ?).
<M-27 run ErrorMessage
(input #T-4'Update failed: database record stays locked.':255(90)T-4# (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
assign oiReturnStatus = -3.
return.
end.
pause 3 no-message.
vhQuery:get-current (exclusive-lock, no-wait).
/* ================================================================= */
/* bugfix : get-current does not check if the record still meets */
/* the query condition. Do this now. */
/* ================================================================= */
if vhBuffer:available = yes
and vhBuffer:locked = no
then do:
create buffer vhLockBuffer for table icTableName in widget-pool "non-persistent".
create query vhLockQuery in widget-pool "non-persistent".
vhLockQuery:forward-only = yes.
vhLockQuery:set-buffers(vhLockBuffer).
vhLockQuery:query-prepare (icPrepare + " and rowid(":U + icTableName
+ ") = to-rowid('":U + string(vhBuffer:rowid) + "')":U).
vhLockQuery:query-open().
vhLockQuery:get-first(no-lock).
if vhLockQuery:query-off-end
then vhQuery:get-next (exclusive-lock, no-wait).
vhLockQuery:query-close().
delete object vhLockQuery.
delete object vhLockBuffer.
end.
end. /* if locked */
if vhQuery:query-off-end
or not vhBuffer:available
then leave.
if icFieldList = ""
then do:
/* do cascaded deletes first */
if vhRefInt = ?
then if search ("ref_int/dc_":U + lc(icTableName) + ".r":U) <> ?
or search ("ref_int/dc_":U + lc(icTableName) + ".p":U) <> ?
then run value ("ref_int/dc_":U + lc(icTableName) + ".p":U) persistent set vhRefInt.
if vhRefInt <> ?
then do:
run gipr_RefInt in vhRefInt
(input vhBuffer,
input ihClass,
input {&TARGETPROCEDURE},
input icUserLogin,
output viFcReturnSuper).
if viFcReturnSuper <> 0
then oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
end.
publish "Logging.DatabaseAccess"
("delete " + icTableName, vhBuffer).
/* delete */
vhBuffer:buffer-delete().
end.
else if icIncremental = ""
then do viFcCount1 = 1 to viFields:
assign vhField = ?.
assign vhField = vhBuffer:buffer-field(entry(viFcCount1,icFieldList)) no-error.
if vhField = ?
then do:
<M-28 run ErrorMessage
(input 'Invalid field ':U + entry(viFcCount1,icFieldList) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
assign oiReturnStatus = -3.
return.
end.
case vhField:data-type:
when "character":U then assign vhField:buffer-value = entry(viFcCount1,icAbsolute,chr(2)).
when "date":U then assign vhField:buffer-value = date(entry(viFcCount1,icAbsolute,chr(2))).
when "decimal":U then assign vhField:buffer-value = decimal(entry(viFcCount1,icAbsolute,chr(2))).
when "integer":U then assign vhField:buffer-value = integer(entry(viFcCount1,icAbsolute,chr(2))).
when "logical":U then assign vhField:buffer-value = (entry(viFcCount1,icAbsolute,chr(2)) = "true":U).
otherwise do:
return.
end.
end case.
end.
else do viFcCount1 = 1 to viFields:
assign vhField = ?.
assign vhField = vhBuffer:buffer-field(entry(viFcCount1,icFieldList)) no-error.
if vhField = ?
then do:
<M-29 run ErrorMessage
(input 'Invalid field ':U + entry(viFcCount1,icFieldList) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
assign oiReturnStatus = -3.
return.
end.
case vhField:data-type:
when "decimal":U then assign vhField:buffer-value = decimal(vhField:buffer-value)
+ decimal(entry(viFcCount1,icIncremental,chr(2))).
when "integer":U then assign vhField:buffer-value = integer(vhField:buffer-value)
+ integer(entry(viFcCount1,icIncremental,chr(2))).
otherwise do:
return.
end.
end case.
end.
if icFieldList <> ""
then publish "Logging.DatabaseAccess"
("update " + icTableName, vhBuffer).
assign viReadCount = viReadCount + 1.
end.
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) +
(if icFieldList = ""
then "Delete count="
else "Update count=") + string(viReadCount) + chr(10) +
"time(ms)=" + string(etime - vgDebugTime), ?).
if viReadCount = 0 then oiReturnStatus = -4.
finally:
if vhQuery <> ?
then do:
vhQuery:query-close().
delete object vhQuery.
end.
if vhBuffer <> ?
then delete object vhBuffer.
if vhRefInt <> ?
then do:
delete procedure vhRefInt.
assign vhRefInt = ?.
end.
end finally.