Problem solve Get help with specific problems with your technologies, process and projects.

Archive a source member

Find a way to archive our old source members without purchasing any new software.

We were instructed by the powers-that-be to find a way to archive our old source members WITHOUT purchasing any new software.

The command ARCSRCM accepts the source file, library, and member name to archive.

CL program ARCSRCM1 runs behind the command and verifies the existence of the source file and member. If it does not exist, an appropriate message is displayed and the command is cancelled. If it does exist, CL program ARCSRCM2 is called to complete the process.

CL program ARCSRCM2 verifies that a source file exists in the archive library having the same name as the source member. (In our case, we have created the library SRCARCHIVE to hold all archived source files.) If the source file does not exist, one is created, its file text being the same as the member text. The program then assigns a member name based on the next available version number. (VER0000001, VER0000002, etc.) The text of the new member contains the date and time the archive process was completed, the library and source file of the original member, and the user ID of individual who performed the archive.

We have also added the user-defined option 'AR' allowing the process to be executed from within PDM.

CALL PGM(ARCSRCM1) PARM(&L &F &N)


    ARCSRCM  

/*  ARCSRCM - Archive a source member                               */  
/*  PARMS   - FILE(XXXXXXXXXX/XXXXXXXXXX) SRCMBR(XXXXXXXXXX)        */ 
/*                                                                  */ 
/*  ARCSRCM command copies a source file member to the archive      */ 
/*    library.                                                      */ 
/*                                                                  */ 
/*  ARCSRCM runs the CL program ARCSRCM1                            */ 
/*                                                                  */ 
             CMD        PROMPT('Archive a source member')              
                                                                       
             PARM       KWD(FILE) TYPE(QUAL1) MIN(1) PROMPT('File +    
                          name')                                       
                                                                       
             PARM       KWD(SRCMBR) TYPE(*CHAR) LEN(10) MIN(1) +       
                          PROMPT('Member name')                        
 QUAL1:      QUAL       TYPE(*NAME) LEN(10) EXPR(*YES)                 
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +               
                          SPCVAL((*LIBL)) EXPR(*YES) +                 
                          PROMPT('Library name')                       

Source code:  ARCSRCM1

/*  ARCSRCN1 - Archive a source member                              */ 
/*  PARMS   - FILE(XXXXXXXXXX/XXXXXXXXXX) SRCMBR(XXXXXXXXXX)        */ 
/*                                                                  */ 
/*  ARCSRCM  command archives a source member to a source file      */ 
/*             within the archive library                           */ 
/*  ARCSRCM1 program runs behind the command ARCSRCM                */ 
/*  ARCSRCM1 program calls program ARCSRCM2                         */ 
/*                                                                  */ 
             PGM        PARM(&FILE &SRCMBR)                            
                                                                       
             DCL        VAR(&FILE)   TYPE(*CHAR) LEN(20)               
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)               
                                                                       
             DCL        VAR(&SRCFIL) TYPE(*CHAR) LEN(10)               
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)               
             DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)               
             DCL        VAR(&MSG)    TYPE(*CHAR) LEN(512)              
                                                                       
             CHGVAR     VAR(&SRCFIL) VALUE(%SST(&FILE 1 10))           
             CHGVAR     VAR(&SRCLIB) VALUE(%SST(&FILE 11 10))          
                                                                       
             CHKOBJ     OBJ(&SRCLIB/&SRCFIL) OBJTYPE(*FILE) +          
                          MBR(&SRCMBR)                                 
             MONMSG     MSGID(CPF9801 CPF9815) EXEC(DO)                
             GOTO       CMDLBL(DONE)                                   
             ENDDO                                                     
                                                                       
             IF         COND(&SRCLIB *EQ '*LIBL') THEN(DO)             
             RTVMBRD    FILE(&SRCLIB/&SRCFIL) MBR(&SRCMBR) +           
                          RTNLIB(&RTNLIB)                              
             MONMSG     MSGID(CPF9812 CPF9815) EXEC(DO)                
             GOTO       CMDLBL(DONE)                                   
             ENDDO                                                     
             CHGVAR     VAR(&SRCLIB) VALUE(&RTNLIB)                    
             ENDDO                                                     
                                                                       
             CALL       PGM(ARCSRCM2) PARM(&SRCLIB &SRCFIL &SRCMBR)    
                                                                       
             GOTO       CMDLBL(ENDPGM)                                 
                                                                       
 DONE:       CHGVAR     VAR(&MSG) VALUE(&SRCLIB *TCAT '/' *TCAT +      
                          &SRCFIL *TCAT '/' *TCAT &SRCMBR *BCAT +      
                          'does not exist.  Command cancelled.')       
             SNDUSRMSG  MSG(&MSG) MSGTYPE(*INFO)                       
                                                                       
 ENDPGM:     ENDPGM                                                    
Source code:  ARCSRCM2

/*   ARCSRCM2 - Back up source member to ARCHIVE library            */
/*      PARMS - &SRCLIB - Library where the source file exists      */
/*            - &SRCFIL - Source file where the source member exists*/
/*            - &SRCMBR - Source member                             */
/*                                                                  */
/*  ARCSRCM  command archives a source member to a source file      */
/*             within the archive library                           */
/*  ARCSRCM1 program runs behind the command ARCSRCM                */
/*  ARCSRCM1 program calls program ARCSRCM2                         */
/*                                                                  */
             PGM        PARM(&SRCLIB &SRCFIL &SRCMBR)                 
                                                                      
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&SRCFIL) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)              
                                                                      
             DCL        VAR(&ARCLIB) TYPE(*CHAR) LEN(10) +            
                          VALUE('SRCARCHIVE')                         
             DCL        VAR(&ARCFIL) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&ARCMBR) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&ARCNAM) TYPE(*CHAR) LEN(03) VALUE('VER') 
             DCL        VAR(&ARCNUM) TYPE(*CHAR) LEN(07)              
             DCL        VAR(&WRKDEC) TYPE(*DEC)  LEN(07 0) VALUE(0)   
                                                                      
             DCL        VAR(&DATE)   TYPE(*CHAR) LEN(06)              
             DCL        VAR(&TIME)   TYPE(*CHAR) LEN(06)              
             DCL        VAR(&USER)   TYPE(*CHAR) LEN(10)              
             DCL        VAR(&MSG)    TYPE(*CHAR) LEN(512)             
             DCL        VAR(&SRCTXT) TYPE(*CHAR) LEN(50)              
             DCL        VAR(&ARCTXT) TYPE(*CHAR) LEN(50)              
                                                                      
             CHKOBJ     OBJ(&ARCLIB/&SRCMBR) OBJTYPE(*FILE)           
             MONMSG     MSGID(CPF9801) EXEC(DO)                       
             RTVMBRD    FILE(&SRCLIB/&SRCFIL) MBR(&SRCMBR) +          
                          TEXT(&SRCTXT)                               
             CRTSRCPF   FILE(&ARCLIB/&SRCMBR) TEXT(&SRCTXT) AUT(*ALL) 
             ENDDO                                                    
                                                                      
             CHGVAR     VAR(&ARCFIL) VALUE(&SRCMBR)                   
 INCREMENT:  CHGVAR     VAR(&WRKDEC) VALUE(&WRKDEC + 1)               
             CHGVAR     VAR(&ARCNUM) VALUE(&WRKDEC)                   
             CHGVAR     VAR(&ARCMBR) VALUE(&ARCNAM *CAT &ARCNUM)      
                                                                      
             CHKOBJ     OBJ(&ARCLIB/&SRCMBR) OBJTYPE(*FILE) +         
                          MBR(&ARCMBR)                                
             MONMSG     MSGID(CPF9801 CPF9815) EXEC(DO)               
             CPYF       FROMFILE(&SRCLIB/&SRCFIL) +                   
                          TOFILE(&ARCLIB/&ARCFIL) FROMMBR(&SRCMBR) +  
                          TOMBR(&ARCMBR) MBROPT(*REPLACE)             
             GOTO       CMDLBL(RTVSYSVAL)                             
             ENDDO                                                    
             GOTO       CMDLBL(INCREMENT)                             
 
 RTVSYSVAL:  RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&DATE)                   
             RTVSYSVAL  SYSVAL(QTIME) RTNVAR(&TIME)                   
             RTVJOBA    USER(&USER)                                   
                                                                      
             CHGVAR     VAR(&ARCTXT) VALUE(&DATE *BCAT &TIME *BCAT +  
                          &SRCLIB *TCAT '/' *CAT &SRCFIL *BCAT &USER) 
             CHGPFM     FILE(&ARCLIB/&ARCFIL) MBR(&ARCMBR) +          
                          TEXT(&ARCTXT)                               
                                                                      
             CHGVAR     VAR(&MSG) VALUE('Archive' *BCAT &SRCLIB +     
                          *TCAT '/' *CAT &SRCFIL *TCAT '/' *CAT +     
                          &SRCMBR *TCAT ' to' *BCAT &ARCLIB *TCAT +   
                          '/' *CAT &ARCFIL *TCAT '/' *CAT &ARCMBR +   
                          *TCAT ' complete')                          
             SNDUSRMSG  MSG(&MSG) MSGTYPE(*INFO)                      
                                                                      
 ENDPGM:     ENDPGM               

==================================
MORE INFORMATION ON THIS TOPIC
==================================

The Best Web Links: tips, tutorials and more.

Ask your programming questions--or help out your peers by answering them--in our live discussion forums.

Ask the Experts yourself: Our application development gurus are waiting to answer your programming questions.

Dig Deeper on iSeries CL programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close