/* 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'"' '"'traceOption'"' '"'TempDSN'"' '"'binloc'"',
                '"'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 'Manifest file :' manifest
   Say 'Unpacked location :' binloc

   Call loadManifestIntoStem(manifest)
   Call setdsnsV301
   Call deploy                     /* do the receives             */

Exit

loadManifestIntoStem: procedure expose manlist.
  parse arg manifest
  Address syscall "readfile (manifest) manlist."
  If retval < 0 Then
  Do
    Say "Problem reading manifest file : "manifest". " ||,
        "Errno : "errno" Reason : "right(errnojr,8,0)"."
    Call ExitProgram(8)
  End
Return

setdsnsV301 :

   /* Create a mapping list package data set to deploy      */
   /* data set.                                             */

   k = 0
   RecvMap.0 = k
   isDeleted = 0
   Do i = 1 to manlist.0
     Select
       When (Pos('<deleted>',manlist.i) > 0) Then
         isDeleted = 1

       When (Pos('</deleted>',manlist.i) > 0) Then
         isDeleted = 0

       When (Pos('<container',manlist.i) > 0) Then
       Do
         Parse var manlist.i . ' name="' DataSet '"' .

        /* Ignore directory (i.e. HFS) containers. They are handled by Ant. */
         If Pos(' type="directory"',manlist.i) > 0 Then
           Do
           /* Say "Skipping directory container "DataSet */
           i = i + 1
           Do while (Pos('<resource',manlist.i) > 0)
             i = i + 1
           End
           i = i - 1
           iterate
         End


         /* Need to see if this is a sequential file */
         If Pos(' type="sequential"',manlist.i) > 0 Then
           Sequential = 1
         Else
           Sequential = 0

          /* If dataset was missing during deployment it will be true */
         isDatasetMissing = 0
         if (isDeleted & pos(' missing="true"',manlist.i) > 0) then
            isDatasetMissing = 1

         DeplDSN = Strip(DataSet)

         i = i + 1
         j = 0
         FirstMem = 1
         memberlist.0 = 0
         memberindex = 0
        Do while Pos('<resource',manlist.i) > 0
           Parse var manlist.i . '<resource' . ' name="' member '"' .
          /* Need to change the XML format chars to real chars */
           member = chkmem3(member)
            If isDeleted Then
            Do
               /* If there is a member delete there may be more */
               /* than one. Do the LMINIT once, then process    */
               /* all the member deletes. Then the LMFREE after */
               If FirstMem = 1 Then
               Do
                  FirstMem = 0
                  Address ISPEXEC "LMINIT DATAID(DID) "         ||,
                                     " DATASET('"Strip(DeplDSN)"')" ||,
                                     " ENQ(SHRW)"
                  If (rc = 8) then
                  Do
                    Say 'Deploy to data set 'DeplDSN' does not exist.'||,
                    'Member 'member
                    FirstMem = 1
                    i = i + 1
                    Iterate
                  End
                  Else
                    If (rc > 0) then
                    Do
                      say 'The LMINIT function failed for data'||,
                      'set 'DeplDSN'. Return code 'rc
                      Call ExitProgram(rc)
                    End

                  Address ISPEXEC "LMOPEN DATAID(&DID) OPTION(OUTPUT)"
                  If (rc > 0) then
                  Do
                     say 'The LMOPEN function failed for '||,
                     'data set 'DeplDSN' Return code:' rc
                     Call ExitProgram(rc)
                  End
               End

               Say 'Deleting the member 'member' from 'DeplDSN'.'

               Address ISPEXEC "LMMDEL DATAID(&DID) MEMBER("member")"
               Select
                  When (rc = 0) Then
                     Nop
                  When (rc = 8) Then
                  Do
                     Say 'The deletion of the member 'member' failed ' ||,
                     'because member did not exist in the dataset' DeplDSN
                  End
                  Otherwise
                  Do
                    say 'The deletion of the member 'member' failed.' ||,
                    'Return code : 'rc
                    Call ExitProgram(rc)
                  End
               End
            End
            Else
            do
               memberindex = memberindex + 1
               /* change characters to wildcards for IEBCOPY           */
               member = chkmem2(member)
               memberlist.memberindex = member
               memberlist.0 = memberindex
            end
            i = i + 1
        End

         If FirstMem = 0 Then
         Do
            Address ISPEXEC "LMCLOSE DATAID(&DID)"
            If (rc <> 0) then
            Do
               say 'The LMCLOSE function failed with Return Code : 'rc
               Call ExitProgram(rc)
            End

            Address ISPEXEC "LMFREE DATAID(&DID)"
            If (rc <> 0) then
            Do
               say 'The LMFREE function failed with Return Code:'rc
               Call ExitProgram(rc)
            End
         End
         Call Proc_Action
         i = i - 1
       End
       Otherwise
         Nop
     End
   End
   RecvMap.0 = k

Return

Deploy :

   /* There should be a zip file to deploy based on the contents */
   /* of the manifest.                                           */
   If RecvMap.0 > 0 Then
   Do
      /* One by one transfer xmit files from HFS to temp data set  */
      /* Receive into the target dataset based on the new manifest */
      Do i = 1 to RecvMap.0
         Parse var RecvMap.i 'RecvDSN='RecvDSN' DeployTo='DeplDSN ' Type='Type
         If Type = 'sequential' Then
           sequential = 1
         Else
           sequential = 0

         /* Now copy sequential from HFS to sequential data set  */
         x = msg('off')
         Address TSO "FREE F(HFSFILE)"
         Address TSO "FREE F(SEQFILE)"
         Address TSO "FREE F(SYSPRINT)"
         x = msg('on')

         /* Need to work out how much space to allocate  */
         /* the .bin file in the HFS will have a size in */
         /* bytes. Convert that to tracks based on the   */
         /* calculation that there are 56664 bytes/track */
         stdout.0 = 0
         stderr.0 = 0

         shellcmd="ls -Ego '"binloc"/"RecvDSN".bin'"

         sh_rc = bpxwunix(shellcmd,,stdout.,stderr.)
         If stderr.0 > 0 Then
         Do
            Say '---STDERR---'
            Do e = 1 to stderr.0
               Say stderr.e
            End
         End
         If stdout.0 > 0 Then
         Do
           parse var stdout.1 stuff 21 size .
           dstype = "BASIC"
           select
             when (size <= 56664) Then
               Do
                 trk = 1
               End
             /* when size is lesser than 1.5GB, still alloc BASIC */
             when (size > 56664 & size <= 1500000000  ) Then
               Do
                 trk =  Format(size/56664,,0)
               End
             /* when size IS GREATER THAN 1.5GB alloc LARGE */
             otherwise
               Do
                 trk =  Format(size/56664,,0)
                 dstype = "LARGE"
               End
           End
         End

         Address TSO "ALLOC F(SYSPRINT) DUMMY"
         Address TSO "ALLOC F(SEQFILE) NEW" ||,
                 " TRACKS UNIT("tempUnit") "tempVolser" DSORG(PS)" ||,
                 " BLKSIZE(3120) LRECL(80) RECFM(F B)" ||,
                 " SPACE("trk" "trk") DSNTYPE("dstype")"
         Address TSO "ALLOC F(HFSFILE) PATH('"binloc"/"RecvDSN".bin')"
         Address TSO "OCOPY INDD(HFSFILE) OUTDD(SEQFILE) BINARY"
         if rc <> 0 then
         do
          say "OCOPY operation failed with return code :" rc
          call ExitProgram(8)
         end

         Address TSO "FREE F(HFSFILE)"

         /* Now receive the file and replace what was there     */

         x = PROMPT("ON")

         If sequential Then
           Say 'Deploying sequential data set to 'DeplDSN'.'
         Else
           Say 'Deploying members to 'DeplDSN'.'
         
         /* Allocate a temporary throw away log so we don't */
         /* fill up LOG.MISC                                */

         Address TSO "ALLOC F(LOGFILE) NEW" ||,
              " CYLINDERS UNIT("tempUnit") "tempVolser" DSORG(PS)" ||,
              " BLKSIZE(3120) LRECL(255) RECFM(V B)" ||,
              " SPACE(1 1)"
       Address TSO "ALLOC F(SYSUT4) NEW" ||,
                 " CYLINDERS UNIT("tempUnit") "tempVolser" SPACE(5 10)"
       Address ISPEXEC "QBASELIB LOGFILE ID(LOGFILE)"

         XX=OUTTRAP('STEM.')
         If sequential Then
           Queue " DATASET('"DeplDSN"')" sysoutClass
         Else
           Queue " DATASET('"TempDSN"')" sysoutClass
         Address TSO "RECEIVE INFILE(SEQFILE) NONAMES LOGDS("LOGFILE")"
         if rc <> 0 Then
         Do
            Do xmit = 1 to stem.0
               Say stem.xmit
            End
            Address TSO "FREE F(LOGFILE)"
            Address TSO "FREE F(SEQFILE)"
            Address TSO "FREE F(SYSPRINT)"
            Address TSO "FREE F(SYSUT4)"
            Call ExitProgram(8)
         End
         XX=OUTTRAP('OFF')
         Address TSO "FREE F(SYSPRINT)"
         Address TSO "FREE F(LOGFILE)"

         x = msg('off')
         Address TSO "FREE F(SYSIN)"
         Address TSO "FREE F(SYSPRINT)"
         Address TSO "FREE F(SYSUT4)"
         Address TSO "FREE F(OUTDD)"
         Address TSO "FREE F(INDD)"
         x = msg('on')

         /* Now copy from tempdsn to deploy to data set */

         If sequential Then
           Nop
         Else
         Do
           Address ISPEXEC "DSINFO DATASET('"DeplDSN"')"
           If (rc > 0) then
           Do
             If (rc = 8) Then  /* Data set does not exist */
             Do
               Say ZERRLM'. Allocating data set like 'RecvDSN'.'
               Address ISPEXEC "DSINFO DATASET('"TempDSN"')"
               If (rc > 0) then
               Do
                 say 'DSINFO failed on ' TempDSN 'Return Code :'rc
                 Call ExitProgram(rc)
               End

               blksize = Strip(zdsblk)
               Address TSO "ALLOC DA('"Strip(DeplDSN)"') " ||,
                             "LIKE('"Strip(TempDSN)"') BLKSIZE("blksize")"
               If (rc > 0) then
               Do
                  say 'Problem allocating data set 'DeplDSN ||,
                           '. Return Code='rc
                  Call ExitProgram(rc)
               End
             End
             Else
             Do
               say 'DSINFO failed on ' DeplDSN' Return Code :' rc
               Call ExitProgram(rc)
             End
           End

            Address ISPEXEC "DSINFO DATASET('"DeplDSN"')"
          
            x = msg('off')
            Address TSO "FREE F(TEMPPDS)"
            x = msg('on')

            Address TSO "ALLOC F(SYSPRINT) NEW REUSE" sysoutClass

            Address TSO "ALLOC F(INDD)  DA('"TempDSN"') SHR REUSE"
            If (rc > 0) then
            Do
              say 'Problem allocating data set 'TempDSN ||,
                  ' Return Code :'rc'.'  
              Call ExitProgram(rc)
            End
            Address TSO "ALLOC F(OUTDD) DA('"DeplDSN"') SHR REUSE"
            If (rc > 0) then
            Do
              say 'Problem allocating data set 'DeplDSN ||,
                  ' Return Code :'rc'.'  
              Call ExitProgram(rc)
            End

            Address TSO "ALLOC F(SYSIN) NEW REUSE"
            Address TSO "ALLOC F(SYSUT4) NEW" ||,
                    " CYLINDERS UNIT("tempUnit") SPACE(5 10) " ||,
                    tempVolser

            DROP SYSLINE.
            
          SYSLINE.1 = " COPYGROUP OUTDD=OUTDD,INDD=((INDD,R))"
          
            /* support deploying part of a package */
            Do memberindex = 1 to RecvMap.i.MemList.0
              sysIndex = memberindex + 1
              SYSLINE.sysIndex = "         SELECT MEMBER="||,
                            RecvMap.i.MemList.memberindex
            end
            SYSLINE.0 = RecvMap.i.MemList.0 + 1
            say 'IEBCOPY control statement'
            do x = 1 to SYSLINE.0
              say SYSLINE.x
            end
            Address TSO "EXECIO * DISKW SYSIN (STEM SYSLINE. FINIS)"

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

           If Copy_rc /= 0 Then
           Do
             "EXECIO * DISKR SYSPRINT (FINIS STEM sysprint."
             Do xmit = 1 to sysprint.0
               Say Strip(sysprint.xmit)
             End
             x = Msg('off')
             Address TSO "FREE F(SYSIN)"
             Address TSO "FREE F(SYSPRINT)"
             Address TSO "FREE F(SYSUT4)"
             Address TSO "FREE F(OUTDD)"
             Address TSO "FREE F(INDD)"
             Address TSO "FREE F(SEQFILE)"
             x = Msg('on')
             Call ExitProgram(8)
           End

           x = Msg('off')
           Address TSO "FREE F(SYSIN)"
           Address TSO "FREE F(SYSPRINT)"
           Address TSO "FREE F(SYSUT4)"
           Address TSO "FREE F(OUTDD)"
           Address TSO "FREE F(INDD)"
           Address TSO "FREE F(SEQFILE)"
           Address TSO "DELETE '"TempDSN"'"
           x = msg('on')
        End
      End
   End

Return

Proc_Action:

  if isDeleted Then
  Do
    quotedDsn = "'"DeplDSN"'"
    ListdsiRC = Listdsi(quotedDsn directory)
    If ListdsiRC <= 4 Then
    Do
      If (sequential) Then
      Do
          Say 'Deleting data set 'DeplDSN
          Address TSO "DELETE '"DeplDSN"'"
      End
      else do
        If (isDatasetMissing & SYSMEMBERS = 0) Then
        Do
          Say 'Deleting data set 'DeplDSN' because it did not exist before'||,
              ' deployment and it is now empty.'
          Address TSO "DELETE '"DeplDSN"'"
        End
      end
    End
    else
    do
      if (sequential) then
        say 'The data set 'DeplDSN' was not deleted because it did not exist.'
    end
  End
  else
  Do
    /* There should be a XMI file to receive if the dataset is    */
    /* not already in the map.                                    */
    found = 0
    If sequential then
      Type = 'Type=sequential'
    Else
      Type = 'Type=PDS'

    RecvMapValue = 'RecvDSN='Strip(DataSet)' DeployTo='Strip(DeplDSN) Type
    Do z = 1 to RecvMap.0
      If RecvMap.z = RecvMapValue Then
      Do
        found = 1
      End
    End
    If found = 0 Then
    Do
      k = k + 1
      RecvMap.k = RecvMapValue
      RecvMap.k.MemList.0 = memberlist.0
      do l = 1 to memberlist.0
          RecvMap.k.MemList.l = memberlist.l
      end
      RecvMap.0 = k
    End
  End

Return

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