project BLF > class BXmlDaemonQueue > method CreateDaemonQueue
Description
Create
Parameters
| icInputDirectory | input | character | |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
BLF
program code (program1/bxmldaemonqueue.p)
empty temp-table tFileList.
/* Do not convert this longchar to cpinternal. */
fix-codepage (vpXMLRepresentation) = "UTF-8".
/* Start with a clean and empty instance */
<M-26 run ClearData (output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
/* Check for files in the input directory */
input stream sdir from os-dir (icInputDirectory) no-echo.
repeat with width 640 on error undo, throw:
/* Only max 500 files are treated in a single call to this method */
if viXmlFileCounter >= 500
then leave.
set stream sdir vcShortName vcFullName vcFileType.
if vcFileType <> "F" or
not vcShortName matches "*.xml" or
vcShortName matches "+++*+++*"
then next.
/* lookup file owner */
vcFileOwner = "".
if opsys = "UNIX"
then do:
input stream sFile through value ("ls -l ~"" + vcFullName + "~"").
UX: repeat:
vintra = 0.
import stream sFile unformatted vcInput.
if vcinput matches ("*" + vcShortName + "*")
then do viter = 1 to num-entries(vcInput," "):
if entry (viter,vcInput," ") <> ""
then vintra = vintra + 1.
if vintra = 3
then do:
vcFileOwner = entry(viter,vcInput," ").
leave UX.
end.
end.
end.
input stream sFile close.
end.
else do:
input stream sFile through value ("dir /q ~"" + vcFullName + "~"").
WIN: repeat:
import stream sFile unformatted vcInput.
do viter = num-entries(vcInput," ") to 2 by -1:
if entry(viter,vcInput," ") = entry(1,vcShortName," ")
then do while viter > 0:
viter = viter - 1.
vcFileOwner = entry(viter,vcInput," ").
if vcFileOwner <> "" then leave WIN.
end.
end.
end.
input stream sFile close.
end.
assign vcFileOwner = substring(vcFileOwner,1,20,'character':U).
assign viFileNum = viSessionID.
do while true:
assign vcFileRenamed = replace(vcFullName, "~\", "/")
entry(num-entries(vcFileRenamed, "/"), vcFileRenamed, "/") = "+++" + string(viFileNum) + "+++" + entry(num-entries(vcFileRenamed, "/"), vcFileRenamed, "/")
file-info:file-name = vcFileRenamed.
if file-info:file-type = ?
then leave.
viFileNum = viFileNum + 1.
end.
os-rename value(vcFullName) value(vcFileRenamed).
if os-error <> 0
then do:
assign vcMsgXml = trim(subst(#T-57'XML daemon error: unable to rename file &1 into &2.':255(52616730)T-57#, vcFullName, vcFileRenamed)) + chr(10) +
trim(subst(#T-40'Operating system error: &1.':255(55310346)T-40#, string(os-error)))
oiReturnStatus = -3.
<M-21 run SetMessage
(input vcMsgXml (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-297':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
return.
end.
assign vcCreateXmlClassName = ""
vcXmlComment = ""
vcXmlCompanyCode = ""
vcXmlActivity = ""
vcXmlOriginator = ""
viXmlPriority = 0.
/* First, read the XML file in the DOM parser, and read some information from the header part */
create x-document vhDocument in widget-pool "non-persistent".
assign vlFcOk = vhDocument:load("file", vcFileRenamed, no) no-error.
if not vlFcOk or
error-status:error or
error-status:num-messages > 0
then do viCnt1 = 1 to error-status:num-messages:
assign vcErrors = vcErrors + chr(2) + error-status:get-message(viCnt1).
end.
if vcErrors <> ""
then do:
assign vcErrors = trim(vcErrors, chr(2))
oiReturnStatus = -3.
<M-14 run SetMessage
(input trim(#T-17'The XML document could not be read.':100(371)T-17#) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'D' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-294':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
do viCnt1 = 1 to num-entries(vcErrors, chr(2)):
<M-35 run SetMessage
(input entry(viCnt1, vcErrors, chr(2)) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'S' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'blf-576393':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
end.
return.
end.
/* Convert encoding of the loaded data into the default UTF-8 */
vhDocument:encoding = "UTF-8".
create x-noderef vhRoot in widget-pool "non-persistent".
assign vlRootFound = false.
do viCnt1 = 1 to vhDocument:num-children:
vhDocument:get-child(vhRoot, viCnt1).
if vhRoot:local-name <> ""
then do:
assign vlRootFound = true.
leave.
end.
end.
if not vlRootFound
then do:
<M-16 run SetMessage
(input trim(#T-18'Invalid XML document: the object node is missing.':100(378)T-18#) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-296':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
assign oiReturnStatus = -3.
return.
end.
assign vcCreateXmlClassName = vhRoot:local-name.
/* Check if we have a valid a business component */
<Q-22 assign vlFcQueryRecordsAvailable = BusComponentPrim (NoCache)
(input ?, (BusComponentID)
input vcCreateXmlClassName, (BusComponentCode)) in BBusinessComponent >
if vlFcQueryRecordsAvailable <> true
then do:
<M-23 run SetMessage
(input trim(#T-73'The name of the dataset does not match with a business component name ($1).':255(9060)T-73#) (icMessage),
input vcCreateXmlClassName (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-298':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
assign oiReturnStatus = -3.
return.
end.
/* Locate tContextInfo */
create x-noderef vhContextInfo in widget-pool "non-persistent".
assign vlContextInfoFound = false.
do viCnt1 = 1 to vhRoot:num-children:
vhRoot:get-child(vhContextInfo, viCnt1).
if vhContextInfo:local-name = "tContextInfo"
then do:
assign vlContextInfoFound = true.
leave.
end.
end.
if not vlContextInfoFound
then do:
<M-74 run SetMessage
(input trim(#T-44'The XML did not contain the tContextInfo table.':255(9058)T-44#) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'blf-143963':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
assign oiReturnStatus = -3.
return.
end.
/* Read tContextInfo */
create x-noderef vhNode in widget-pool "non-persistent".
create x-noderef vhNodeValue in widget-pool "non-persistent".
do viCnt1 = 1 to vhContextInfo:num-children:
vhContextInfo:get-child(vhNode, viCnt1).
case vhNode:local-name:
when "tcComment"
then do:
if vhNode:num-children = 1
then do:
vhNode:get-child(vhNodeValue, 1).
assign vcXmlComment = vhNodeValue:node-value.
end.
end.
when "tcCompanyCode"
then do:
if vhNode:num-children = 1
then do:
vhNode:get-child(vhNodeValue, 1).
assign vcXmlCompanyCode = vhNodeValue:node-value.
end.
end.
when "tcActivityCode"
then do:
if vhNode:num-children = 1
then do:
vhNode:get-child(vhNodeValue, 1).
assign vcXmlActivity = vhNodeValue:node-value.
end.
end.
when "tcOriginator"
then do:
if vhNode:num-children = 1
then do:
vhNode:get-child(vhNodeValue, 1).
assign vcXmlOriginator = vhNodeValue:node-value.
end.
end.
when "tiPriority"
then do:
if vhNode:num-children = 1
then do:
vhNode:get-child(vhNodeValue, 1).
assign viXmlPriority = int(vhNodeValue:node-value) no-error.
if error-status:error
then assign viXmlPriority = 0.
end.
end.
end case.
end.
assign vlFcOk = vhDocument:save("longchar", vpXMLRepresentation) no-error.
if not vlFcOk or
error-status:error or
error-status:num-messages > 0
then do:
assign vcErrors = "".
do viFcCount1 = 1 to error-status:num-messages:
if vcErrors <> ""
then assign vcErrors = vcErrors + chr(2).
assign vcErrors = vcErrors + error-status:get-message(viFcCount1).
end.
<M-49 run SetMessage
(input #T-83'Unable to Save XML as Longchar':255(778664708)T-83# (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'blf-235599':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if vcErrors <> ""
then do viFcCount1 = 1 to num-entries(vcErrors, chr(2)):
<M-32 run SetMessage
(input entry(viFcCount1, vcErrors, chr(2)) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E' (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'blf-656541':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
end.
assign oiReturnStatus = -1.
return.
end.
delete object vhNodeValue.
delete object vhNode.
delete object vhContextInfo.
delete object vhRoot.
delete object vhDocument.
<M-1 run AddDetailLine
(input 'fcDaemonQueue':U (icTable),
input '' (icParentRowid),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
<M-2 run AddDetailLine
(input 'XmlDaemonQueue':U (icTable),
input tfcDaemonQueue.tc_Rowid (icParentRowid),
output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
/* Save date and time in UTC */
assign session:timezone = 0.
create tFileList.
assign tfcDaemonQueue.DaemonQueueRef = vcShortName
tfcDaemonQueue.DaemonQueueRefDescription = vcShortName
tfcDaemonQueue.DaemonQueuePriority = viXmlPriority
tXmlDaemonQueue.DaemonQueueId = tfcDaemonQueue.DaemonQueueId
tXmlDaemonQueue.XmlDaemonQueueFileName = vcShortName
tXmlDaemonQueue.XmlDaemonQueueXmlClassName = vcCreateXmlClassName
tXmlDaemonQueue.XmlDaemonQueueXmlCyCode = vcXmlCompanyCode
tXmlDaemonQueue.XmlDaemonQueueXmlOrigin = vcXmlOriginator
tXmlDaemonQueue.XmlDaemonQueueXmlFreeText = vcXmlComment
tXmlDaemonQueue.XmlDaemonQueueAct = vcXmlActivity
tXmlDaemonQueue.XmlDaemonQueueXmlCrtDate = today
tXmlDaemonQueue.XmlDaemonQueueXmlCrtTime = time
tXmlDaemonQueue.XmlDaemonQueueFileOwner = vcFileOwner
tXmlDaemonQueue.XmlDaemonQueueLOB = vpXMLRepresentation
tFileList.tcFileName = vcFileRenamed
viKeyCount = 99999
viXmlFileCounter = viXmlFileCounter + 1.
assign session:timezone = viTimeOffset.
end.
input stream sdir close.
/* Create queue entries */
if can-find(first tfcDaemonQueue where
tfcDaemonQueue.tc_Status = "N")
then do:
<M-4 run ValidateBC (output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
<M-5 run AdditionalUpdates (output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
<M-6 run DataSave (output viFcReturnSuper (oiReturnStatus)) in BXmlDaemonQueue>
if viFcReturnSuper <> 0
then assign oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
end.
finally:
for each tFileList:
os-delete value(tFileList.tcFileName).
end.
empty temp-table tFileList.
if valid-handle(vhNodeValue)
then delete object vhNodeValue.
if valid-handle(vhNode)
then delete object vhNode.
if valid-handle(vhContextInfo)
then delete object vhContextInfo.
if valid-handle(vhRoot)
then delete object vhRoot.
if valid-handle(vhDocument)
then delete object vhDocument.
end finally.