| icTableName | input | character | Database table name. |
| ihDestinationBuffer | input | handle | Handle to the class temp-table |
| ihIDestinationBuffer | input | handle | Handle to the optimistic lock data temp-table |
| icPrepare | input | character | where clause for database retrieval |
| icParentRowid | input | character | rowid of parent database record |
| ilTopLevel | input | logical | Read is the top-level. In this case, we must return an error if we do not find any record. |
| 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}. |
| ilStartEmpty | input | logical | if class temp-tables were empty before read, PL can create records without prior read (performance improvement) |
| oiReturnStatus | output | integer |
BLF
assign vgDebugTime = etime
vhParentRowidField = ihDestinationBuffer:buffer-field("tc_ParentRowid":U)
vhStatusField = ihDestinationBuffer:buffer-field("tc_status":U)
vhIParentRowidField = ihIDestinationBuffer:buffer-field("tc_ParentRowid":U) no-error.
/* must exist */
assign vhRowidField = ihDestinationBuffer:buffer-field("tc_rowid":U)
vhIRowidField = ihIDestinationBuffer:buffer-field("tc_rowid":U).
/* ================================================================= */
/* First, take care that all buffer fields are known for this table */
/* ================================================================= */
<M-1 run UpdateBufferInfo
(input icTableName (icTableName),
input ihDestinationBuffer (ihDestinationBuffer),
input ihIDestinationBuffer (ihIDestinationBuffer),
input ihClass (ihClass),
output vhBuffer (ohBuffer),
output vhquery (ohQuery),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper < 0
then do:
assign oiReturnStatus = viFcReturnSuper.
return.
end.
/* ================================================================= */
/* Open the query that will be used to read the data. */
/* ================================================================= */
assign vlFcOk = vhQuery:query-prepare (icPrepare) no-error.
if vlFcOk
then assign vlFcOk = vhQuery:query-open() no-error.
if not vlFcOk
then do:
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) + "FAILED":U, ?).
<M-11 run ErrorMessage
(input #T-1'Invalid database query ($1).':255(88)T-1# (icMessage),
input icPrepare (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
assign oiReturnStatus = -3.
return.
end.
if vlProgress
then assign vcIndexInfo = "Index : ":U + vhQuery:index-information(1).
vhQuery:get-first (no-lock).
if ilTopLevel
and vhBuffer:available = no
then do:
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) +
vcIndexInfo + chr(10) +
"Record count=0":U + chr(10) +
"time(ms)=" + string(etime - vgDebugTime), ?).
vhQuery:query-close().
assign oiReturnStatus = -4.
return.
end.
/* ================================================================= */
/* Go over all records, and create the corresponding t en t_i */
/* records if they do not already exist. */
/* Call the iReadDataRecursive for related tables. */
/* ================================================================= */
repeat while vhBuffer:available on error undo, throw:
vlCreated = no.
if ilStartEmpty = no
then do:
ihDestinationBuffer:find-unique ("where tc_rowid = '":U + string(vhBuffer:rowid) + "'":U) no-error.
ihIDestinationBuffer:find-unique ("where tc_rowid = '":U + string(vhBuffer:rowid) + "'":U) no-error.
end.
if ilStartEmpty = yes
or ihDestinationBuffer:available = no
then TRY1: do transaction on error undo, throw:
ihDestinationBuffer:buffer-create.
vhRowidField:buffer-value = string(vhBuffer:rowid).
vlCreated = yes.
catch notcreated as Progress.Lang.Error:
if ihDestinationBuffer:available
then ihDestinationBuffer:buffer-delete().
ihDestinationBuffer:find-unique ("where tc_rowid = '":U + string(vhBuffer:rowid) + "'":U).
vlCreated = no.
end catch.
end. /* TRY1 */
if ilStartEmpty = yes
or ihIDestinationBuffer:available = no
then TRY2: do transaction on error undo, throw:
ihIDestinationBuffer:buffer-create.
vhIRowidField:buffer-value = string(vhBuffer:rowid).
catch notcreated as Progress.Lang.Error:
if ihIDestinationBuffer:available
then ihIDestinationBuffer:buffer-delete().
ihIDestinationBuffer:find-unique ("where tc_rowid = '":U + string(vhBuffer:rowid) + "'":U) no-error.
end catch.
end. /* TRY2 */
if ihDestinationBuffer:available = no
or ihIDestinationBuffer:available = no
then do:
vhQuery:query-close().
assign oiReturnStatus = -4.
return.
end.
if vlCreated or (vhStatusField <> ? and vhStatusField:buffer-value <> "C")
then ihDestinationBuffer:buffer-copy (vhBuffer).
else for each tBufferFields where
tBufferFields.thTempBuffer = ihDestinationBuffer
on error undo, throw:
if tBufferFields.thIDestinationField:buffer-value =
tBufferFields.thDestinationField:buffer-value
then assign tBufferFields.thDestinationField:buffer-value =
tBufferFields.thBufferField:buffer-value.
end.
ihIDestinationBuffer:buffer-copy (vhBuffer).
if vhParentRowidField <> ?
then assign vhParentRowidField:buffer-value = icParentRowid
vhIParentRowidField:buffer-value = icParentRowid.
create tRowidList.
assign tRowidList.tcRowid = vhRowidField:buffer-value.
for each bDynRel where
bDynRel.tcFcFrom = icTableName
on error undo, throw:
if bDynRel.tcFcTo matches "*":U + icTableName
then assign vcPrepare = replace (bDynRel.tcFcRel,bDynRel.tcFcTo,chr(2)).
else assign vcPrepare = bDynRel.tcFcRel.
for each tBufferFields where
tBufferFields.thTempBuffer = ihDestinationBuffer and
index(bDynRel.tcFcRel,icTableName + ".":U + tBufferFields.tcFieldName) > 0
by length(tBufferFields.tcFieldName,"CHARACTER":U) descending
on error undo, throw:
if tBufferFields.thBufferField:buffer-value = ?
then assign vcValue = "?":U.
else if tBufferFields.thBufferField:data-type = "character":U
then assign vcValue = <M-15 EnQuote (input tBufferFields.thBufferField:buffer-value (icToQuote)) in Progress>.
else assign vcValue = string (tBufferFields.thBufferField:buffer-value).
assign vcPrepare = replace(vcPrepare,
icTableName + ".":U +
(if bDynRel.tcFcTo matches "*":U + icTableName
then replace (tBufferFields.tcFieldName,bDynRel.tcFcTo,chr(2))
else tBufferFields.tcFieldName),
vcValue).
end.
if bDynRel.tcFcTo matches "*":U + icTableName
then assign vcPrepare = replace (vcPrepare,chr(2),bDynRel.tcFcTo).
<M-2 run ReadDataRecursive (input bDynRel.tcFcTo (icTableName),
input bDynRel.thFcBuffer (ihDestinationBuffer),
input bDynRel.thFcIBuffer (ihIDestinationBuffer),
input vcPrepare (icPrepare),
input string(vhBuffer:rowid) (icParentRowid),
input false (ilTopLevel),
input ihClass (ihClass),
input ilStartEmpty (ilStartEmpty),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper <> 0
then do :
vhQuery:query-close().
assign oiReturnStatus = viFcReturnSuper.
return.
end.
end.
vhQuery:get-next (no-lock).
assign viReadCount = viReadCount + 1.
catch syster as progress.lang.syserror:
if vlCreated
then do:
if ihDestinationBuffer:available
then ihDestinationBuffer:buffer-delete().
if ihIDestinationBuffer:available
then ihIDestinationBuffer:buffer-delete().
end.
undo, throw syster.
end catch.
end.
vhQuery:query-close().
/* ================================================================= */
/* Update the records that have not been reloaded */
/* (because deleted in the database) */
/* ================================================================= */
if ilStartEmpty = no
and icParentRowid <> ""
and vhStatusField <> ?
then do:
create query vhTQuery in widget-pool "non-persistent".
vhTQuery:forward-only = yes.
vhTQuery:set-buffers(ihDestinationBuffer).
vhTQuery:query-prepare
("for each ":U + ihDestinationBuffer:name +
" where ":U + ihDestinationBuffer:name +
".tc_ParentRowid = '":U + icParentRowid +
"' and ":U + ihDestinationBuffer:name +
".tc_status <> 'N'":U).
vhTQuery:query-open().
vhTQuery:get-first().
do while not vhTQuery:query-off-end :
if not can-find (first tRowidList where
tRowidList.tcRowid = string(vhRowidField:buffer-value))
then do:
assign vlTFound = (vhStatusField:buffer-value = "C":U).
if vhStatusField:buffer-value = ""
then for each bDynRel where
bDynRel.tcFcFrom = icTableName on error undo, throw:
<M-12 run CheckChanges (input bDynRel.tcFcTo (icTableName),
input bDynRel.thFcBuffer (ihDestinationBuffer),
input vhRowidField:buffer-value (icParentRowid),
output vlTFound (olFound),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if vlTFound then leave.
end.
if vlTFound
then do:
/* If a record that is deleted in the database, is changed by the user
give it status 'N', including it's detail. */
assign vhPdatabaseInst = ihClass
vcTRowid = <M-7 GetNumberForNew () in database>.
for each bDynRel where
bDynRel.tcFcFrom = icTableName on error undo, throw:
<M-13 run UpdateChanges (input bDynRel.tcFcTo (icTableName),
input bDynRel.thFcBuffer (ihDestinationBuffer),
input vhRowidField:buffer-value (icOldRowid),
input vcTRowid (icNewRowid),
input ihClass (ihClass),
output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper <> 0
then do :
assign oiReturnStatus = viFcReturnSuper.
return.
end.
end.
assign vhRowidField:buffer-value = vcTrowid
vhStatusField:buffer-value = "N":U.
end.
else do:
/* If a record that is deleted in the database, is not changed by the user
delete it, including it's detail. */
for each bDynRel where
bDynRel.tcFcFrom = icTableName on error undo, throw:
<M-14 run UpdateChanges (input bDynRel.tcFcTo (icTableName),
input bDynRel.thFcBuffer (ihDestinationBuffer),
input vhRowidField:buffer-value (icOldRowid),
input '' (icNewRowid),
input ihClass (ihClass),
output viFcReturnSuper (oiReturnStatus)) in Progress>
end.
ihDestinationBuffer:buffer-delete().
end.
end.
vhTQuery:get-next().
end.
end.
ihDestinationBuffer:buffer-release().
ihIDestinationBuffer:buffer-release().
publish "Logging.DatabaseAccess"
("read ":U + icTableName + chr(10) +
icPrepare + chr(10) +
vcIndexInfo + chr(10) +
"Record count=":U + string(viReadCount) + chr(10) +
"time(ms)=" + string(etime - vgDebugTime), ?).
finally:
if vhTQuery <> ?
then do:
vhTQuery:query-close().
delete object vhTQuery.
end.
end finally.