RPGLE - CPYTOSTMF example
reading XML file
|
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
*
Program Name:
*
Description :
*
Written On :
*
*
Modification
*
~~~~~~~~~~~~
*
Date Mark Int
Description
*
~~~~~~~~ ~~~~ ~~~
~~~~~~~~~~~
*
*
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
H
Option(*SrcStmt: *NoDebugIO)
DftActGrp(*No)
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
*
*
XML Source File
*
~~~~~~~~~~~~~~~
FBIGSOURCE if e k disk rename(BIGSOURCE : format1)
F
prefix(x)
*
*
*
XML Source File
*
~~~~~~~~~~~~~~~
FOUTSOURCE uf a e k
disk rename(OUTSOURCE : format2)
F
prefix(q)
F
usropn
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
*
*
Constants
*
~~~~~~~~~
D
Up C
const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
D
Low C
const('abcdefghijklmnopqrstuvwxyz')
*
*
Program Info
*
~~~~~~~~~~~~
D
PgmInfo SDS
D @PgmName 1
10
D @Parms 37 39
0
D @MsgID 40 46
D @JobName 244 253
D @UserId 254 263
D @JobNbr 264 269
0
*
* Field Definitions.
* ~~~~~~~~~~~~~~~~~~
D
Next S 4 0 inz(0)
D
Chr4 S 4
D*
D
pos S 5 0 inz(0)
D
OutFile S 50
D
infile S 50
*
D
WorkData s 30000 inz(*blanks)
D
TheHeader s 30000 inz(*blanks)
D
Line# S 3 0 inz(0)
D
WriteHeader S 01 inz('Y')
D
pos2 S 5
0 inz(0)
D
pos3 S 5 0 inz(0)
*
D
Cmdstring s 40000 inz(*blanks)
D
CmdLength s 15 5 inz(0)
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* M A I N L I N E
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
*
*
Read the source file to populate WorkData
*
*
C*
C Reset WriteHeader
C*
C *start setll BIGSOURCE
C read BIGSOURCE
C dow not %eof(BIGSOURCE)
C*
C eval WorkData = %Trim(WorkData) +
%trim(xSRCDTA)
C*
C* The header is complete dont
write anymore
C*
C eval pos2 = %scan('' : xSRCDTA)
C if pos2 > 0
C Eval WriteHeader = 'N'
C Endif
C*
C If WriteHeader = 'Y'
C eval TheHeader = %Trim(TheHeader)+
%trim(xSRCDTA)
C Endif
C*
C eval pos3 = %scan('' : xSRCDTA)
C if pos3 > 0
C Eval Line# = (Line# + 1)
C Endif
C*
C eval pos = %scan('' : xSRCDTA)
C if pos > 0
C Or Line# = 90.
C*
C exsr $writeIFS
C*
C If Line# = 90.
C Exsr $Continue
C Endif
C*
C Clear Line#
C*
C endif
C*
C read BIGSOURCE
C enddo
C
C eval *inlr = *on
C return
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C $WriteIFS begsr
C*
C Eval Next = (Next + 1)
C Movel(p) Next Chr4
C '.' Scan InFile Pos
C Eval OutFile = %Trim(%Subst(Infile:1:Pos-1))
C +
%Trim('-')
C +
%Trim(Chr4) + %Trim('.xml')
C*
C if %open(OUTSOURCE)
C close OUTSOURCE
C endif
*
C eval CmdString = %trim('OVRDBF
FILE(OUTSOURCE)') +
C %trim('TOFILE(QTEMP/OUTSOURCE)')
C eval CmdLength = 256.
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C eval CmdString = 'CLRPFM OUTSOURCE'
C eval CmdLength = 256.
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
*
C if not %open(OUTSOURCE)
C open OUTSOURCE
C endif
*
C eval qSRCDTA
= WorkData
C write format2
*
C if %open(OUTSOURCE)
C close OUTSOURCE
C endif
C*
C*
Copy to stream file
C*
CPYTOSTMF FROMMBR('qsys.lib/qgpl.lib/outsource.file/outdata.mbr')
C*
TOSTMF('dsmorders/test.xml-01') STMFOPT(*REPLACE)
C*
C*
C Eval CmdString = 'CPYTOSTMF FROMMBR(''qsys.'
C +
%Trim('lib/qgpl.lib/outsource.file')
C +
%Trim('/outdata.mbr''')
C +
%Trim(') TOSTMF(''')
C +
%Trim('dsmorders/')
C + %Trim(Outfile)
C +
%Trim(''') STMFOPT(*REPLACE)')
C +
%Trim('@@STMFCODPAG(*PCASCII)')
C*
C '@':' ' Xlate CmdString CmdString
C*
C eval
CmdLength = 256.
C*
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C*
C*
C* QSYS/CHGAUT OBJ('dsmorders/*') USER(*PUBLIC)
+
C* DTAAUT(*RWX)
OBJAUT(*ALL)
C*
C Eval CmdString = %Trim('CHGAUT
OBJ(''dsmorde')
C +
%Trim('rs/*'' USER(*PUBLIC) DTAAUT')
C +
%Trim('(*RWX) OBJAUT(*ALL)')
C Eval CmdLength = 256.
C*
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C*
C Clear WorkData
C*
C endsr
C*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C* $Continue - Set up program to send the rest
of the file.
C*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C $Continue begsr
C*
*
C if not %open(OUTSOURCE)
C open OUTSOURCE
C endif
C*
C
Movel(p) TheHeader WorkData
C*
C endsr
C*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C* *inzsr - Initial one time run
subroutine
C*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C *inzsr begsr
*
C *entry plist
C parm infile
*
C endsr
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
Subscribe to:
Post Comments
(
Atom
)
No comments