project BLF > class Persistence (Progress) > method MainBlock

Description

Connect all necessary databases (found in server.ini).


Parameters


ihClassinputhandleHandle to the business class that is using the persistence layer. In most of the cases, this handle will be available in the preprocessor {&TARGETPROCEDURE}.
icDBMSinputcharacterDatabase type. Must refer to a registered DLL with the correct function to access a database of that type.
oiReturnStatusoutputintegerReturn status


Internal usage


BLF
method ComponentPool.StartPersistenceInPool


program code (program1/progress.p)

/* Connect all databases listed in server.xml */
assign oiReturnStatus = -5
       vcIniPath      = search ("server.xml":U).
if vcIniPath = ?
then do:
    <M-12 run ErrorMessage
       (input  #T-3'The server.xml file was not found.':100(5014)T-3# (icMessage), 
        input  '' (icArguments), 
        input  '' (icFieldName), 
        input  '' (icFieldValue), 
        input  '' (icRowid), 
        input  ? (ihClass)) in Progress>
    return.
end.

assign vhFcComponent = ?.
<M-7 run MainBlock  () in XML>
assign vhXMLhandle = vhFcComponent.

<M-15 run ReadXMLNodeValue
   (input  vcIniPath (icXMLFile), 
    input  'state' (icStartTag), 
    input  'StateDirectory' (icNodeTag), 
    output vcStateDirectory (ocNodeValue), 
    output viFcReturnSuper (oiReturnStatus)) in XML>

if index(vcStateDirectory,"$ENVROOT") > 0
then do:
    <M-16 run ReadXMLNodeValue
       (input  vcIniPath (icXMLFile), 
        input  'serverConfiguration' (icStartTag), 
        input  'ENVROOT' (icNodeTag), 
        output vcFcMaskList (ocNodeValue), 
        output viFcReturnSuper (oiReturnStatus)) in XML>
    vcStateDirectory = replace(vcStateDirectory,"$ENVROOT",vcFcMaskList).
end.

if vcStateDirectory <> ""
then do:
    file-info:file-name = vcStateDirectory.
    if  index(file-info:file-type,"D":U) > 0
    and index(file-info:file-type,"R":U) > 0
    then vcStateDirectory = file-info:full-pathname.
    else vcStateDirectory = "".
end.

assign vhFcComponent = vhXMLhandle.
<M-8 run ReadXML
   (input  vcIniPath (icXMLFile), 
    input  'databases':U (icStartTag), 
    output tNodesPP (tNodes), 
    output viFcReturnSuper (oiReturnStatus)) in XML>        
run gipr_DeleteProcedure in vhXMLhandle.
delete procedure vhXMLHandle.
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.

For Each tNodesPP By tNodesPP.tiNodeId on error undo, throw:

    If tNodesPP.tcNodeName = "Name":U
    Then Assign vcDBName = tNodesPP.tcNodeValue.
    Else If tNodesPP.tcNodeName = "Parameters":U
    Then Assign vcDBConnect = tNodesPP.tcNodeValue.
    Else if vcDBName <> ""
    then do:
        <M-9 run ConnectDB (input  vcDBName (icDB), 
                    input  vcDBConnect (icConnect), 
                    input  ihClass (ihClass), 
                    output viFcReturnSuper (oiReturnStatus)) in Progress>
        if viFcReturnSuper < 0
        then do:
            input close.
            assign oiReturnStatus = viFcReturnSuper.
            return.
        end.
        
        assign vcDBName    = ""
               vcDBConnect = "".
    end.
 
End. /*For Each tNodesPP:*/ 

empty temp-table tNodesPP.

if vcDBName <> ""
then do:
    <M-14 run ConnectDB
       (input  vcDBName (icDB), 
        input  vcDBConnect (icConnect), 
        input  ihClass (ihClass), 
        output viFcReturnSuper (oiReturnStatus)) in Progress>
    if viFcReturnSuper < 0
    then do:
        assign oiReturnStatus = viFcReturnSuper.
        return.
    end.
end.

<M-11 run AfterDBConnections
   (input  ihClass (ihClass), 
    output viFcReturnSuper (oiReturnStatus)) in Progress>
if viFcReturnSuper < 0
then do:
    assign oiReturnStatus = viFcReturnSuper.
    return.
end.
    
<M-10 run ConnectionValid
   (output oiReturnStatus (oiReturnStatus)) in Progress>
if oiReturnStatus < 0
then do:
    <M-13 run ErrorMessage
       (input  #T-4'The server.xml file must contain a connection to the application database.':255(5116)T-4# (icMessage), 
        input  '' (icArguments), 
        input  '' (icFieldName), 
        input  '' (icFieldValue), 
        input  '' (icRowid), 
        input  ? (ihClass)) in Progress>
end.