/* REXX */
/*%STUB CALLCMD*/
/*********************************************************************/
/* Copyright:    Licensed Materials - Property of IBM and/or HCL     */
/*                                                                   */
/*        Copyright IBM Corporation. All rights reserved             */
/*        Copyright HCL Technologies limited. All rights reserved    */
/*                                                                   */
/*        US Government Users Restricted Rights -                    */
/*        Use, duplication or disclosure restricted by               */
/*        GSA ADP Schedule Contract with IBM Corp.                   */
/*                                                                   */
/*********************************************************************/

   Call syscalls('ON')

   parse arg '"'manifest'"' '"'skipBackup'"' '"'workDir'"',
                '"'traceOption'"' '"'sysoutValue'"',
                '"'tempUnit'"' '"'tempVolSerValue'"'.

   if traceOption == 'true' then interpret 'trace a'

   /* Set Sysout class and temp volser */
   sysoutClass = ''
   tempVolser  = ''
   If sysoutValue /= "" Then sysoutClass = 'SYSOUT('sysoutValue')'
   If tempVolSerValue /= "" Then tempVolser  = 'VOLUME('tempVolSerValue')'

   Say 'Backup Manifest file :' manifest
   Say 'Working directory :' workDir
   say ''

   Call loadPackageManifest(manifest)

   Call performBackup(skipBackup)

   deltaManifest = workDir'/deltaDeployed.xml'
   Call createDeltaDeployFile(deltaManifest)

Exit

loadPackageManifest :procedure expose manlist.

  parse arg manifest

   Address syscall "readfile (manifest) manlist."
   If retval < 0 Then
   Do
      Say 'There was a problem reading the manifest file :' manifest ||,
          ' Errno :' errno 'Reason :' right(errnojr,8,0)
      Call ExitProgram(8)
   End

  if manlist.0 = 0 then
  do
    Say 'Backup Manifest MVS File is empty.'
    Call ExitProgram(8)
  end

Return

performBackup:
    parse arg skipBackup

   /*
    Description of the DeltaMap data structure
    DeltaMap.1 = Added Containers
    DeltaMap.2 = Updated Containers
    DeltaMap.3 = Deleted Containers
    DeltaMap.i.# = List of Containers
    DeltaMap.i.j.# = List of Resources
    DeltaMap.i.j.#.missing = 0 or 1
   */
   DeltaMap.1.0 = 0
   DeltaMap.2.0 = 0
   DeltaMap.3.0 = 0
   DeltaMap.0 = 3
   lastPosition = 0

   isDeleted = 0
   ds = 0
   dsnSet = ''
   MemList. = ''

   Do i = 1 to manlist.0
      If Pos('<deleted>',manlist.i) > 0 Then
        isDeleted = 1
      Else If Pos('</deleted>',manlist.i) > 0 Then
        isDeleted = 0
      Else If Pos('<container',manlist.i) > 0 Then
      Do
        Parse var manlist.i . ' name="' dataset '" type="' Type '"' restOfContainer
        dataset = Strip(dataset)

        If Type = 'sequential' Then
          Call buildDeltaMapForSequentialContainer(dataset isDeleted restOfContainer)
        Else
          Call buildDeltaMapForPdsContainer(dataset isDeleted restOfContainer)

        If Wordpos(dataset,dsnSet) = 0 Then
          dsnSet = dsnSet dataset

        If Type = 'sequential' Then
          MemList.dataset = 'sequential'
        Else do c = 1 to CopyMem.0
          MemList.dataset = MemList.dataset CopyMem.c
        End

      End
   End

   if (skipBackup == 'true') then return

   k = 0
   Do i = 1 to Words(dsnSet)
     dataset = Word(dsnSet,i)
     If Memlist.dataset <> '' Then
     Do
       xmi_rc = xmi_it();
       If xmi_rc = 0 Then
       Do
         k = k + 1
         ZipDSN.k = dataset".bin"
       End
     End
     Else
       Say 'There are no members to back up in' dataset
   End
   ZipDSN.0 = k

   If ZipDSN.0 > 0 then
      Call zipBinaryFiles(workDir)

Return

buildDeltaMapForSequentialContainer:procedure expose DeltaMap.

  parse arg dataset isDeleted restOfContainer

  addedContainers  = DeltaMap.1.0
  updateContainers = DeltaMap.2.0
  deleteContainers = DeltaMap.3.0

  containerTag = '<container name="'dataset'" type="sequential"'

  quotedDsn = "'"dataset"'"
  ListdsiRC = Listdsi(quotedDsn directory recall)
  If ListdsiRC = 16 Then
  Do
    If SYSREASON = 5 Then
    Do
      missingAttr = ' missing="true"'
      Say 'The data set' dataset 'does not exist.'
      If isDeleted Then
      Do
        deleteContainers = deleteContainers + 1
        DeltaMap.3.deleteContainers = containerTag || missingAttr || restOfContainer
      End
      Else
      Do
        addedContainers = addedContainers + 1
        DeltaMap.1.addedContainers = containerTag || missingAttr || restOfContainer
      End
    End
  End
  Else
  Do
    If isDeleted Then
    Do
     deleteContainers = deleteContainers + 1
     DeltaMap.3.deleteContainers = containerTag || restOfContainer
    End
    Else
    Do
      updateContainers = updateContainers + 1
      DeltaMap.2.updateContainers = containerTag || restOfContainer
    End
  End

  DeltaMap.1.0 = addedContainers
  DeltaMap.2.0 = updateContainers
  DeltaMap.3.0 = deleteContainers

Return

buildDeltaMapForPdsContainer:procedure expose i manlist. DeltaMap. CopyMem.

  parse arg dataset isDeleted restOfContainer

  addedContainers  = DeltaMap.1.0
  updateContainers = DeltaMap.2.0
  deleteContainers = DeltaMap.3.0

  sysdsnRC = 'OK'
  quotedDsn = "'"dataset"'"
  ListdsiRC = Listdsi(quotedDsn directory recall)
  isPdsNotExist = 0
  If ListdsiRC <= 4 Then
  Do
    If SYSMEMBERS = 0 Then
    Do
      sysdsnRC = 'MEMBER NOT FOUND'
    End
  End
  Else
  Do
    If SYSREASON = 5 Then
    Do
      isPdsNotExist = 1
      sysdsnRC = 'MEMBER NOT FOUND'
      Say 'The data set' dataset 'does not exist.'
    End
    Else
    Do
      Say 'There was a problem checking the existence of the data set' dataset
      Say 'The return code from the LISTDSI function is :' SYSREASON
      Call ExitProgram(8)
    End
  End

  CopyMemCount = 0
  /* Get all the members to zip               */
  i = i + 1
  Do while (Pos('<resource',manlist.i) > 0)
     Parse var manlist.i . ' name="' member '" type="' type '"' restOfResource

     /* Need to change the XML format chars to real chars */
     member = chkmem3(member)
     member=Strip(member)
     /* Need to check that the member exists in the    */
     /* previous PDS. If not Transmit will fail.       */
     /* Also we need to mark this as we will need      */
     /* to delete the member if a restore is done.     */

      If sysdsnRC = 'OK' Then
      Do
          tempdsn = "'"dataset"("Strip(member)")'"
          x  = MSG('Off')
          sysdsnRCRes = sysdsn(tempdsn)
          If Pos('INVALID DATASET NAME,',sysdsnRCRes) > 0 Then
          Do
            /* probably an IMS member with invalid characters */
            /* Try LMMFIND as that works                      */
            "ISPEXEC LMINIT DATAID(DOD) DATASET('"dataset"') ENQ(SHR)"
            "ISPEXEC LMOPEN DATAID("DOD")"
            "ISPEXEC LMMFIND  DATAID("DOD") MEMBER("member")"
            If RC = 0 Then
              sysdsnRCRes = 'OK'
            Else
              sysdsnRCRes = 'MEMBER NOT FOUND'
            "ISPEXEC LMCLOSE DATAID("DOD")"
            "ISPEXEC LMFREE DATAID("DOD")"
          End
          x  = MSG('On')
      End
      else
      Do
          sysdsnRCRes = 'MEMBER NOT FOUND'
      End

     Select
       When (sysdsnRCRes = 'OK') Then
       Do
         /* Need to get rid of weird chars */
         cpyMember = chkmem2(member)
         CopyMemCount = CopyMemCount + 1
         CopyMem.CopyMemCount = Strip(cpyMember)
          If isDeleted Then
          Do
            parse var DeltaMap.3.deleteContainers . 'name="' LDataSet '"' .
            If LDataSet = dataset then
            Do
              lastPosition = DeltaMap.3.deleteContainers.0 + 1
              DeltaMap.3.deleteContainers.lastPosition = member
              DeltaMap.3.deleteContainers.lastPosition.restOfResourceTag = restOfResource
              DeltaMap.3.deleteContainers.lastPosition.missing = 0
              DeltaMap.3.deleteContainers.0 = lastPosition
            End
            Else
            Do
              deleteContainers = deleteContainers + 1
              containerPrefixTag = '<container name="'dataset'" type="PDS"'
              DeltaMap.3.deleteContainers = containerPrefixTag || restOfContainer
              DeltaMap.3.deleteContainers.1 = member
              DeltaMap.3.deleteContainers.1.restOfResourceTag = restOfResource
              DeltaMap.3.deleteContainers.1.missing = 0
              DeltaMap.3.deleteContainers.0 = 1
            End
          End
          Else
          Do
            parse var DeltaMap.2.updateContainers . 'name="' LDataSet '"' .
            If LDataSet = dataset then
            Do
              lastPosition = DeltaMap.2.updateContainers.0 + 1
              DeltaMap.2.updateContainers.lastPosition = member
              DeltaMap.2.updateContainers.lastPosition.restOfResourceTag = restOfResource
              DeltaMap.2.updateContainers.lastPosition.missing = 0
              DeltaMap.2.updateContainers.0 = lastPosition
            End
            Else
            Do
              updateContainers = updateContainers + 1
              containerPrefixTag = '<container name="'dataset'" type="PDS"'
              DeltaMap.2.updateContainers = containerPrefixTag || restOfContainer
              DeltaMap.2.updateContainers.1 = member
              DeltaMap.2.updateContainers.1.restOfResourceTag = restOfResource
              DeltaMap.2.updateContainers.1.missing = 0
              DeltaMap.2.updateContainers.0 = 1
            End
          End
       End
       When (sysdsnRCRes= 'MEMBER NOT FOUND') Then
       Do
          If isDeleted Then
            Do
            parse var DeltaMap.3.deleteContainers . 'name="' LDataSet '"' .
            If LDataSet = dataset then
            Do
              lastPosition = DeltaMap.3.deleteContainers.0 + 1
              DeltaMap.3.deleteContainers.lastPosition = member
              DeltaMap.3.deleteContainers.lastPosition.missing = 1
              DeltaMap.3.deleteContainers.lastPosition.restOfResourceTag = restOfResource
              DeltaMap.3.deleteContainers.0 = lastPosition
            End
            Else
            Do
              deleteContainers = deleteContainers + 1
              containerTagPrefix = '<container name="'dataset'" type="PDS"'
              if (isPdsNotExist) then
                containerTagPrefix = containerTagPrefix ||,
                                                    ' missing="true"'

              DeltaMap.3.deleteContainers = containerTagPrefix || restOfContainer
              DeltaMap.3.deleteContainers.1 = member
              DeltaMap.3.deleteContainers.1.missing = 1
              DeltaMap.3.deleteContainers.1.restOfResourceTag = restOfResource
              DeltaMap.3.deleteContainers.0 = 1
            End
          End
          Else
          Do
            parse var DeltaMap.1.addedContainers . 'name="' LDataSet '"' .
            if LDataSet = dataset then
            Do
                lastPosition = DeltaMap.1.addedContainers.0 + 1
                DeltaMap.1.addedContainers.lastPosition = member
                DeltaMap.1.addedContainers.lastPosition.missing = 0
                DeltaMap.1.addedContainers.lastPosition.restOfResourceTag = restOfResource
                DeltaMap.1.addedContainers.0 = lastPosition
            End
            Else
            Do
                addedContainers = addedContainers + 1
                containerTagPrefix = '<container name="'dataset'" type="PDS"'
                if (isPdsNotExist) then
                  containerTagPrefix = containerTagPrefix ||' missing="true"'
                DeltaMap.1.addedContainers = containerTagPrefix || restOfContainer
                DeltaMap.1.addedContainers.1 = member
                DeltaMap.1.addedContainers.1.missing = 0
                DeltaMap.1.addedContainers.1.restOfResourceTag = restOfResource
                DeltaMap.1.addedContainers.0 = 1
            End
          End
       End
       Otherwise
       Do
         Say 'There was a problem checking the existence of the member.'
         Say 'Message received :' sysdsnRCRes
         Call ExitProgram(8)
       End
     End
     i = i + 1
  End
  i = i - 1

  CopyMem.0 = CopyMemCount

  DeltaMap.1.0 = addedContainers
  DeltaMap.2.0 = updateContainers
  DeltaMap.3.0 = deleteContainers

Return

Xmi_it :

   /* Take a stab at the allocation of the sequential XMI  */
   /* file. XMITs are generally about the same size as     */
   /* the actual PDS. So if we are XMITing the whole thing */
   /* then make the primary the same as the PDS. If we are */
   /* XMITing some members split the primary and secondary */
   /* up.                                                  */

   Address ISPEXEC "DSINFO DATASET('"dataset"')"
   nummems = Space(ZDS#MEM,0)

   Select
     When (rc = 8) Then
       return 8
     When (rc = 0) Then
     do
       if (ZDSORG /= 'PS' & nummems = 0) then
          return 8
     end
     Otherwise
     Do
       say "DSINFO failed on '"dataset"' Return Code :" rc
       Say ZERRMSG ':' ZERRSM
       Say ZERRLM
       Call ExitProgram(rc)
     End
   End

   /* Need to get rid of the thousands separators */
   AllocUnit = Translate(Strip(ZDSTOTA),"abc def ghi jkl","abc,def,ghi,jkl")
   AllocUnit = Space(AllocUnit,0)
   UsedUnit  = Translate(Strip(ZDSTOTU),"abc def ghi jkl","abc,def,ghi,jkl")
   UsedUnit  = Space(UsedUnit,0)
   NumMems   = Translate(Strip(ZDS#MEM),"abc def ghi jkl","abc,def,ghi,jkl")
   NumMems   = Space(NumMems,0)

   If ZDSDSNT = 'LIBRARY' Then
     SpaceUsed = AllocUnit*(ZDSPERU/100)
   Else
     SpaceUsed = UsedUnit

   If ZDSORG = 'PS' Then
   Do
     Primary   = Max(Format(SpaceUsed/4,,0),1)
     Secondary = Primary
   End

   /* If only some members are being copied then calculate   */
   /* the primary as a percentage of the members being       */
   /* copied against the total member count. If the total    */
   /* percentage of members is > 24% then set primary to 25% */
   Else
   Do
      Memperc   = (Words(Memlist.dataset)/NumMems)*100
     If Memperc > 24 Then
     Do
       Primary   = Max(Format(SpaceUsed/4,,0),1)
       Secondary = Primary
     End
     Else
     Do
       Primary   = Max(Format(SpaceUsed*Memperc/100,,0),1)
       Secondary = Max(Format(((SpaceUsed-Primary)/15)+1,,0),1)
     End
   End

   /* Create the space units literal, either tracks, cylinders */
   /* or Blocks. If blocks, the blocksize is also required.    */

   If Pos('BLOCK',ZDSSPC) > 0 Then
     SpaceUnits = Strip(ZDSSPC)'('Strip(ZDSBLK)')'
   Else
     SpaceUnits = Strip(ZDSSPC)

   Select
     When (SpaceUnits = 'MEGABYTE') Then
     Do
       SpaceUnits = 'TRACK'
       Primary    = Primary%0.06
       Secondary  = Secondary%0.06
     End
     When (SpaceUnits = 'KILOBYTE') Then
     Do
       SpaceUnits = 'TRACK'
       Primary    = Primary%56
       Secondary  = Secondary%56
     End
     When (SpaceUnits = 'BYTE') Then
     Do
       SpaceUnits = 'TRACK'
       Primary    = Primary%56664
       Secondary  = Secondary%56664
     End
     Otherwise
       Nop
   End
   If Primary < 10 Then
     Primary = 10
   If Secondary < 10 Then
     Secondary = 10

   x= MSG('off')
   Address TSO "FREE F(SEQFILE)"
   x= MSG('on')
   Address TSO "ALLOC F(SEQFILE) NEW " SpaceUnits ||,
            " UNIT("tempUnit") "tempVolser" DSORG(PS)" ||,
            " BLKSIZE(3120) LRECL(80) RECFM(F B)" ||,
            " SPACE("Primary" "Secondary")"

   xmit_rc = 0
   /* You have to XMIT into a sequential dataset            */
   XX=OUTTRAP('STEM.')
   If ZDSORG = 'PS' Then
   Do
     Address TSO "XMIT A.A DA('"dataset"')",
                    "OUTDD(SEQFILE) NON NOL " sysoutClass
     xmit_rc = rc
   End
   Else
   Do
     /* Going to copy members to a temporary data set first */
     /* to ensure aliases are copied. Then XMIT the         */
     /* complete data set                                   */

     /* Need to put blanks into record format */
     recfm = ''
     Do r = 1 to length(strip(ZDSRF))
       recfm = recfm || substr(strip(ZDSRF),r,1) || ' '
     End
     /* get some additional stuff to allocate temp PDS */
     If ZDSDSNT = 'LIBRARY' Then
       DSORG = 'DSORG('ZDSORG') DSNTYPE(LIBRARY)'
     Else
     Do
       DirBlks = Words(Memlist.dataset) % 2
       If DirBlks < 10 Then
          DirBlks = 10
       Select
         When (SpaceUnits = 'TRACK') Then
         Do
           DirSpace = DirBlks * 256
           DirSpace = DirSpace % 56664
           If DirSpace = 0 Then
             DirSpace = 1
           Primary = Primary + DirSpace
         End
         When (SpaceUnits = 'CYLINDER') Then
         Do
           DirSpace = DirBlks * 256
           DirSpace = DirSpace % 849960
           If DirSpace = 0 Then
             DirSpace = 1
           Primary = Primary + DirSpace
         End
         Otherwise
         Do
           DirSpace = ZDSBLK%256
           DirSpace = DirSpace%DirBlks
           If DirSpace = 0 Then
             DirSpace = 1
           Primary = Primary + DirSpace
         End
       End
       DSORG = 'DSORG('ZDSORG') DIR('Strip(DirBlks)')'
     End

     Address TSO "ALLOC F(TEMPPDS) NEW " SpaceUnits ||,
          " UNIT("tempUnit") "tempVolser" "DSORG ||,
          " BLKSIZE("ZDSBLK") LRECL("ZDSLREC") RECFM("recfm")"          ||,
          " SPACE("Primary" "Secondary")"

     /* Now copy the members to the temp PDS */
     x = msg('off')
      Address TSO "FREE F(SYSPRINT)"
     x = msg('on')

     Address TSO "ALLOC F(SYSPRINT) NEW REUSE"
     Address TSO "ALLOC F(INDD)  DA('"dataset"') SHR REUSE"
     Address TSO "ALLOC F(SYSIN) NEW REUSE"

     Drop SYSLINE.
     ss = 1

     SYSLINE.1 = " COPYGROUP OUTDD=TEMPPDS,INDD=INDD"

     Do mems = 1 to words(Memlist.dataset)
        copymem = Word(Memlist.dataset,mems)
        ss = ss + 1
        SYSLINE.ss = "  SELECT MEMBER=("copymem")"
     End
     SYSLINE.0 = ss
     Address TSO "EXECIO "SYSLINE.0" DISKW SYSIN (STEM SYSLINE. FINIS)"

     Address ISPEXEC "ISPEXEC SELECT PGM(IEBCOPY)"
     Copy_rc = rc

     If Copy_rc = 0 Then
     Do
       Address TSO "XMIT A.A DD(TEMPPDS) OUTDD(SEQFILE) NON NOL " ||,
               sysoutClass
       xmit_rc = rc
     End
     Else
     Do
       "EXECIO * DISKR SYSPRINT (FINIS STEM sysprint."
       Do x = 1 to sysprint.0
         Say Strip(sysprint.x)
       End
       Call ExitProgram(8)
     End

     Address TSO "FREE F(TEMPPDS)"
   End

   If xmit_rc <> 0 Then
   Do
      isNonEmptyPds = 1
      Do x = 1 to stem.0
        If Pos('Empty partitioned datasets cannot be transmitted',stem.x) Then
          isNonEmptyPds = 0
      End

      If isNonEmptyPds Then
      Do
        Do x = 1 to stem.0
          Say stem.x
        End
        /* Need to run the copy through IEBCOPY just to get the      */
        /* message. Stupid solution but XMIT does not return the     */
        /* sysprint output and IEBCOPY always creates the sequential */
        /* data set as VS.                                           */
        Address TSO "ALLOC F(INDD)  DA('"dataset"') SHR REUSE"
        Address TSO "ALLOC F(SYSIN) NEW REUSE"
        SYSIN.0 = 1
        SYSIN.1 = " COPYGROUP OUTDD=SEQFILE,INDD=INDD"
        n = 1
        Do mems = 1 to words(memlist.dataset)
          copymem = Word(memlist.dataset,mems)
          n = n + 1
          SYSIN.n = "  SELECT MEMBER=("Strip(copymem)")"
        End
        SYSIN.0 = n
        Address TSO "EXECIO * DISKW SYSIN (STEM SYSIN. FINIS)"

        /* Call IEBCOPY to XMIT into a sequential dataset */
        Address ISPEXEC "ISPEXEC SELECT PGM(IEBCOPY)"
        "EXECIO * DISKR SYSPRINT (FINIS STEM sysprint."
        Do x = 1 to sysprint.0
          Say Strip(sysprint.x)
        End

        Address TSO "FREE F(INDD)"
        Address TSO "FREE F(SYSIN)"

        Call ExitProgram(8)
      End
   End
   XX=OUTTRAP('OFF')

   hfsFile = workDir"/"dataset".bin"
   call copySeqFileToHfs(hfsFile)

Return 0

copySeqFileToHfs:procedure

  parse arg filePath

  x = msg('off')
    Address TSO "FREE F(HFSFILE)"
  x = msg('on')

  Address TSO "ALLOC F(HFSFILE) PATH('"filePath"')",
              "PATHMODE(SIRWXU,SIRGRP,SIXGRP,SIROTH,SIXOTH)",
              "PATHOPTS (ocreat, owronly)"

  Address TSO "OCOPY INDD(SEQFILE) OUTDD(HFSFILE) BINARY"
  if rc <> 0 then
  do
    say "OCOPY operation failed with return code :" rc
    call ExitProgram(8)
  end


  Address TSO "FREE F(SEQFILE)"
  Address TSO "FREE F(HFSFILE)"

return

zipBinaryFiles :procedure expose ZipDSN.

   parse arg workDir

   ZipList = ''
   Do c = 1 to ZipDSN.0
      ZipList = ZipList "'"ZipDSN.c"'"
   End

   shellcmd="cd '"workDir"';chmod 744 "ZipList
   call executeShellCommand(shellcmd)

   zipName = "backup.zip"
   shellcmd="cd '"workDir"';pax -o saveext -wvpe -f '"zipName"'" ZipList
   call executeShellCommand(shellcmd)
   say "Backup zip created :" workDir"/"zipName

Return

executeShellCommand: procedure

   parse arg shellcmd

   sh_rc = bpxwunix(shellcmd,,stdout.,stderr.)

   If stderr.0 > 0 Then
   Do
      Do e = 1 to stderr.0
         Say stderr.e
      End
   End

   If stdout.0 > 0 Then
   Do
      Say '---STDOUT---'
      Do o = 1 to stdout.0
         Say stdout.o
      End
   End

   If sh_rc /= 0 Then do
      say "Command :" shellcmd "failed with rc :" sh_rc
      Call ExitProgram(sh_rc)
   end

return

createDeltaDeployFile :procedure expose DeltaMap.

  parse arg deltaManifest

   /*
    Description of the DeltaMap data structure
    DeltaMap.1 = Added Containers
    DeltaMap.2 = Updated Containers
    DeltaMap.3 = Deleted Containers
    DeltaMap.i.# = List of Containers
    DeltaMap.i.j.# = List of Resources
    DeltaMap.i.j.#.missing = 0 or 1
   */

   XML_INDENT_1 = '    '
   XML_INDENT_2 = copies(XML_INDENT_1, 2)
   XML_INDENT_3 = copies(XML_INDENT_1, 3)

   DeltaFile.1 = '<?xml version="1.0"?>'
   DeltaFile.2 = '<manifest type="MANIFEST_REPORT">'
   k = 2

   Do i = 1 to DeltaMap.0
     Select
       When (i == 1) then
       Do
         k = k + 1
         DeltaFile.k = ''
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '<created>'
       End
       When (i == 2) then
       Do
         k = k + 1
         DeltaFile.k = ''
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '<updated>'
       End
       Otherwise /* i == 3 */
       Do
         k = k + 1
         DeltaFile.k = ''
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '<deleted>'
       End
     End

     Do j = 1 to DeltaMap.i.0
        If pos(' type="sequential"', DeltaMap.i.j) > 0 Then
        Do
            k = k + 1
            DeltaFile.k = XML_INDENT_2 || DeltaMap.i.j
        End
        Else
        Do
          k = k + 1
          DeltaFile.k = XML_INDENT_2 || DeltaMap.i.j

          Do l = 1 to DeltaMap.i.j.0
            k = k + 1
            DeltaMap.i.j.l = chkmem1(DeltaMap.i.j.l)

            resourceTagPrefix = XML_INDENT_3 || '<resource' ||,
                          ' name="'DeltaMap.i.j.l'" type="PDSMember"'
            If (DeltaMap.i.j.l.missing) then
              DeltaFile.k = resourceTagPrefix || ' missing="true"' || DeltaMap.i.j.l.restOfResourceTag
            else
              DeltaFile.k = resourceTagPrefix || DeltaMap.i.j.l.restOfResourceTag
          End

          k = k + 1
          DeltaFile.k = XML_INDENT_2 || '</container>'
        End
     End

     Select
       When (i == 1) then
       Do
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '</created>'
       End
       When (i == 2) then
       Do
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '</updated>'
       End
       Otherwise /* i == 3 */
       Do
         k = k + 1
         DeltaFile.k = XML_INDENT_1 || '</deleted>'
       End
     End
   End

   k = k + 1
   DeltaFile.k = '</manifest>'
   DeltaFile.0 = k

   Address syscall "writefile (deltaManifest) 755 DeltaFile."
   If rc <> 0 Then
   Do
      Say 'There was an error writing the delta deployed file '||,
          ':' deltaManifest 'Errno :'errno
      Call ExitProgram(8)
   End

   say "Manifest file created for delta deployed datasets :" deltaManifest

Return

chkmem1: Procedure

  /* change characters that may cause problems in the xml */

  Parse arg member
  Validchars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$'
  newMemb = ''

  Do mm = 1 to Length(member)
    char = Substr(member,mm,1)
    If Pos(char,Validchars) = 0 Then
    Do
      newMemb = newMemb||'HexValueIs'||right(C2D(char),3,0)
    End
    Else
      newMemb = newMemb||char
  End

Return newMemb

chkmem2: Procedure

  /* change characters to wildcards for IEBCOPY           */

  Parse arg member
  Validchars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$'
  newMemb = ''

  Do mm = 1 to Length(member)
    char = Substr(member,mm,1)
    If Pos(char,Validchars) = 0 Then
      newMemb = newMemb||'%'
    Else
      newMemb = newMemb||char
  End

Return newMemb

chkmem3: Procedure

  /* change characters that may cause problems in the xml */

  Parse arg member
  nonValid = 'HexValueIs'
  newMemb = ''

  Do mm = 1 to Length(member)
    char = Substr(member,mm,10)
    If char = nonValid Then
    Do
       newMemb = newMemb || D2C(Substr(member,mm+10,03))
       mm = mm + 12 /* Because do loop will increment by 1 */
    End
    Else
      newMemb = newMemb||Substr(member,mm,1)
  End

Return newMemb

ExitProgram :procedure

   Parse arg exit_rc

   ZISPFRC = exit_rc
   Address ISPEXEC "VPUT (ZISPFRC) SHARED"

Exit exit_rc
