QSRLSAVF & QUI......

The Work with Save File Objects (WRKSAVFOBJ) Utility
Robin Klima - 12:01am Nov 1, 1995 PST
MC Press Online

Save files are a versatile type of AS/400 object. You can use save
files to compress and store AS/400 objects and libraries to disk.
The contents of save files can be saved to offline storage as part
of a backup strategy. Save files can also be used as containers for
sending objects over a SNADS network.

OS/400 provides a number of commands that allow you to interact with
save files. Surprisingly enough, however, there are no commands in
the operating system that allow you to "work with" the contents of
a save file. The closest command is Display Save File (DSPSAVF),
which only lets you view the contents of a save file. In this article,
I'll introduce you to a command that overcomes this limitation. The
Work with Save File Objects (WRKSAVFOBJ) command presents a list of
objects in a save file and allows you to select objects that you want
to restore.

This command is useful because it can save you time when you need to
restore individual objects from a save file. It accomplishes this by
combining several steps into one. For example, suppose you want to
restore some objects from a save file, but you don't know the exact
names of the objects. Using native OS/400 commands, you need to first
run the DSPSAVF command, then either write down the names of the
objects you want to restore or, if you requested a listing, send the
output to a printer. Finally, you need to return to a command line,
prompt the Restore Object (RSTOBJ) command, and begin keying object
names. This can be a time-consuming and possibly error-prone task.

Given the same scenario, the WRKSAVFOBJ command makes this task much
easier. You just need to enter the command followed by the name of the
save file. You are presented with a display showing a list of all of
the objects in the save file. As you find objects you want to restore,
you simply select them from the list and press Enter to restore them to
the system. I'll discuss a number of other features to this command
shortly, but this gives you the basic idea for the purpose for this
command.

As I describe this utility, you'll notice that it has functionality
similar to many other commands in OS/400. This is because I designed
this application to use a UIM list panel (see "UIM List Panels," MC,
July 1994). UIM provides a very consistent user interface that IBM uses
extensively throughout OS/400. UIM list panels provide functionality
similar to subfiles, but require much less code. This utility also takes
advantage of several system application program interfaces (APIs) to
accomplish its task.

APIs

In addition to calling APIs to interact with the list panel, the SAV001RG
program also calls APIs to retrieve information about the contents of the
save file. I'll briefly describe all of the APIs used in this program in
the order in which they are called. Refer to Figure 6 to see the syntax
of the API calls.

The List Save File (QSRLSAVF) API loads the user space with information
about the library that the objects in the save file were saved from.

The Retrieve User Space (QUSRTVUS) API is called to retrieve the library
information from the user space.

The Open Display Application (QUIOPNDA) API opens the SAV001PG panel group.

The Put Dialog Variable (QUIPUTV) API updates the value of the dialog
variables in the "header" variable record by passing a buffer containing
the new values.

The QSRLSAVF API loads the user space with information about the objects
in the save file.

The QUSRTVUS API is called a second time to retrieve the object information
from the user space.

The Add List Entry API (QUIADDLE) API adds an entry to the list panel
(similar to adding a record to a subfile).

The Display Panel (QUIDSPP) API displays the panel and waits for the user
to press F3 or F12.

The Close Application (QUICLOA) API closes the UIM panel group.


/*===============================================================*/
/* To compile:                                                   */
/*                                                               */
/*           CRTCMD     CMD(XXX/WRKSAVFOBJ) PGM(XXX/SAV001CL) +  */
/*                        SRCFILE(XXX/QCMDSRC)                   */
/*                                                               */
/*===============================================================*/
              CMD        PROMPT('Work with Save File Objects')

              PARM       KWD(SAVF) TYPE(QUAL) MIN(1) PROMPT('Save file')

              PARM       KWD(OBJ) TYPE(*GENERIC) DFT(*ALL) +
                           SPCVAL((*ALL)) PROMPT('Object')

              PARM       KWD(OBJTYP) TYPE(*CHAR) LEN(10) RSTD(*YES) +
                           DFT(*ALL) VALUES(*ALRTBL *BNDDIR *CFGL +
                           *CHTFMT *CLD *CLS *CMD *CRQD *CSI *CSPMAP +
                           *CSPTBL *DTAARA *DTAQ *EDTD *EXITRG *FCT +
                           *FILE *FNTRSC *FORMDF *FTR *GSS *JOBD +
                           *JOBQ *JOBSCD *JRN *JRNRCV *MENU *MODULE +
                           *MSGF *MSGQ *NODL *OUTQ *OVL *PAGDFN +
                           *PAGSEG *PDG *PGM *PNLGRP *PRDAVL *PRDDFN +
                           *PRDLOD *QMFORM *QMQRY *QRYDFN *RCT *SBSD +
                           *SCHIDX *SPADCT *SQLPKG *SRVPGM *SSND +
                           *SVRSTG *S36 *TBL *USRIDX *USRQ *USRSPC +
                           *WSCST) SPCVAL((*ALL)) PROMPT('Object type')

  QUAL:       QUAL       TYPE(*NAME) LEN(10)
              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
                           SPCVAL((*LIBL)) PROMPT('Library')


/*===============================================================*/
/* To compile:                                                   */
/*                                                               */
/*           CRTCLPGM   PGM(XXX/SAV001CL) SRCFILE(XXX/QCLSRC)    */
/*                                                               */
/*===============================================================*/
              PGM        PARM(&SAVF &OBJ &OBJTYP)

              DCL        VAR(&SAVF) TYPE(*CHAR) LEN(20)
              DCL        VAR(&OBJ) TYPE(*CHAR) LEN(10)
              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)
              DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
              DCL        VAR(&ERRDTA) TYPE(*CHAR) LEN(10)
              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(80)

              /* Send all errors to error handling routine */
              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

              /* Don't allow this command to be called recursively */
              SNDPGMMSG  MSG(' ') TOPGMQ(*SAME (SAV001RG))
              MONMSG     MSGID(CPF2469) EXEC(GOTO CMDLBL(CONTINUE))
              RMVMSG     PGMQ(*SAME (SAV001RG)) CLEAR(*ALL)
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Command +
                           WRKSAVFOBJ already in use within this +
                           job') MSGTYPE(*ESCAPE)

              /* Check to be sure file exists */
  CONTINUE:   CHKOBJ     OBJ(%SST(&SAVF 11 10)/%SST(&SAVF 1 10)) +
                           OBJTYPE(*FILE)

              /* Check to be sure file is a save file */
              RTVOBJD    OBJ(%SST(&SAVF 11 10)/%SST(&SAVF 1 10)) +
                           OBJTYPE(*FILE) RTNLIB(&RTNLIB) +
                           OBJATR(&OBJATR)
              IF         COND(&OBJATR *NE 'SAVF') THEN(SNDPGMMSG +
                           MSGID(CPF3782) MSGF(QCPFMSG) +
                           MSGDTA(&SAVF) MSGTYPE(*ESCAPE))
              CHGVAR     VAR(%SST(&SAVF 11 10)) VALUE(&RTNLIB)

              /* Re-create the user space */
              DLTUSRSPC  USRSPC(QTEMP/SAV001US)
              MONMSG     MSGID(CPF0000)
              CALL       PGM(QUSCRTUS) PARM('SAV001US  QTEMP' '' +
                           100000 '' '*ALL' '')

              /* Call program to display save file information */
              CALL       PGM(SAV001RG) PARM(&SAVF &OBJ &OBJTYP &ERRDTA)
              IF         COND(&ERRDTA *EQ '*EMPTY') THEN(SNDPGMMSG +
                           MSGID(CPF3707) MSGF(QCPFMSG) +
                           MSGDTA(&SAVF) MSGTYPE(*ESCAPE))
              ELSE       CMD(IF COND(&ERRDTA *NE ' ') THEN(SNDPGMMSG +
                           MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Save +
                           file data generated with' *BCAT &ERRDTA +
                           *BCAT 'command not supported') +
                           MSGTYPE(*ESCAPE)))

              /* Branch around error handling routine */
              GOTO       CMDLBL(ENDPGM)

              /* Error handling routine */
  ERROR:      RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID)
              SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
                           MSGTYPE(*ESCAPE)
  ENDPGM:     ENDPGM


.*===================================================================*
.* To compile:                                                       *
.*                                                                   *
.*           CRTPNLGRP  PNLGRP(XXX/SAV001PG) SRCFILE(XXX/QPNLSRC)    *
.*                                                                   *
.*===================================================================*
:PNLGRP.
.*====================================================================
.* Class Definitions
.*====================================================================
:CLASS    NAME=optcls   BASETYPE=action.
:ECLASS.
:CLASS    NAME=objcls   BASETYPE='OBJNAME 10'.
:ECLASS.
:CLASS    NAME=typcls   BASETYPE='CHAR 7'.
:ECLASS.
:CLASS    NAME=txtcls   BASETYPE='CHAR 40'.
:ECLASS.
:CLASS    NAME=prmcls   BASETYPE='CHAR 255'.
:ECLASS.
.*====================================================================
.* Variable Definitions
.*====================================================================
:VAR      NAME=sfn      CLASS=objcls.
:VAR      NAME=sfl      CLASS=objcls.
:VAR      NAME=cmd      CLASS=objcls.
:VAR      NAME=ofl      CLASS=objcls.
:VAR      NAME=lib      CLASS=objcls.
:VAR      NAME=tfl      CLASS=objcls.
:VAR      NAME=opt      CLASS=optcls.
:VAR      NAME=obj      CLASS=objcls.
:VAR      NAME=typ      CLASS=typcls.
:VAR      NAME=atr      CLASS=objcls.
:VAR      NAME=txt      CLASS=txtcls.
:VAR      NAME=prm      CLASS=prmcls.
.*====================================================================
.* Variable Record and List Definitions
.*====================================================================
:VARRCD  NAME=header    VARS='sfn sfl cmd ofl lib tfl'
          NOGET='sfn sfl cmd ofl lib tfl'.
:VARRCD  NAME=detail    VARS='opt obj typ atr txt'
          NOGET='obj typ atr txt'.
:LISTDEF NAME=detlst    VARS='opt obj typ atr txt'
          MSGID=EDT0417  MSGF='QPDA/QEDTMSG'.
.*====================================================================
.* Key Definitions
.*====================================================================
:KEYL  NAME=fkeys.
:KEYI  KEY=enter    HELP=hlp  ACTION=enter.
:KEYI  KEY=help     HELP=hlp  ACTION=help.
:KEYI  KEY=f1       HELP=hlp  ACTION=help.
:KEYI  KEY=f3       HELP=hlp  ACTION=exit     VARUPD=no  .F3=Exit
:KEYI  KEY=f4       HELP=hlp  ACTION=prompt              .F4=Prompt
:KEYI  KEY=f9       HELP=hlp  ACTION=retrieve            .F9=Retrieve
:KEYI  KEY=f12      HELP=hlp  ACTION=cancel   VARUPD=no  .F12=Cancel
:KEYI  KEY=pagedown HELP=hlp  ACTION=pagedown.
:KEYI  KEY=pageup   HELP=hlp  ACTION=pageup.
:KEYI  KEY=print    HELP=hlp  ACTION=print.
:EKEYL.
.*====================================================================
.* Panel Definition
.*====================================================================
:PANEL NAME=SAV001PG KEYL=fkeys HELP=hlp
        TOPSEP=space .Work with Save File Objects
:DATA     DEPTH=4         LAYOUT=2    compact.
:DATACOL  WIDTH=19.
:DATACOL  WIDTH='*'.
:DATAGRP  GRPSEP=qindent  compact.
:DATAI    VAR=sfn         HELP=hlp    USAGE=out  .Save file
:DATAI    VAR=sfl         HELP=hlp    USAGE=out  .Library
:EDATAGRP.
:DATAI    VAR=cmd         HELP=hlp    USAGE=out  .Save command
:DATAGRP  GRPSEP=qindent  compact.
:DATAI    VAR=ofl         HELP=hlp    USAGE=out  .Object
:DATAI    VAR=lib         HELP=hlp    USAGE=out  .Library
:EDATAGRP.
:DATAI    VAR=tfl         HELP=hlp    USAGE=out  .Object type
:EDATA.
:LIST     DEPTH=14  LISTDEF=detlst  MAXHEAD=1  ACTOR=uim  PARMS=prm.
:TOPINST .Type options, press Enter.
:LISTACT  ENTER='CMD RSTOBJ OBJ(&obj.) SAVLIB(&lib.) DEV(*SAVF)'
           ENTER='OBJTYPE(&typ.) SAVF(&sfl./&sfn.) &prm.'
           PROMPT='CMD ?RSTOBJ ?*OBJ(&obj.) ?*SAVLIB(&lib.)'
           PROMPT='?*DEV(*SAVF) ?*OBJTYPE(&typ.) ?*SAVF(&sfl./&sfn.)'
           PROMPT='&prm.' HELP=hlp OPTION=1  .1=Restore object
:LISTCOL  VAR=opt   USAGE=inout   MAXWIDTH=3   HELP=hlp  .Opt
:LISTCOL  VAR=obj   USAGE=out     MAXWIDTH=10  HELP=hlp  .Object
:LISTCOL  VAR=typ   USAGE=out     MAXWIDTH=7   HELP=hlp  .Type
:LISTCOL  VAR=atr   USAGE=out     MAXWIDTH=10  HELP=hlp  .Attribute
:LISTCOL  VAR=txt   USAGE=out     MAXWIDTH=40  HELP=hlp  .Text
:LISTVIEW COLS='opt obj typ atr txt'.
:ELIST.
:CMDLINE  SIZE=short  .Parameters or command
:EPANEL.
.*====================================================================
.* Help Module
.*====================================================================
:HELP     NAME=hlp.
:EHELP.
:EPNLGRP.


  *===============================================================
  * To compile:
  *
  *      CRTRPGPGM  PGM(XXX/SAV001RG) SRCFILE(XXX/QRPGSRC)
  *
  *===============================================================
  *. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
IGENDS       DS
I                                    B 125 1280OFFLST
I                                    B 133 1360NUMLST
I                                    B 137 1400SIZENT
ILIBINF      DS                             72
I                                        1  10 SAVLIB
I                                       11  20 SAVCMD
I                                       11  16 SAVCM6
IOBJINF      DS                            204
I                                        1  10 OBJNAM
I                                       21  30 OBJTYP
I                                       31  40 OBJATR
I                                      155 194 OBJTXT
ILIBBUF      DS
I                                        1  10 SFN
I                                       11  20 SFL
I                                       21  30 CMD
I                                       31  40 OFL
I                                       41  50 LIB
I                                       51  60 TFL
IOBJBUF      DS
I                                    B   1   20OPT
I                                        3  12 OBJ
I                                       13  19 TYP
I                                       20  29 ATR
I                                       30  69 TXT
I           IDS
I I            'SAV001US  QTEMP     '    1  20 USRSPC
I I            'SAV001PG  *LIBL     '   21  40 PNLGRP
I                                    B  41  440STRPOS
I                                    B  45  480STRLEN
I                                    B  49  520LENSPC
I                                    B  53  560STKCNT
I                                    B  57  600APPSCP
I                                    B  61  640EXTPRM
I                                    B  65  680ERRCOD
I                                    B  69  720FKEY
I                                    B  73  760VARLEN
  *===============================================================
C           *ENTRY    PLIST
C                     PARM           SAVF   20
C                     PARM           OBJFLT 10
C                     PARM           TYPFLT 10
C                     PARM           ERRDTA 10
  *
  * Load user space with library level information
C                     MOVEL'SAVF0100'FMTNAM  8
C                     EXSR LODSPC
  *
  * Get library level information from user space
C                     CALL 'QUSRTVUS'
C                     PARM           USRSPC
C                     PARM           STRPOS
C                     PARM           STRLEN
C                     PARM           LIBINF
  *
  * Perform error checking selection
C                     SELEC
  *
  * If no data issue message
C           SAVLIB    WHEQ *BLANKS
C                     MOVEL'*EMPTY'  ERRDTA
  *
  * If unsupported save command issue message
C           SAVCM6    WHNE 'SAVLIB'
C           SAVCM6    ANDNE'SAVOBJ'
C           SAVCM6    ANDNE'SAVCHG'
C                     MOVELSAVCMD    ERRDTA
  *
  * Otherwise process data
C                     OTHER
C                     EXSR PROCES
C                     ENDSL
  *
C                     MOVE *ON       *INLR
  *===============================================================
C           LODSPC    BEGSR
  *
  * Call the list save file API
C                     CALL 'QSRLSAVF'
C                     PARM           USRSPC
C                     PARM           FMTNAM
C                     PARM           SAVF
C                     PARM           OBJFLT
C                     PARM           TYPFLT
C                     PARM *BLANKS   CNTHND 36
C                     PARM 0         ERRCOD
  *
  * Retrieve the generic header
C                     Z-ADD1         STRPOS
C                     Z-ADD140       STRLEN
  *
C                     CALL 'QUSRTVUS'
C                     PARM           USRSPC
C                     PARM           STRPOS
C                     PARM           STRLEN
C                     PARM           GENDS
  *
  * Calculate starting position and length
C           OFFLST    ADD  1         STRPOS
C                     Z-ADDSIZENT    STRLEN
  *
C                     ENDSR
  *===============================================================
C           PROCES    BEGSR
  *
  * Open display application
C                     CALL 'QUIOPNDA'
C                     PARM           HANDLE  8
C                     PARM           PNLGRP
C                     PARM -1        APPSCP
C                     PARM           EXTPRM
C                     PARM 'N'       FULHLP  1
C                     PARM 0         ERRCOD
  *
  * Put the library level information on the screen
C                     MOVELSAVF      SFN
C                     MOVE SAVF      SFL
C                     MOVELSAVCMD    CMD
C                     MOVELOBJFLT    OFL
C                     MOVELSAVLIB    LIB
C                     MOVELTYPFLT    TFL
  *
C                     CALL 'QUIPUTV'
C                     PARM           HANDLE
C                     PARM           LIBBUF
C                     PARM 60        VARLEN
C                     PARM 'HEADER'  RCDNAM 10
C                     PARM 0         ERRCOD
  *
  * Load user space with object level information
C                     MOVEL'SAVF0200'FMTNAM
C                     EXSR LODSPC
C                     MOVEL'FRST'    OPTION  4
  *
  * Get object level information from user space
C                     DO   NUMLST
C                     CALL 'QUSRTVUS'
C                     PARM           USRSPC
C                     PARM           STRPOS
C                     PARM           STRLEN
C                     PARM           OBJINF
  *
  * Exclude library objects from list
C           OBJTYP    IFNE '*LIB'
C                     Z-ADD0         OPT
C                     MOVELOBJNAM    OBJ
C                     MOVELOBJTYP    TYP
C                     MOVELOBJATR    ATR
C                     MOVELOBJTXT    TXT
  *
  * Add a list entry to the screen
C                     CALL 'QUIADDLE'
C                     PARM           HANDLE
C                     PARM           OBJBUF
C                     PARM 69        VARLEN
C                     PARM 'DETAIL'  RCDNAM 10
C                     PARM 'DETLST'  LSTNAM 10
C                     PARM           OPTION
C                     PARM           LEHNDL  4
C                     PARM 0         ERRCOD
  *
C                     MOVEL'NEXT'    OPTION
C                     ENDIF
  *
  * Calculate position of next entry
C                     ADD  SIZENT    STRPOS
C                     ENDDO
  *
  * Display the panel
C                     CALL 'QUIDSPP'
C                     PARM           HANDLE
C                     PARM           FKEY
C                     PARM 'SAV001PG'PNLNAM 10
C                     PARM 'N'       REDSPO  1
C                     PARM 0         ERRCOD
  *
  * Close the application
C                     CALL 'QUICLOA'
C                     PARM           HANDLE  8
C                     PARM 'M'       CLSOPT  1
C                     PARM 0         ERRCOD
  *
C                     ENDSR


The full article can be found here:

Thanks to Robin Klima