RPGLE - CPYTOSTMF example reading XML file

    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
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=