project BLF > class Persistence (Progress) > method WriteDirect

Description

Write directly to the database, without using any temp-tables, without optimistic lock.
Cannot be used to create data in the database.

PostCondition

Unless run inside a larger transaction (when run from methods PreSave or PostSave) every database record that matches the search criteria will be updated in it's own transaction. This means there is no transaction undo in case an error occurs during update, but this was necessary to prevent a lock table overflow on updates that can potentially update very large record sets.


Parameters


icTableNameinputcharacterDatabase table name
icPrepareinputcharacterProgress for each statement defining what record(s) must be updated.
icFieldListinputcharacterComma seperated list of field names to update.
If this list is empty, the record(s) to update will be deleted.
icFieldListDataTypesinputcharacterComma seperated list of data type of each field in icFieldList.

data type =
c (character)
d (decimal)
i (integer)
l (logical)
t (date)
icAbsoluteinputcharacterchr(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.
icIncrementalinputcharacterchr(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.
ihClassinputhandleHandle to the class that is using the persistence layer. In most of the cases, this handle will be available in the preprocessor {&TARGETPROCEDURE}.
icUserLogininputcharacter
oiReturnStatusoutputintegerReturn status of the method.


Internal usage


BLF
method Progress.CleanupStateOnline
method Progress.CreateDraftInstance
method Session.SetDebugLevel

QadFinancials
method BAutoNumber.GetAutoNumber
method BBill.PostSave
method BBill.SetBillDate
method BCInvoice.PostSaveLegalDocument
method BCInvoice.PreSave
method BCInvoice.UpdateCInvoicesPaymentReference
method BDebtor.ApiUpdateOpenOrderTotal
method BDInvoice.PreSave
method BDPaymentSelection.AdditionalUpdatesDInvoice
method BDPaymentSelection.DeleteDPaySelLine
method BPosting.PostSave
method BPosting.PreSave
method BJournalEntry.ApiSetPostingStatusChange
method BPaymentSelection.ApiChangePaymentSelInProcessing
method BPaymentSelection.ChangeStatusPaymentSelInBatch
method BPaymentSelection.ChangeStatusPaymentSelInProcessing
method BPaymentSelection.UpdatesCInvoiceIsSelected
method BReportingJournal.ApiUpdateReportingJournal
method BReportTree.DataLoadByInput
method BSharedSetMerge.MergeBeforeMerge
method BSharedSetMerge.MergeFinish
method BSharedSetMerge.MergeInitClearReferencesSameTable
method BSharedSetMerge.MergeProfiles
method BSharedSetMerge.MergeBeforeMergeGL


program code (program1/progress.p)

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.