/* 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 '"'manifestFile'"' '"'mappingFile'"',
                '"'traceOption'"' '"'TempDSN'"' '"'artifactsDirectory'"',
                '"'sysoutValue'"' '"'tempUnit'"' '"'tempVolSerValue'"',
                '"'useDeployTime'"' '"'deployUserId'"'.

   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 'Artifacts directory :' artifactsDirectory
   Say 'Manifest file       :' manifestFile
   Say 'Mapping file        :' mappingFile

   call loadContainerMapperIntoMap(mappingFile)
   Call processManifestContainers(manifestFile)

Exit

loadContainerMapperIntoMap: procedure expose containerMap.

  parse arg mappingFile
  Address syscall "readfile (mappingFile) mapping."
  If retval < 0 Then do
    Say "Problem reading mapping file : "mappingFile". " ||,
        "Errno : "errno" Reason : "right(errnojr,8,0)"."
    Call ExitProgram(8)
  End

  if mapping.0 = 0 then do
    Say 'Mapping file' mappingFile 'is empty.'
    Call ExitProgram(8)
  end

  drop containerMap.
  Do i = 1 to mapping.0
    If Pos('<sourceContainer',mapping.i) > 0 Then Do
      Parse var mapping.i . ' name="' sourceDsn '"' .
      i = i + 1
      If Pos('<targetContainers>', mapping.i) = 0 Then Do
        Say 'Target dataset not found for 'sourceDsn
        Call ExitProgram(8)
      End

      i = i + 1
      targets = ''
      do while pos('<targetContainer ', mapping.i) > 0
        Parse var mapping.i . ' name="' targetDsn '"' .
        targets = targets targetDsn
        i = i + 1
      end
      sourceDsn = Strip(sourceDsn)
      targets = Strip(targets)
      containerMap.sourceDsn = targets
    End
  End

Return

processManifestContainers:

  parse arg manifestFile

  call loadManifestIntoStem(manifestFile)

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

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

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

        if type == 'PDS' then
          call createMemberList isDeleted

        Call performDeployment dataset type isDeleted
      End
      Otherwise
        Nop
    End
  End

Return

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

  if manifest.0 = 0 then
  do
    Say 'Manifest file' manifestFile 'is empty.'
    Call ExitProgram(8)
  end
Return

createMemberList:procedure expose i manifest. memberlist.

  parse arg isDeleted

  drop memberlist.
  memberlist.0 = 0
  memberindex = 0
  i = i + 1
  Do while Pos('<resource',manifest.i) > 0
    Parse var manifest.i . '<resource' . ' name="' member '"' .
    /* Need to change the XML format chars to real chars         */
    member = chkmem3(member)
    /* change characters to wildcards only for IEBCOPY           */
    if (isDeleted == 0) then
      member = chkmem2(member)

    memberindex = memberindex + 1
    memberlist.memberindex = member
    memberlist.0 = memberindex
    i = i + 1
  End
  i = i - 1

return

performDeployment:
  parse arg sourceDsn type isDeleted

  if isDeleted Then
  Do
    targets = getTargetDatasetsFromContainerMap(sourceDsn)
    do g = 1 to words(targets)
      DeplDSN = word(targets, g)
      If type = 'PDS' then
        call deletePdsMembers(DeplDSN)
      else
        call deleteDataset(DeplDSN)
    End
  end
  else do
    if type = 'PDS' then
      call copyPdsMembers sourceDsn
    else
      call copySequentialDataset sourceDsn
  end

Return

copySequentialDataset:
  Parse arg sourceDsn

  binFilePath = artifactsDirectory"/"sourceDsn".bin"
  call copyHFSBinaryToSequentialDataset tempUnit, tempVolser, binFilePath

  targets = getTargetDatasetsFromContainerMap(sourceDsn)
  do p = 1 to words(targets)
    DeplDSN = word(targets, p)
    Say 'Deploying sequential dataset to 'DeplDSN'.'
    call receiveSeqfileIntoDataset DeplDSN
  end

return

copyPDSMembers :

  Parse arg sourceDsn

  binFilePath = artifactsDirectory"/"sourceDsn".bin"
  call copyHFSBinaryToSequentialDataset tempUnit, tempVolser, binFilePath

  call receiveSeqfileIntoDataset TempDSN

  call freeIebcopyDDs

  Address TSO "ALLOC F(SYSPRINT) NEW REUSE"

  Address TSO "ALLOC F(INDD)  DA('"TempDSN"') SHR REUSE"
  If (rc > 0) then
  Do
    say 'Problem allocating dataset 'TempDSN'. Return code : 'rc
    call ExitProgram(8)
  End

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

  Address TSO "ALLOC F(SYSIN) NEW REUSE"

  call writeSysinRecordsForIebcopy

  targets = getTargetDatasetsFromContainerMap(sourceDsn)
  do r = 1 to words(targets)
    DeplDSN = word(targets, r)
    call createTargetDatasetIfNotExist sourceDsn DeplDSN TempDSN
    call runIebcopyProgram DeplDSN

    if useDeployTime == 'true' then do
        if (deployUserId == '') then do
            currentUser = USERID()
        end
        else do
            currentUser = deployUserId
        end
        if(Length(currentUser) < 8) then do
            call updateMemberTimestamps DeplDSN currentUser
        end
        else do
            Say 'Skipping timestamp update for 'DeplDSN'. userId length='Length(currentUser)'.'
        end
    end
  end

  call freeIebcopyDDs

  x = Msg('off')
    Address TSO "DELETE '"TempDSN"'"
  x = msg('on')

Return

writeSysinRecordsForIebcopy:

  DROP SYSLINE.
  SYSLINE.1 = " COPYGROUP OUTDD=OUTDD,INDD=((INDD,R))"
  Do memberindex = 1 to memberlist.0
    sysIndex = memberindex + 1
    SYSLINE.sysIndex = "         SELECT MEMBER="memberlist.memberindex
  end
  SYSLINE.0 = memberlist.0 + 1
  Address TSO "EXECIO * DISKW SYSIN (STEM SYSLINE. FINIS)"

return

createTargetDatasetIfNotExist:procedure

  parse arg sourceDsn DeplDSN TempDSN

  Address ISPEXEC "DSINFO DATASET('"DeplDSN"')"
  select
    when rc = 0 then
      nop
    when rc = 8 then do /* Dataset does not exist */
      Say 'Dataset' DeplDSN 'does not exist. Allocating dataset like 'sourceDsn
      call allocateTargetDataset DeplDSN TempDSN
    end
    otherwise do
      say 'DSINFO failed on 'DeplDSN'. Return code : 'rc
      call ExitProgram(8)
    end
  end

return

runIebcopyProgram:

  parse arg targetDsn

  Address TSO "ALLOC F(OUTDD) DA('"targetDsn"') SHR REUSE"
  If (rc > 0) then
  Do
    say 'Problem allocating dataset 'targetDsn'. Return code : 'rc
    call ExitProgram(8)
  End

  Say 'Deploying members to 'targetDsn'.'

  say 'IEBCOPY control statement'
  do x = 1 to SYSLINE.0
    say SYSLINE.x
  end

  Address ISPEXEC "ISPEXEC SELECT PGM(IEBCOPY) PARM(WORK=4M)"
  If rc <> 0 Then
  Do
    Address TSO "EXECIO * DISKR SYSPRINT (FINIS STEM sysprint."
    Do sys = 1 to sysprint.0
      Say Strip(sysprint.sys)
    End
    call freeIebcopyDDs
    Call ExitProgram(8)
  End

return

updateMemberTimestamps: procedure expose memberlist.

  parse arg dataset currentUser

  Address ISPEXEC "DSINFO DATASET('"dataset"')"
  If rc <> 0 Then
  Do
    say 'DSINFO failed on 'dataset'. Return code : 'rc
    call ExitProgram(8)
  End

  recfm = Strip(zdsrf)
  If recfm = 'U' Then
  Do
    Say 'Skipping timestamp update for 'dataset' (RECFM=U).'
    return
  End

  currentDate = Date('S')
  currentTime = Time('N')
  modifiedDate = Left(currentDate,4)'/'Substr(currentDate,5,2)'/'Right(currentDate,2)
  modifiedTime = Left(currentTime,5)

  Say 'Updating member timestamps in 'dataset' to 'modifiedDate' 'modifiedTime'.'

  Address ISPEXEC "LMINIT DATAID(DID) DATASET('"dataset"') ENQ(SHRW)"
  If rc <> 0 Then
  Do
    say 'LMINIT failed for dataset 'dataset'. Return code : 'rc
    call ExitProgram(8)
  End

  Do m = 1 to memberlist.0
    member = memberlist.m
    lmmstatsCmd = "LMMSTATS DATAID(&DID) MEMBER("member")" ||,
            " MODDATE4("modifiedDate") MODTIME("modifiedTime")" ||,
            " USER("currentUser")"

    Address ISPEXEC lmmstatsCmd
    If rc <> 0 Then Do
      Say 'Warning: Unable to update timestamp for member 'member' in 'dataset ||,
              '. Return code : 'rc
      Address ISPEXEC "LMFREE DATAID(&DID)"
      if rc <> 0 then do
        say "LMFREE failed with return code :" rc
        call ExitProgram(rc)
      end
      call ExitProgram(8)
    End
  End

  Address ISPEXEC "LMFREE DATAID(&DID)"

return

freeIebcopyDDs:

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

return

receiveSeqfileIntoDataset:
  parse arg dataset

  x = PROMPT("ON")

  /* 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('trapOut.')
    Queue " DATASET('"dataset"')" sysoutClass
    Address TSO "RECEIVE INFILE(SEQFILE) NONAMES LOGDS("LOGFILE")"
    receive_rc = rc
  XX=OUTTRAP('OFF')

  if receive_rc <> 0 Then
  Do
    say "RECEIVE command failed for dataset" sourceDsn ||,
        " with return code :" receive_rc
    Do xmit = 1 to trapOut.0
        Say trapOut.xmit
    End
    call freeReceiveDDs
    Call ExitProgram(8)
  End

  call freeReceiveDDs

return

freeReceiveDDs:

  x = msg('off')
    Address TSO "FREE F(LOGFILE)"
    Address TSO "FREE F(SEQFILE)"
    Address TSO "FREE F(SYSUT4)"
  x = msg('on')

return

allocateTargetDataset:procedure

  parse arg targetDsn TempDSN

  blksize = getDatasetBlockSize(TempDSN)

  Address TSO "ALLOC DA('"targetDsn"') LIKE('"TempDSN"') BLKSIZE("blksize")"
  If (rc > 0) then
  Do
    say 'Problem allocating dataset 'targetDsn'. Return code : 'rc
    call ExitProgram(8)
  End

return

getDatasetBlockSize:procedure

  parse arg dataset

  Address ISPEXEC "DSINFO DATASET('"dataset"')"
  If (rc > 0) then
  Do
    say 'DSINFO failed on 'dataset'. Return code : 'rc
    call ExitProgram(8)
  End

  blockSize = Strip(zdsblk)

return blockSize

copyHFSBinaryToSequentialDataset:procedure

  parse arg tempUnit, tempVolser, binFilePath

  trk = getFileSizeInTracks(binFilePath)
  if trk < 26471 then
    dstype = "BASIC"
  else
    dstype = "LARGE"

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

  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('"binFilePath"')"
  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)"

return

getFileSizeInTracks: procedure 

  parse arg filePath 

  shellcmd="ls -Ego '"filePath"'"
  
  sh_rc = bpxwunix(shellcmd,,stdout.,stderr.)
  If sh_rc /= 0 Then do
    say "Command :" shellcmd "failed with rc :" sh_rc
    Call ExitProgram(sh_rc)
  end

  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 sizeInBytes .
    if sizeInBytes <= 56664 Then
      return 1
    else
      return  Format(sizeInBytes/56664,,0)
  End
  else do 
    say "Unable to get size of the file: " filePath
    call ExitProgram(8)
  end 
return

deleteDataset: procedure
  parse arg datasetName 
  quotedDsn = "'"datasetName"'"
  ListdsiRC = Listdsi(quotedDsn directory recall)
  If ListdsiRC <= 4 Then
  Do
    Say 'Deleting dataset 'datasetName
    Address TSO "DELETE '"datasetName"'"
  End
  else        
    say 'The dataset 'datasetName' was not deleted because it did not exist.'
Return

deletePdsMembers: procedure expose memberlist.

  parse arg dataset
  Address ISPEXEC "LMINIT DATAID(DID) DATASET('"dataset"') ENQ(SHRW)"
  select
    when rc = 0 then
      nop
    when rc = 8 then do
      Say 'Target dataset 'dataset' does not exist. Skipping member deletion.'
      return
    end
    otherwise do
      say 'The LMINIT function failed for dataset 'dataset'. Return code : 'rc
      call ExitProgram(8)
    end
  end

  Address ISPEXEC "LMOPEN DATAID(&DID) OPTION(OUTPUT)"
  If (rc > 0) then
  Do
    Call freeDataset
    say 'The LMOPEN function failed for dataset 'dataset'. Return code : 'rc
    call ExitProgram(8)
  End
 
  Do m = 1 to memberlist.0   
    call deletePdsMember dataset memberlist.m
  End

  Call closeDataset
  Call freeDataset

Return

deletePdsMember:

  parse arg dataset member
  Say 'Deleting the member 'member' from 'dataset'.'
  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' dataset
    End
    Otherwise
    Do
      Call closeDataset
      Call freeDataset
      say 'The deletion of the member 'member' failed. Return code : 'rc
      call ExitProgram(8)
    End
  End

return

closeDataset:
  Address ISPEXEC "LMCLOSE DATAID(&DID)"
  If (rc <> 0) then
  Do
    say 'The LMCLOSE function failed with return code : 'rc
    call ExitProgram(8)
  End
Return 

freeDataset:
  Address ISPEXEC "LMFREE DATAID(&DID)"
  If (rc <> 0) then
  Do
    say 'The LMFREE function failed with return code : 'rc
    call ExitProgram(8)
  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

getTargetDatasetsFromContainerMap: procedure expose containerMap.
  parse arg sourceDataset
  if symbol('containerMap.sourceDataset') = 'VAR' then
    return containerMap.sourceDataset

  Say "No target dataset found for source dataset:- "sourceDataset
  call ExitProgram(8)
Return

ExitProgram :procedure

   Parse arg exit_rc

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

Exit exit_rc