Description
save instance data to the application database
PreCondition
This method is to be used by instance procedures only.
Parameters
| ihClass | input | handle | |
| iiInstanceID | input | integer | instance ID |
| ihInstanceData | input | handle | dataset with instance data |
| icClassName | input | character | class name |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
unused
program code (program1/progress.p)
/* Do not save when loaded read-only (see LoadInstance) */
viFcCount1 = 2.
if icClassName = "session"
then do while program-name(viFcCount1) <> ?:
if program-name(viFcCount1) = "UpdateSessionData program/cacher.p"
then return.
viFcCount1 = viFcCount1 + 1.
end.
if ihInstanceData:name = "StateData"
and ihClass <> ?
then run GetPublicData in ihClass (input "vlRawTransferSupported", output vcRawTransferSupported, output viFcReturnSuper).
CREATE tRaw. /* Just need one dummy row to store RAW field in by its handle. */
vhContext = BUFFER tRaw:BUFFER-FIELD("taContext":U):HANDLE.
CREATE QUERY vhQuery in widget-pool "non-persistent".
do transaction on error undo, throw:
if not (valid-handle(vhInstanceQuery) and
viInstanceUID = vhInstanceQuery:unique-id)
then do:
create buffer vhInstanceBuffer for table "fcInstance":U in widget-pool "persistent".
create query vhInstanceQuery in widget-pool "persistent".
vhInstanceQuery:forward-only = yes.
vhInstanceQuery:set-buffers(vhInstanceBuffer).
vhInstanceQuery:private-data = "Persistent". /* do not ever delete this query */
viInstanceUID = vhInstanceQuery:unique-id.
end.
if ihInstanceData:name = "StateData"
then do:
/* create a separate record containing the session ID only, for usage by housekeeping */
vhBuffer = ihInstanceData:get-buffer-handle("ibusinessData").
vhBuffer:find-first().
put-string(vaContext,1) = string(vhBuffer::iSessionId).
vhInstanceQuery:query-prepare
("for each fcInstance where fcInstance.Instance_ID = ":U + string(iiInstanceId) +
" and fcInstance.InstanceSeq = 0").
vhInstanceQuery:query-open().
vhInstanceQuery:get-first(exclusive-lock, no-wait).
vhInstanceQuery:query-close().
if vhInstanceBuffer:available and vhInstanceBuffer:locked
then do:
assign oiReturnStatus = -3.
return.
end.
if vhInstanceBuffer:available
then assign vhInstanceBuffer::InstanceData = vaContext.
else do:
vhInstanceBuffer:buffer-create().
assign vhInstanceBuffer::Instance_ID = iiInstanceId
vhInstanceBuffer::InstanceSeq = 0
vhInstanceBuffer::InstanceData = vaContext
vhInstanceBuffer::InstanceIsInUse = no
vhInstanceBuffer::InstanceClassName = icClassName.
end.
end.
if vcStateDirectory = "" or ihInstanceData:name <> "StateData"
then do:
vhInstanceQuery:query-prepare
("for each fcInstance where fcInstance.Instance_ID = ":U + string(iiInstanceId) +
" and fcInstance.InstanceSeq > 0").
vhInstanceQuery:query-open().
vleoq = no.
if vcRawTransferSupported = "false"
then do:
ihInstanceData:write-xml ("memptr",vmContext,false,?,?,false,false,false,true).
viMaxLength = get-size(vmcontext).
viContextPos = 1.
do while viContextPos <= viMaxLength:
viRawLength = minimum (viMaxLength - viContextPos + 1, 31000).
vacontext = get-bytes (vmcontext,viContextPos,viRawLength).
viContextPos = viContextPos + viRawLength.
if vleoq = no
then do:
vhInstanceQuery:get-next(exclusive-lock, no-wait).
if vhInstanceBuffer:available and vhInstanceBuffer:locked
then do:
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
return.
end.
if vhInstanceBuffer:available
then do:
if vhInstanceBuffer::InstanceClassName <> icClassName
then do:
vhInstanceBuffer:buffer-release().
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
<M-64 run ErrorMessage
(input #T-73'Unable to save data for business class $1, cannot overwrite data for business class $2.':255(4393)T-73# (icMessage),
input icClassName + chr(2) + vhInstanceBuffer::InstanceClassName (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
return.
end.
if vhInstanceBuffer::InstanceIsInUse = no
then do:
vhInstanceBuffer:buffer-release().
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
<M-19 run ErrorMessage
(input #T-60'Instance is already closed.':255(93)T-60# + ' (class name = ' + icClassName + ')' (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
return.
end.
end.
vleoq = vhInstanceQuery:query-off-end.
end.
if vleoq = no
then assign viContextSeq = vhInstanceBuffer::InstanceSeq.
else do:
vhInstanceBuffer:buffer-create().
viContextSeq = viContextSeq + 1.
end.
assign vhInstanceBuffer::Instance_ID = iiInstanceId
vhInstanceBuffer::InstanceSeq = viContextSeq
vhInstanceBuffer::InstanceIsInUse = no
vhInstanceBuffer::InstanceClassName = icClassName.
vhInstanceBuffer::InstanceData = vaContext.
end.
end.
else do:
/* maximum number of bytes to store in a RAW field */
if <M-62 DataServerActive () in Progress>
then viMaxLength = 26000.
else viMaxLength = 31900.
vhInstanceQuery:get-first(exclusive-lock, no-wait).
if vhInstanceBuffer:available and vhInstanceBuffer:locked
then do:
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
return.
end.
if vhInstanceBuffer:available
then do:
if vhInstanceBuffer::InstanceClassName <> icClassName
then do:
vhInstanceBuffer:buffer-release().
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
<M-17 run ErrorMessage
(input #T-50'Unable to save data for business class $1, cannot overwrite data for business class $2.':255(4393)T-50# (icMessage),
input icClassName + chr(2) + vhInstanceBuffer::InstanceClassName (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
return.
end.
if vhInstanceBuffer::InstanceIsInUse = no
then do:
vhInstanceBuffer:buffer-release().
vhInstanceQuery:query-close().
assign oiReturnStatus = -3.
<M-9 run ErrorMessage
(input #T-77'Instance is already closed.':255(93)T-77# + ' (class name = ' + icClassName + ')' (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input '' (icRowid),
input ? (ihClass)) in Progress>
return.
end.
assign vhInstanceBuffer::InstanceIsInUse = no
viContextSeq = vhInstanceBuffer::InstanceSeq.
end.
else do:
vhInstanceBuffer:buffer-create().
assign vhInstanceBuffer::Instance_ID = iiInstanceId
vhInstanceBuffer::InstanceSeq = viContextSeq
vhInstanceBuffer::InstanceIsInUse = no
vhInstanceBuffer::InstanceClassName = icClassName.
end.
SET-SIZE(vmContext) = viMaxLength.
DO viBuffer = 1 TO ihInstanceData:NUM-BUFFERS:
vhBuffer = ihInstanceData:GET-BUFFER-HANDLE(viBuffer).
vhQuery:SET-BUFFERS(vhBuffer).
vhQuery:QUERY-PREPARE("FOR EACH ":U + vhBuffer:NAME).
vhQuery:QUERY-OPEN().
vhQuery:GET-FIRST().
DO WHILE NOT vhQuery:QUERY-OFF-END:
vhBuffer:RAW-TRANSFER(TRUE, vhContext).
viRawLength = LENGTH(tRaw.taContext, "RAW":U).
IF viContextPos + viRawLength + 8 > viMaxLength THEN
DO:
/* The data won't fit in a single BLOB, so create another row. */
PUT-SHORT(vmContext, viContextPos) = 0. /* Signal end of this row. */
viContextPos = viContextPos + 2.
vaContext = get-bytes(vmContext,1,viContextPos).
vhInstanceBuffer::InstanceData = vaContext.
if not vhInstanceQuery:query-off-end
then vhInstanceQuery:get-next(exclusive-lock).
if vhInstanceQuery:query-off-end
then do:
viContextSeq = viContextSeq + 1.
vhInstanceBuffer:buffer-create().
assign vhInstanceBuffer::Instance_ID = iiInstanceId
vhInstanceBuffer::InstanceSeq = viContextSeq
vhInstanceBuffer::InstanceIsInUse = no
vhInstanceBuffer::InstanceClassName = icClassName.
end.
else assign viContextSeq = vhInstanceBuffer::InstanceSeq.
assign vhInstanceBuffer::InstanceIsInUse = no.
viContextPos = 1.
END.
PUT-SHORT(vmContext, viContextPos) = viBuffer.
viContextPos = viContextPos + 2. /* Move past the table number. */
PUT-LONG(vmContext, viContextPos) = viRawLength.
viContextPos = viContextPos + 4. /* Move past the buffer length. */
PUT-BYTES(vmContext, viContextPos) = tRaw.taContext.
viContextPos = viContextPos + viRawLength.
vhQuery:GET-NEXT().
END.
vhQuery:QUERY-CLOSE().
IF viBuffer = ihInstanceData:NUM-BUFFERS
THEN DO:
PUT-SHORT(vmContext, viContextPos) = 0. /* Mark the end of the data. */
viContextPos = viContextPos + 2.
END.
END.
vaContext = get-bytes(vmContext,1,viContextPos).
vhInstanceBuffer::InstanceData = vaContext.
end.
do while not vhInstanceQuery:query-off-end:
vhInstanceQuery:get-next(exclusive-lock).
if vhInstanceQuery:query-off-end then leave.
vhInstanceBuffer:buffer-delete().
end.
end.
else
if vcRawTransferSupported = "false"
then ihInstanceData:write-xml ("file",vcStateDirectory + "/" + lc(icClassName) + string(iiInstanceID) + ".lob",false,?,?,false,false,false,true).
else do:
/* All data is stored in a single memptr.
Set size large enough to make an overflow VERY exceptional.
(Size is not limited to RAW length) */
viMaxLength = 200000.
SET-SIZE(vmContext) = viMaxLength.
DO viBuffer = 1 TO ihInstanceData:NUM-BUFFERS:
vhBuffer = ihInstanceData:GET-BUFFER-HANDLE(viBuffer).
vhQuery:SET-BUFFERS(vhBuffer).
vhQuery:QUERY-PREPARE("FOR EACH ":U + vhBuffer:NAME).
vhQuery:QUERY-OPEN().
vhQuery:GET-FIRST().
DO WHILE NOT vhQuery:QUERY-OFF-END:
vhBuffer:RAW-TRANSFER(TRUE, vhContext).
viRawLength = LENGTH(tRaw.taContext, "RAW":U).
if viContextPos + viRawLength + 8 > viMaxLength
then do:
/* In case an overflow does occur, double the size of the target memptr. */
viMaxLength = viMaxLength * 2.
SET-SIZE(vmContextOverflow) = viMaxLength.
copy-lob from vmContext starting at 1 for viContextPos - 1 to vmContextOverflow overlay at 1.
vmContext = vmContextOverflow.
set-size(vmContextOverflow) = 0.
end.
PUT-SHORT(vmContext, viContextPos) = viBuffer.
viContextPos = viContextPos + 2. /* Move past the table number. */
PUT-LONG(vmContext, viContextPos) = viRawLength.
viContextPos = viContextPos + 4. /* Move past the buffer length. */
PUT-BYTES(vmContext, viContextPos) = tRaw.taContext.
viContextPos = viContextPos + viRawLength.
vhQuery:GET-NEXT().
END.
vhQuery:QUERY-CLOSE().
END.
copy-lob vmContext for viContextPos to file (vcStateDirectory + "/" + lc(icClassName) + string(iiInstanceID) + ".lob").
end.
end.
finally:
if vhInstanceBuffer <> ?
then vhInstanceBuffer:buffer-release().
if vhInstanceQuery <> ?
then vhInstanceQuery:query-close().
if vhQuery <> ?
then delete object vhQuery.
if available tRaw
then delete tRaw.
SET-SIZE(vmContext) = 0.
end finally.