SAVUSROB.RPG

SAVUSROB.RPG code for Ron Turull's tip, " Use the Save Object List API to let users customize nightly saves -- Part II."

      *
      *  Program SAVUSROBJ:  Save User Objects. Saves the objects that
      *                      have been entered into the SAVINFO file.
      *                      The objects are grouped by library and
      *                      saved together. That is, objects in the same
      *                      library are all saved together using a single
      *                      save operation and a single tape label (up to
      *                      the maximum of 1600 objects in a single save
      *                      operation). If file SAVINFO contains more
      *                      than 1600 objects for a single library,
      *                      objects are saved 1600 at a time until all
      *                      objects have been saved.
      *
      *                      User space SAVUSROBJ must already exist in
      *                      QTEMP. Note, it would be more efficient to
      *                      base data structure UsrSpc on a pointer set
      *                      to point to the actual user space object with
      *                      the QUSPTRUS API. This would also allow the
      *                      ObjArr array to be expanded to 32,767 elements.
      *                      The following method simplifies the code,
      *                      especially the initialization code (ie, the
      *                      INZ keyword cannot be used in a based-on
      *                      data structure).
      *

     FSAVINFO   IF   E           K DISK


     D cUsrSpcNam      C                   Const('SAVUSROBJ QTEMP     ')


      *  Data structure for user space (note, 4-byte binary fields must
      *  be defined as 9.0 in RPG). Lx = record length, Kx = Key,
      *  LPx = Length of key-specific Parameter data.

     D UsrSpc          DS

      *     #Keys = the number of records that follow.
     D   #Keys                        9b 0 Inz(4)

      *     Library info record.
     D   L1                           9b 0 Inz(26)
     D   K1                           9b 0 Inz(2)
     D   LP1                          9b 0 Inz(14)
     D   #Libs                        9b 0 Inz(1)
     D   LibName                     10

      *     Tape device record.
     D   L2                           9b 0 Inz(26)
     D   K2                           9b 0 Inz(3)
     D   LP2                          9b 0 Inz(14)
     D   #Devs                        9b 0 Inz(1)
     D   DevName                     10    Inz('TAP01')

      *     End-of-tape option record.
     D   L3                           9b 0 Inz(13)
     D   K3                           9b 0 Inz(10)
     D   LP3                          9b 0 Inz(1)
     D   EndTapeOpt                   1    Inz('1')

      *     Object info record (length not known).
     D   L4                           9b 0
     D   K4                           9b 0 Inz(1)
     D   LP4                          9b 0
     D   #Objs                        9b 0
     D   ObjArr                      20    dim(1600)

      * ----------  End of UsrSpc data structure  ------------


     D Max#Objs        S              9b 0 Inz(%Elem(ObjArr))

      *  The following data structure is used to overlay the
      *  object array in UsrSpc (ObjArr) with the object name
      *  and object type in the proper format.
     D ObjDS           DS
     D   SIOBJ
     D   SITYP

     D LenUsrSpc       S              9b 0
     D StartPos        S              9b 0 Inz(1)


     c                   read      SAVINFO                                lr
     c     *inlr         DoWEq     '0'

     c                   MoveL     *Zeros        #Objs
     c                   MoveL     SILIB         LibName

      *  Fill up ObjArr array.
     c     SILIB         DoWEq     LibName
     c     #Objs         AndLT     Max#Objs
     c     *inlr         AndEq     '0'
     c                   Add       1             #Objs
     c                   MoveL     ObjDS         ObjArr(#Objs)
     c                   read      SAVINFO                                lr
     c                   EndDo

      *  Rewind tape if last save ('0' = rewind).
     c     *inlr         IfEq      '1'
     c                   MoveL     '0'           EndTapeOpt
     c                   EndIf

      *  Set the len of the var-len record (L4) and the len of
      *  parm data (LP4) for the Object Information record.
     c                   Eval      LP4 = (#Objs * 20) + 4
     c                   Eval      L4 = LP4 + 12

      *  Set the len of data in data structure.
     c                   Eval      LenUsrSpc = L1 + L2 + L3 + L4 + 4

      *  Write it to the user space.
     c                   call      'QUSCHGUS'
     c                   parm      cUsrSpcNam    UsrSpcName       20
     c                   parm                    StartPos
     c                   parm                    LenUsrSpc
     c                   parm                    UsrSpc
     c                   parm      '0'           Force2Aux         1

      *  Call the QSRSAVO API to perform save.
     c                   call      'QSRSAVO'
     c                   parm      cUsrSpcNam    UsrSpcName       20
     c                   parm      x'00000000'   ResigError        4

      *  Do next library.
     c                   EndDo


     c                   Return