File Edit Edit_Settings Menu Utilities Compilers Test Help ------------------------------------------------------------------------------- VIEW TSOUSER.ISPF.EXEC(MG) - 01.08 MG active Command ===> Scroll ===> CSR ****** ***************************** Top of Data ****************************** 000100 /* REXX ***************************************************************/ 000200 /* */ 000300 /* MG Member Generations */ 000400 /* */ 000500 /* Purpose: automatic backup for every version of a member */ 000600 /* (without z/OS PDS Member Generation Feature, since */ 000700 /* MAXGENS_LIMIT=0) */ 000800 /* */ 000900 /* This feature can be switch on/off like an initial macro for an */ 001000 /* entire PDS while editing. But it takes effect in the following */ 001100 /* edit session. */ 001200 /* */ 001300 /* Switch on: IMACRO MG */ 001400 /* Switch off: IMACRO NONE */ 001500 /* */ 001600 /* All backups will be stored in the same PDS under Z9* descending. */ 001700 /* */ 001800 /* Date Change Name */ 001900 /* 20160601 implementation UWi */ 002000 /* 20160613 only for ISPF standard EDIT sessions UWi */ 002100 /* 20160614 avoid duplicates via ISRSUPC checksums UWi */ 002200 /* 20161208 use VIO datasets UWi */ 002300 /* 20161212 switch from keylist to initial macro UWi */ 002400 /* 20170209 ignore empty members UWi */ 002500 /* 20170216 save the old version instead of the current one UWi */ 002600 /* */ 002700 /**********************************************************************/ 002800 address isredit 002900 "MACRO" ; if RC>0 then exit 0 003000 address ispexec "VGET (ZEDTMCMD)"; ZEDTMCMD=translate(ZEDTMCMD) 003100 "(DSN,V2,V3) = DATASET"; "(MBR) = MEMBER"; DSN="'"!!DSN!!"'" 003200 "(TYP,SCLM)=SESSION"; "(CHANGED)=DATA_CHANGED" 003300 "(LASTLINE)=LINENUM .ZLAST" 003400 if wordpos(ZEDTMCMD,"MG SAVE END")>0 then do 003500 if CHANGED="YES" & ZEDSAVE="SAVE" & LASTLINE>0 then , 003600 TMP=MBR_ARCHIVE(DSN,MBR) 003700 if ZEDTMCMD<>"MG" then "BUILTIN "!!ZEDTMCMD 003800 else if TYP="EDIT" & length(MBR)>0 then do 003900 "DEFINE SAVE ALIAS MG" 004000 "DEFINE END ALIAS MG" 004100 ZERRSM="MG active" 004200 ZERRLM="Member Generations has been activated." 004300 ZERRALRM='YES'; ZERRHM='*' 004400 address ispexec "SETMSG MSG(ISRZ002)" 004500 end /*<IF TYP="EDIT" & length(MBR)>0 >*/ 004600 end /*<IF wordpos(ZEDTMCMD,"MG SAVE END")>0 >*/ 004700 exit 0 004800 004900 MBR_ARCHIVE: procedure 005000 DSN=arg(1); MBR=arg(2); DS=SETDSNMBR(DSN,MBR) 005100 if sysdsn(DS)<>'OK' then return 0 005200 MGHEAD="~@"!!MBR!!"@"!!MBR_HASH(DSN,MBR) 005300 SYSIN.0=1; SYSIN.1="SRCHFOR '"!!MGHEAD!!"'" 005400 address tso 005500 "ALLOC F(SYSIN) NEW CATALOG DSO(PS) UNIT(VIO)", 005600 "SP(15,5) TRACK RECFM(F B) LRECL(80) REUSE" 005700 "EXECIO * DISKW SYSIN (STEM SYSIN. FINIS)" 005800 "ALLOC F(NEWDD) DA("!!DSN!!") SHR REUSE" 005900 "ALLOC F(OUTDD) DUMMY" 006000 address ispexec "SELECT PGM(ISRSUPC) PARM(SRCHCMP,ANYC)" 006100 EXISTS=RC; "FREE F(NEWDD OUTDD SYSIN)" 006200 if EXISTS<>1 then do /* 0=does not exist, EXISTS>1 is a failure */ 006300 address ispexec 006400 MGMBRSTART="Z9000000"; MGMBR=MGMBRSTART 006500 "LMINIT DATAID(DID1) DATASET("!!DSN!!") ENQ(SHR)" 006600 "LMOPEN DATAID("!!DID1!!") OPTION(INPUT)" 006700 "LMMLIST DATAID("!!DID1!!") OPTION(LIST) MEMBER(MGMBR)" 006800 XRC=RC 006900 "LMCLOSE DATAID("DID1")" 007000 if XRC=0 & MGMBR=MGMBRSTART then MSG_EXIT(8,, 007100 "Maximum amount of backups reached.","MG") 007200 if XRC>8 then MSG_EXIT(12,"MG-Member was not generated.","MG") 007300 CNT=IIF((RC=8 ! verify(right(MGMBR,6),'0123456789','N')>0 !, 007400 right(MGMBR,6)=0),999999,right(right(MGMBR,6)-1,6,'0')) 007500 MGMBR="Z9"!!CNT 007600 address tso 007700 "MAKEBUF"; BUFFER=RC 007800 push MGHEAD 007900 "ALLOC F("!!DID1!!") DA("!!DS!!") SHR REUSE" 008000 "EXECIO * DISKR "!!DID1!!" (FIFO FINIS)" 008100 "FREE F("!!DID1!!")" 008200 queue '' /* EOF Marker */ 008300 "ALLOC F("!!DID1!!") DA("!!SETDSNMBR(DSN,MGMBR)!!") OLD" 008400 "EXECIO * DISKW "!!DID1!!" (FINIS)" 008500 "FREE F("!!DID1!!")" 008600 "DROPBUF "!!BUFFER 008700 address ispexec 008800 "LMINIT DATAID(DID1) DATASET("!!DSN!!") ENQ(SHR)" 008900 "LMOPEN DATAID("!!DID1!!") OPTION(INPUT)" 009000 /* save history of MBR */ 009100 "LMMLIST DATAID("DID1") OPTION(LIST) STATS(YES) MEMBER("!!MBR!!")" 009200 STATS="CREATED4("!!ZLC4DATE!!") MODDATE4("!!ZLM4DATE!!")", 009300 "USER("!!ZLUSER!!") VERSION("!!ZLVERS!!") MODLEVEL("!!ZLMOD!!")", 009400 "MODTIME("!!ZLMTIME!!":"!!ZLMSEC!!") " 009500 STATS=STATS!!IIF(ZLEXT="YES","EXT(YES) CURSIZE("!!ZLCNORCE!!")", 009600 "INITSIZE("!!ZLINORCE!!") MODRECS("!!ZLMNORCE!!")",, 009700 "CURSIZE("!!ZLCNORC!!") INITSIZE("!!ZLINORC!!")", 009800 "MODRECS("!!ZLMNORC!!")") 009900 "LMMLIST DATAID("!!DID1!!") OPTION(FREE)" 010000 /* restore history to MGMBR */ 010100 "LMMSTATS DATAID("!!DID1!!") MEMBER("!!MGMBR!!") "!!STATS 010200 "LMCLOSE DATAID("!!DID1!!")" 010300 end /*<IF EXISTS<>1 >*/ 010400 address isredit 010500 return 0 010600 010700 SETDSNMBR: 010800 /* combine DS and MBR to a complete DSNAME and keep quotes */ 010900 return IIF(verify(reverse(arg(1)),'"'!!"'",'M')=1,, /* if / then */ 011000 left(arg(1),length(arg(1))-1)!!'('!!arg(2)!!')'!!right(arg(1),1),, 011100 arg(1)!!'('!!arg(2)!!')') /* else */ 011200 011300 IIF: 011400 /* RESULT=IIF(condition,true,false) */ 011500 if arg(1)='1' then return arg(2) 011600 return arg(3) 011700 011800 MBR_HASH: procedure 011900 TRACE_SAVED=trace(); trace N 012000 DSN=arg(1); MBR=arg(2) 012100 DS=SETDSNMBR(DSN,MBR) 012200 address tso 012300 "ALLOC F(SYSUT1) DA("!!DS!!") SHR REUSE" 012400 "ALLOC F(SYSUT2) DUMMY" 012500 "ALLOC F(SYSPRINT) SYSOUT(A) REUSE" 012600 "ALLOC F(SYSIN) UNIT(VIO) NEW DSO(PS) SP(1,1)", 012700 "TRACK RECFM(F B) LRECL(80) REUSE" 012800 SYSIN.0=1; SYSIN.1=" PRINT TYPORG=PS" 012900 "EXECIO * DISKW SYSIN (STEM SYSIN. FINIS)" 013000 address ATTCHMVS "IEBPTPCH" 013100 XRC=RC /* RC=4 means empty member */ 013200 "FREE F(SYSUT1 SYSUT2 SYSIN)" 013300 if XRC>4 then MSG_EXIT(XRC,"Fehler IEBPTPCH","MBR_HASH",, 013400 "SYSUT1 SYSUT2 SYSIN") 013500 if XRC=4 then ISRSUPCHASH="00000000" /* bypass RC=28 ISRSUPC */ 013600 else do 013700 "ALLOC F(NEWDD) DA("!!DS!!") SHR REUSE" 013800 "ALLOC F(OLDDD) DA("!!DS!!") SHR REUSE" 013900 "ALLOC F(OUTDD) UNIT(VIO) NEW DSO(PS) SP(15,5)", 014000 "TRACK RECFM(F B A) LRECL(133) REUSE" 014100 "ALLOC F(SYSIN) DUMMY REUSE" 014200 PARM="OVSUML,FILECMP" 014300 address ATTCHMVS "ISRSUPC" "PARM" 014400 if RC>0 then MSG_EXIT(RC,"Error while calculating hash value.",, 014500 "MBR_HASH","NEWDD OLDDD OUTDD") 014600 "FREE F(NEWDD OLDDD)" ; REPORT.0=0; ISRSUPCHASH="" 014700 "EXECIO * DISKR OUTDD (STEM REPORT. FINIS)" 014800 do I=1 to REPORT.0 while length(ISRSUPCHASH)=0 014900 if word(REPORT.I,1)="**" then , 015000 ISRSUPCHASH=word(REPORT.I,words(REPORT.I)) 015100 end /*<DO I=1 to REPORT.0 while length(ISRSUPCHASH)=0 >*/ 015200 "FREE F(OUTDD)" 015300 end /*<ELSE >*/ 015400 trace value TRACE_SAVED 015500 return ISRSUPCHASH 015600 015700 MSG_EXIT: procedure 015800 TRACE_SAVED=trace(); trace N 015900 /* MSG_EXIT(RC,ERROR,MODUL,ddnames_to_free) */ 016000 if listdsi("ISPMLIB FILE")=0 then do /* ISPF-Environment ? */ 016100 ZERRSM='RC='!!abs(arg(1)) 016200 ZERRLM=IIF(length(arg(3))>0,arg(3)!!": "!!arg(2),arg(2)) 016300 ZERRALRM = 'YES'; ZERRHM = '*' 016400 address ispexec "SETMSG MSG(ISRZ002)" 016500 end /*<IF listdsi("ISPMLIB FILE")=0 >*/ 016600 else do 016700 if length(arg(3))=0 then say "RC="!!abs(arg(1))!!" - "!!arg(2) 016800 else say arg(3)!!": RC="!!abs(arg(1))!!" "!!arg(2) 016900 end /*<ELSE >*/ 017000 trace value TRACE_SAVED 017100 if abs(arg(1))<>arg(1) then return 0 /* back to caller */ 017200 address tso "ALTLIB RESET" 017300 if arg()>3 then address tso "FREE F("!!arg(4)!!")" 017400 TMP=isfcalls('OFF') /* switch off the SDSF-interface, if active */ 017500 exit arg(1) ****** **************************** Bottom of Data **************************** |