Difference between revisions of "User:MrDolomite/SAVEANDIPL"
From MidrangeWiki
MrDolomite (talk | contribs) (creating page; posting XML source for SAVEANDIPL) |
MrDolomite (talk | contribs) m (added XMLPREVIEW link) |
||
Line 1: | Line 1: | ||
+ | *Created with Craig Rutledge's XMLPREVIEW family of utilities available [http://home.alltel.net/craigru/jcrdown2.html#XMLPREVIEW_tag here] | ||
+ | *No warranty, no deposit, no return, your mileage may vary. | ||
+ | *Watchout for hardcode, kludges | ||
+ | *Currently runs fine on V5R3 | ||
+ | |||
<pre> | <pre> | ||
<?xml version="1.0" encoding="UTF-8"?> | <?xml version="1.0" encoding="UTF-8"?> |
Latest revision as of 18:51, 30 August 2006
- Created with Craig Rutledge's XMLPREVIEW family of utilities available here
- No warranty, no deposit, no return, your mileage may vary.
- Watchout for hardcode, kludges
- Currently runs fine on V5R3
<?xml version="1.0" encoding="UTF-8"?> <upload appname="" appauthor="Craig Rutledge" appblddate=" 8/30/2006"> <install_instructions><![CDATA[ //--------------------------------------------------------------------------- * 1. Upload entire XML to your AS/400 to a source file 112 long, into any mbr * name not in this XML (suggest member name like ABCX or XYZX). The source * file must be in the library where source and objects are to be installed. * * 2. If you have XMLPREVIEW installed, skip to step 3. * Copy the text between the start tag <install_program> and the end * tag </install_program> into any member name (your choice) * in file QRPGLESRC member type RPGLE. CRTBNDRPG to compile. * NOTE: You need extract the install program only once, this same program * will install any upload on this page. * * 3. Call the install program (or execute XmlPrevew) passing these 3 parms. * 'your-member-name you uploaded this text into' * 'your-source-file-name the member is in' * 'your-library-name the source file is in' * * The various source members will be extracted and the objects required * for the application will be created in your-library-name. * * Members in this install: (to view or manually extract members, scan <mbr ) * README TXT * RESTRICTEC CLP * RESTRICTED CMD * SAVEANDIPC CLP * SAVEANDIPL CMD * SAVENOIPL CMD * SAVENOIPLC CLP * SAVE21 CMD * SAVE21C CLP *WARNING* Hardcoded Tape Drive Device Name * //--------------------------------------------------------------------------- ]]> </install_instructions> <install_program><![CDATA[ * /// START OF INSTALL PGM HERE ************************** /// //------------------------------------------------------------- // Parse / Install from xml text into source members and objects. v5r1 // Use xml tags in text to trigger: // 1. Parse text into source members (create srcfile & member if required). // 2. Compile source into objects. // 3. Send installation progress user messages. // 4. Execute qcmdexc as required. //------------------------------------------------------------- Fxmlinput if f 112 disk extfile(extIfile) extmbr(ParseSrcMbr) uploaded text F usropn Fqxxxsrc o f 112 disk extfile(extOfile) extmbr(mbrname) parsed out F usropn //------------------------------------------------------------- D extIfile s 21a D extOfile s 21a D vrcvar s 145a D qm_msgid s 7a D qm_msgtxt s 65a D qm_msgq s 10a D qm_msgtyp s 10a D mbrname s 10a D mbrtype s 10a D mbrtext s 50a D srcfile s 10a D srclen s 5a D srccssid s 5a D bldexc s 500a D IsWrite s n inz(*off) D srcSeqno s 6s 2 inz(0) D aa s 5u 0 inz(0) D ll s 5u 0 inz(0) D qs c '''' // Error return code parm for APIs. D vApiErrDs ds D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided D vbytav 10i 0 inz(0) bytes returned D vmsgid 7a error msgid D vresvd 1a reserved D vrpldta 50a replacement data //------------------------------------------------------------- D qusrmbrd PR ExtPgm('QUSRMBRD') MEMBER DESC Db like(vrcvar) RCVR D 10i 0 const RCVR LEN D 8 const TYPE D 20 const FILE LIB D 10 MBR NAME D 1 const OVERRIDE? Db like(vApiErrDS) D qmhsndpm PR ExtPgm('QMHSNDPM') SEND MESSAGE D 7 ID D 20 const FILE Db like(qm_msgtxt) TEXT D 10i 0 const LENGTH D 10 const TYPE D 10 QUEUE D 10i 0 const STACK ENTRY D 4 const KEY Db like(vApiErrDS) D qcmdexc PR ExtPgm('QCMDEXC') D 500A options(*varsize) D 15P 5 Const //----------------------------------------------- Ixmlinput ns I 13 21 xmltag1 I 18 27 xmltag2 I 13 112 xmlcode //----------------------------------------------- C *entry plist C parm ParseSrcMbr 10 source member C parm ParseSrcFile 10 source file C parm ParseSrcLib 10 source lib // xmlpreview uses this parm to redirect to user selected source file. optional C parm OvrSrcFile 10 override to source /free exsr srValidate; //make sure exists // Set user selected library *first for remainder of program bldexc = 'RMVLIBLE LIB('+%trimr(ParseSrcLib) + ')'; callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))); bldexc = 'ADDLIBLE LIB('+ %trimr(ParseSrcLib) + ') POSITION(*FIRST)'; callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))); // Override Input file to uploaded text file extIfile = %trimr(ParseSrcLib)+'/'+ParseSrcFile; open xmlinput; read xmlinput; 1b dow not %eof; // write records to outfile if flag is on 2b if IsWrite; 3b if xmltag2<>'</copysrc>'; srcSeqno=srcSeqno+1; except write_one; 3x else; IsWrite=*off; close qxxxsrc; 3e endif; // Extract values based on xml tags. 2x elseif xmltag1 = 'mbrname ='; mbrname = %subst(xmlcode:13:10); 2x elseif xmltag1 = 'mbrtype ='; mbrtype =%subst(xmlcode:13:10); 2x elseif xmltag1 = 'mbrtext ='; mbrtext =%subst(xmlcode:13:50); 2x elseif xmltag1 = 'srcfile ='; 3b if %parms=4; //xmlpreview override srcfile=OvrSrcFile; 3x else; srcfile =%subst(xmlcode:13:10); 3e endif; 2x elseif xmltag1 = 'srclen ='; 3b if %parms=4; //xmlpreview override srclen='00112'; 3x else; srclen =%subst(xmlcode:13:5); 3e endif; 2x elseif xmltag1 = 'srccssid='; srccssid=%subst(xmlcode:13:5); // Start of data to copy. Create source files/mbrs as required. 2x elseif xmltag1='<copysrc>'; // crtsrcpf bldexc = 'CRTSRCPF FILE(' + %trimr(ParseSrcLib)+'/'+ %trimr(srcfile) + ') RCDLEN(' + srclen + ') CCSID(' + srccssid + ')'; callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))); // addpfm bldexc = 'ADDPFM FILE(' + %trimr(ParseSrcLib)+'/'+ %trimr(srcfile) + ') MBR(' + %trimr(mbrname) + ') SRCTYPE(' + %trimr(mbrtype) + ') TEXT(' + qs+%trimr(mbrtext)+qs + ')'; callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))); 3b if %error; // chgpfm bldexc = 'CHGPFM FILE(' + %trimr(ParseSrcLib)+'/'+ %trimr(srcfile) + ') MBR(' + %trimr(mbrname) + ') TEXT(' + qs+%trimr(mbrtext)+qs + ')'; callp qcmdexc(bldexc:%len(%trimr(bldexc))); // clr mbr bldexc = 'CLRPFM FILE(' + %trimr(ParseSrcLib)+'/'+ %trimr(srcfile) + ') MBR(' + %trimr(mbrname) + ')'; callp qcmdexc(bldexc:%len(%trimr(bldexc))); 3e endif; // ovr to outfile mbr extOfile=%trimr(ParseSrcLib) +'/'+srcfile; clear srcSeqno; open qxxxsrc; IsWrite = *on; // ------------------------------------------------------ // Compile statement. Read next record and execute it. // The subroutine srTolibToken will replace &tolib with the // library the user has selected at run time. // ------------------------------------------------------ 2x elseif xmltag1 = '<compile>'; read xmlinput; bldexc = %trimr(xmlcode); exsr srTolibToken; callp qcmdexc(bldexc:%len(%trimr(bldexc))); // ------------------------------------------------------ // qcmdexc statement. Build statement from each record between start // and stop tags. When stop tag is found, execute statement. // if dltxxx command, allow errors to be ignored. // ------------------------------------------------------ 2x elseif xmltag1 = '<qcmdexc>'; clear bldexc; aa=1; read xmlinput; 3b dow xmltag2<>'</qcmdexc>'; %subst(bldexc:aa:100)=xmlcode; aa=aa+100; read xmlinput; 3e enddo; exsr srTolibToken; 3b if %subst(bldexc:1:3)='DLT'; callp(e) qcmdexc(bldexc:%len(%trimr(bldexc))); 3x else; callp qcmdexc(bldexc:%len(%trimr(bldexc))); 3e endif; // ------------------------------------------------------ // Send messages to user as program executes // Extract message ID, Message Type, from <sendmsg> // read a record and get the single line of message text. // ------------------------------------------------------ 2x elseif xmltag1 = '<sendmsg '; qm_msgid = %subst(xmlcode:22:7); qm_msgtyp = %subst(xmlcode:46:10); read xmlinput; qm_msgq = '*EXT '; 3b if qm_msgtyp='*COMP '; qm_msgq = '*PGMBDY'; 3e endif; qm_msgtxt = xmlcode; exsr srSndMessage; 2e endif; read xmlinput; 1e enddo; *inlr=*on; return; // ------------------------------------------------------ // Replace &tolib (no matter how many times it is in string) // with whatever library the user has selected at run time. // ------------------------------------------------------ begsr srTolibToken; aa=%scan('&tolib':bldexc); 1b dow aa>0; bldexc=%replace(%trimr(ParseSrcLib):bldexc:aa:6); aa=%scan('&tolib':bldexc); 1e enddo; // user has selected to override source, reset SRCFILE parm in bldexcs. 1b if %parms=4; //xmlpreview override aa=%scan('SRCFILE(':bldexc); 2b if aa>0; aa=%scan('/':bldexc:aa); 3b if aa>0; ll=%scan(')':bldexc:aa); bldexc=%replace(%trimr(OvrSrcFile):bldexc:aa+1:ll-(aa+1)); 3e endif; 2e endif; 1e endif; endsr; // ------------------------------------------------------ // Check of file, lib, member exist. begsr srValidate; callp QUSRMBRD(vrcvar:145:'MBRD0100': ParseSrcFile + ParseSrcLib:ParseSrcMbr: '0':vapierrds); // ------------------------------------------------------ // If error occurred on call, send appropriate message back to user. 1b if vBytav>0; //error occurred 2b if vmsgid = 'CPF9810'; // lib not found qm_msgtxt = '0000 Library ' + %trimr(ParseSrcLib) + ' was not found.'; 2x elseif vmsgid = 'CPF9812'; // src file not found qm_msgtxt = '0000 Source file ' + %trimr(ParseSrcFile)+' was not found in ' + %trimr(ParseSrcLib) + '.'; 2x elseif vmsgid = 'CPF9815'; // member not found qm_msgtxt = '0000 Member ' + %trimr(ParseSrcMbr)+' was not found in ' + %trimr(ParseSrcLib)+'/'+ %trimr(ParseSrcFile); 2x else; // unexpected qm_msgtxt = '0000 Unexpected message ' + vmsgid + ' received. '; 2e endif; // send message qm_msgid = 'CPD0006'; qm_msgtyp = '*DIAG'; qm_msgq = '*CTLBDY'; exsr srSndMessage; qm_msgtxt = *blanks; qm_msgid = 'CPF0002'; qm_msgtyp = '*ESCAPE'; exsr srSndMessage; *inlr=*on; return; 1e endif; endsr; // ------------------------------------------------------ begsr srSndMessage; callp QMHSNDPM(qm_msgid:'QCPFMSG *LIBL ': qm_msgtxt:%size(qm_msgtxt):qm_msgtyp:qm_msgq: 1:' ': vApiErrDS); endsr; /end-free Oqxxxsrc e write_one O srcSeqno 6 O 12 '000000' O xmlcode 112 * /// END OF INSTALL PGM HERE /// do not copy past this point ********** /// ]]> </install_program> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing README type TXT - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "README " mbrtype = "TXT " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ 2005/mm/dd - Brian Dolinar (BCD) Objects compiled into QGPL Objects protected by *PUBLIC *EXCLUDE. Operations staff are member of the BSYOPER group, which are *ALL for these objec ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing RESTRICTEC type CLP - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "RESTRICTEC" mbrtype = "CLP " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ /********************************************************************/ /* DATE: 08/24/2001 */ /* USER: BDOLIN */ /* NOTES: CREATED PROGRAM */ /********************************************************************/ PGM /********************************************************************/ /* PRINT DISK USAGE */ /********************************************************************/ DSPSYSSTS OUTPUT(*PRINT) MONMSG MSGID(CPF0000) CHGSPLFA FILE(QPDSPSTS) JOB(*) SPLNBR(*LAST) + SELECT(*CURRENT *ALL *ALL RESTRICTED) MONMSG MSGID(CPF0000) /********************************************************************/ /* END OTHER SUBSYSTEMS */ /********************************************************************/ ENDSBS SBS(*ALL) OPTION(*IMMED) ENDPGM: ENDPGM ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing RESTRICTED type CMD - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "RESTRICTED" mbrtype = "CMD " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ CMD PROMPT('Goto Restricted State') ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVEANDIPC type CLP - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVEANDIPC" mbrtype = "CLP " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ /********************************************************************/ /* DATE: 08/24/2001 */ /* USER: BDOLIN */ /* NOTES: CREATED PROGRAM */ /********************************************************************/ PGM CHGJOB LOG(4 0 *SECLVL) LOGCLPGM(*YES) RESTRICTED SAVE21 PWRDWNSYS OPTION(*IMMED) RESTART(*YES) ENDPGM: ENDPGM ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVEANDIPL type CMD - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVEANDIPL" mbrtype = "CMD " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ CMD PROMPT('Begin Save And IPL') ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVENOIPL type CMD - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVENOIPL " mbrtype = "CMD " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ CMD PROMPT('Begin Save And IPL') ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVENOIPLC type CLP - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVENOIPLC" mbrtype = "CLP " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ /********************************************************************/ /* DATE: 08/24/2001 */ /* USER: BDOLIN */ /* NOTES: CREATED PROGRAM */ /********************************************************************/ PGM CHGJOB LOG(4 0 *SECLVL) LOGCLPGM(*YES) RESTRICTED SAVE21 ENDPGM: ENDPGM ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVE21 type CMD - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVE21 " mbrtype = "CMD " mbrtext = " " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ CMD PROMPT('Start Save21') ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*STATUS "><![CDATA[ Installing SAVE21C type CLP - in progress. ]]> </sendmsg> <!-- START OF MEMBER --> <mbr mbrname = "SAVE21C " mbrtype = "CLP " mbrtext = "*WARNING* Hardcoded Tape Drive Device Name " srcfile = "SAVEANDSRC" srclib = "selected " srclen = "00112" srccssid= "00037"> <copysrc><![CDATA[ /******************************************************************************/ /* PROGRAM: SAVE21C */ /* CALLED BY: */ /* CALLS TO: */ /* CREATED: 2005-08-08 BY BRIAN DOLINAR FOR V5R3 */ /* PURPOSE: TO BE USED INSTEAD OF THE "GO SAVE, OPTION 21" */ /* THAT OPTION STARTS THE CONTROLLING SBS, WHICH IN TURN STARTS */ /* ALL THE SBS, WHICH DEFEATS THE PURPOSE OF IPL'ING AFTER SAVING */ /******************************************************************************/ /* MODIFICATIONS */ /******************************************************************************/ /* BDOLINAR 08/08/2005 CREATED */ /******************************************************************************/ PGM /* CONSTANTS */ DCL VAR(&TAPDEV) TYPE(*CHAR) LEN(10) VALUE('TAP08') DCL VAR(&NOTIFYUSER) TYPE(*CHAR) LEN(10) + VALUE('BDOLINAR') /* USE THE SYSTEM REPLY LIST TO ANSWER TAPE MESSAGES */ /* CHGJOB INQMSGRPY(*SYSRPYL) */ /* WE NEED THE QSYSOPR MESSAGE QUEUE TO OURSELVES TO SEE TAPE MSGS */ CHGMSGQ MSGQ(QSYSOPR) DLVRY(*BREAK) SEV(10) /* FORMAT THE TAPE */ INZTAP DEV(&TAPDEV) NEWVOL(SAVE21) + NEWOWNID(QSECOFR) CHECK(*NO) + DENSITY(*ULTRIUM1) ENDOPT(*REWIND) CLEAR(*NO) /* GET READY */ CHGMSGD MSGID(CPI8009) MSGF(QSYS/QCPFMSG) SEV(0) CHGMSGD MSGID(CPF2753) MSGF(QSYS/QCPFMSG) SEV(0) CHGMSGD MSGID(CPI5906) MSGF(QSYS/QCPFMSG) SEV(0) CHGMSGD MSGID(CPF9E72) MSGF(QSYS/QCPFMSG) SEV(0) /* CHANGE THE MESSAGE SEVERITY TO ZERO SO IT DOESN'T BREAK */ RETRYSAVE: DLYJOB DLY(60) /* WAIT 60 SECS FOR ENDSBS TO + FINISH, THEN TRY SAVE AGAIN */ SAVSYS DEV(&TAPDEV) ENDOPT(*LEAVE) OUTPUT(*PRINT) + CLEAR(*NONE) MONMSG MSGID(CPF3785) EXEC(GOTO CMDLBL(RETRYSAVE)) + /* CPF3785-NOT ALL SUBSYSTEMS ENDED. */ MONMSG MSGID(CPF0000) /* CPF3772-ONE OR MORE OBJ NOT SAVED */ SAVLIB LIB(*NONSYS) DEV(&TAPDEV) ENDOPT(*LEAVE) + CLEAR(*NONE) PRECHK(*NO) SAVACT(*NO) + ACCPTH(*NO) OMITLIB(QMGPDATA BCDLIBASP2) + OUTPUT(*PRINT) SAVDLO DLO(*ALL) FLR(*ANY) DEV(&TAPDEV) + ENDOPT(*LEAVE) OUTPUT(*PRINT) SAVACT(*YES) MONMSG MSGID(CPF0000) EXEC(DO) SNDMSG MSG('SAVE21 - ERROR ON SAV OF DLO.') + TOUSR(&NOTIFYUSER) MONMSG MSGID(CPF0000) ENDDO /* KLUDGE - STILL HAS HARDCODED TAPE DEVICE NAME INSTEAD OF &TAPDEV. SORRY */ SAV DEV('/QSYS.LIB/TAP08.DEVD') OBJ(('/*') + ('/QSYS.LIB' *OMIT) ('/QDLS' *OMIT) + ('/NOBACKUP' *OMIT) ('/OPTVRT' *OMIT)) + SAVACT(*SYNC) OUTPUT(*PRINT) ENDOPT(*UNLOAD) MONMSG MSGID(CPF0000) EXEC(DO) SNDMSG MSG('SAVE21 - ERROR ON SAV OF IFS.') + TOUSR(&NOTIFYUSER) MONMSG MSGID(CPF0000) ENDDO /* PUT THINGS BACK THE WAY THEY BELONG */ CHGMSGD MSGID(CPI8009) MSGF(QSYS/QCPFMSG) SEV(70) CHGMSGD MSGID(CPF2753) MSGF(QSYS/QCPFMSG) SEV(30) CHGMSGD MSGID(CPI5906) MSGF(QSYS/QCPFMSG) SEV(70) CHGMSGD MSGID(CPF9E72) MSGF(QSYS/QCPFMSG) SEV(40) /* CHANGE THE MESSAGE SEVERITY TO BACK TO WHERE IT BELONGS */ /* PRINT A PARANOID JOB LOG */ DSPJOBLOG OUTPUT(*PRINT) CHGSPLFA FILE(QPJOBLOG) JOB(*) SPLNBR(*LAST) + SELECT(*CURRENT *ALL *ALL 'SAVE21') ENDPGM: ENDPGM ]]> </copysrc> </mbr> <sendmsg sendmsgid="CPF9897" sendmsgtype = "*COMP "><![CDATA[ Application successfully installed. ]]> </sendmsg> </upload>