/* RxSh400 ... a command shell for the IBM AS/400 */ /* Copyright *C* 2000, 2001 by Jack J. Woehr */ /* PO Box 51, Golden, Colorado 80402-0051 USA */ /* jax@well.com jwoehr@ibm.net */ /* All Rights Reserved */ /* STRREXPRC SRCFILE(QREXSRC) SRCMBR(RXSH) */ PARSE SOURCE src PARSE ARG argstring CALL ON ERROR RxShRc = 0 /* All is well unless otherwise noted. */ CALL Init /* Init this program */ SAY "RxSh - Copyright *C* 2000, 2001 by Jack J. Woehr" SAY "http://www.softwoehr.com mailto:jwoehr@softwoehr.com" SAY "Source is" src CALL RunLoop /* Main body of program */ RETURN 0 /* All is always well */ RunLoop: /* Loop accepting input and executing */ DO WHILE \RxSh.exitFlag PULL CMDLINE IF Words(CMDLINE) \= 0 THEN DO PARSE VAR CMDLINE cmd cmdargs CALL ProcessCmd cmd cmdArgs SAY '('RxSh.runLevel')RC='result'.' END END RETURN Init: PROCEDURE EXPOSE History. Cmds. CMDLINE RxSh. call InitCmds call InitHistory RETURN InitHistory: PROCEDURE EXPOSE History. History.='' History.0=0 RETURN InitCmds: PROCEDURE EXPOSE Cmds. CMDLINE RxSh. RxSh.exitFlag = 0 /* Not ready to leave command loop */ RxSh.runLevel = 1 /* We're at the base level */ CMDLINE = '' /* Empty command line */ Cmds.0 = 0 /* Init all the commands in Cmds. */ CALL AddCmd '.A' , 'DoDotA' , ' ....... Repeat previous good command.' CALL AddCmd '.B' , 'DoDotB' , ' ....... Repeat previous bad command.' CALL AddCmd '.BYE', 'DoBye' , '....... Exit RxSh.' CALL AddCmd '.C' , 'DoQCMD' , ' ....... Run a command line interpreter.' CALL AddCmd '.DIR', 'DoDir' , '....... View Library List.' CALL AddCmd '.H' , 'DoDotH' , ' ....... Help.' CALL AddCmd '.HST', 'DoDotHst', '....... History' CALL AddCmd '.LOG', 'DoSignoff', '....... Signoff' CALL AddCmd '.PDM', 'DoPDM' , '....... Start PDM.' CALL AddCmd '.PS' , 'DoPS' , ' ....... Work with Active Jobs.' CALL AddCmd '.Q' , 'DoBye' , ' ....... Exit RxSh.' CALL AddCmd '.R' , 'DoDotR' , ' ....... Execute a line of Rexx.' CALL AddCmd '.RS' , 'DoDotRs', ' ....... Say result of a line of Rexx.' CALL AddCmd '.S' , 'DoDotS' , ' ....... Source an RXSH script.' CALL AddCmd '.SE' , 'DoDotSe', ' ....... Start SEU.' CALL AddCmd '.SQL', 'DoSQL', '....... Start SQL.' Cmds.LastCmd.Name ='DIR' /* Set default for .A command */ Cmds.LastCmd.Args = '' Cmds.LastBadCmd.Name = 'DIR' Cmds.LastBadCmd.Args = '' RETURN AddCmd: PROCEDURE EXPOSE Cmds. PARSE ARG cmd, funcall, helpstr CurrCmd = (Cmds.0) + 1 Cmds.CurrCmd.CommandName = cmd Cmds.CurrCmd.CommandFunc = funcall Cmds.CurrCmd.CommandHelp = helpstr Cmds.0 = CurrCmd RETURN ProcessCmd: PROCEDURE EXPOSE History. Cmds. RxSh. PARSE ARG cmd cmdargs CALL RecordCmd cmd cmdargs CALL DoCmd cmd cmdargs RETURN RESULT RecordCmd: PROCEDURE EXPOSE History. PARSE ARG cmd cmdargs History.0 = History.0 + 1 i = History.0 History.i.command = cmd History.i.arguments = cmdargs RETURN DoCmd: PROCEDURE EXPOSE History. Cmds. RxSh. PARSE ARG cmd cmdargs CmdDone = 0 CmdResult = 0 DO i = 1 to Cmds.0 IF Cmds.i.CommandName = cmd THEN DO Invocation = 'CALL' Cmds.i.CommandFunc cmdargs INTERPRET Invocation CmdResult = result CmdDone = 1 END IF CmdDone & cmd \= '.A' & cmd \= '.B' THEN DO /* Record last successful command and leave */ Cmds.LastCmd.Name = cmd Cmds.LastCmd.Args = cmdargs LEAVE END END IF \CmdDone THEN DO ADDRESS COMMAND cmd cmdargs CmdResult = RC IF cmd \= '.A' & cmd \= '.B' THEN DO IF CmdResult = 0 /* Command was successful */ THEN DO /* Record last successful command and leave */ Cmds.LastCmd.Name = cmd Cmds.LastCmd.Args = cmdargs END ELSE DO /* Command not successful */ Cmds.LastBadCmd.Name = cmd /* Record failing cmd and leave */ Cmds.LastBadCmd.Args = cmdargs END END END RETURN CmdResult /* * Here are the commands */ DoBye: /* Flag that it's time to leave */ PROCEDURE EXPOSE RxSh. RxSh.exitFlag = 1 RETURN 0 DoQCMD: PROCEDURE 'CALL QSYS/QCMD' RETURN RC DoDir: /* Show the library list */ PROCEDURE 'DSPLIBL' RETURN RC DoPDM: /* Start PDM */ PROCEDURE PARSE ARG cmdArgs 'STRPDM' cmdArgs RETURN RC DoPS: /* Work with Active Jobs*/ PROCEDURE PARSE ARG cmdArgs 'WRKACTJOB' cmdArgs RETURN RC DoSQL: /* Start PDM */ PROCEDURE PARSE ARG cmdArgs 'STRSQL' cmdArgs RETURN RC DoDotA: /* Repeat Previous Command */ PROCEDURE EXPOSE Cmds. CALL DoCmd Cmds.LastCmd.Name Cmds.LastCmd.Args RETURN RESULT DoDotB: /* Repeat Previous Bad Command */ PROCEDURE EXPOSE Cmds. CALL DoCmd Cmds.LastBadCmd.Name Cmds.LastBadCmd.Args RETURN RESULT DoDotH: /* Display Help */ PROCEDURE EXPOSE Cmds. DO i = 1 to Cmds.0 Say Cmds.i.CommandName Cmds.i.CommandHelp END RETURN 0 DoDotHst: /* Display History */ PROCEDURE EXPOSE History. Cmds. RxSh. PARSE ARG cmdArgs myRC = 0 IF Datatype(cmdArgs) = 'NUM' THEN DO IF cmdArgs > 0 & cmdArgs <= History.0 THEN DO cmdString = History.cmdArgs.command History.i.arguments myRC = ProcessCmd(cmdString) END END ELSE DO i = 1 to History.0 Say i || "." History.i.command History.i.arguments END RETURN myRC DoDotR: /* Execute a line of Rexx */ PROCEDURE PARSE ARG cmdArgs INTERPRET cmdArgs RETURN 0 DoDotRS: /* Say a line of Rexx */ PROCEDURE PARSE ARG cmdArgs INTERPRET 'Say' cmdArgs RETURN 0 DoDotS: /* Source a script */ PROCEDURE EXPOSE RxSh. Cmds. PARSE ARG filename member IF member = '' /* Bad filename and/or member name */ THEN DO RC="Syntax: .S filename member" END ELSE DO /* We got a good filename and member name */ 'CPYFTOREXQ FROMFILE('filename') NMBRCDS(*ALL) MBR('member')' IF RC = 0 /* We opened the file okay */ THEN DO WHILE Queued() > 0 PULL aLine aLine = Substr(aLine, length(000100980212) + 1) /* Peel record date */ PARSE VAR aLine cmd cmdargs RxSh.runLevel = RxSh.runLevel + 1 CALL DoCmd cmd cmdArgs SAY '('RxSh.runLevel')RC='result'.' RxSh.runLevel = RxSh.runLevel - 1 END ELSE DO /* Couldn't open file and queue its records */ RC = "Error opening" filename member END END RETURN RC DoDotSe: /* Start SEU */ PROCEDURE PARSE ARG cmdArgs 'STRSEU' cmdArgs RETURN RC DoSignoff: /* Really go away */ PROCEDURE 'SIGNOFF' RETURN RC /* Error Handling */ ERROR: condition.name = CONDITION('C') condition.description = CONDITION('D') condition.instruction = CONDITION('I') condition.state = CONDITION('S') Say "Error on last command." Say "Condition name :" condition.name Say "Condition description:" condition.description Say "Condition instruction:" condition.instruction Say "Condition state :" condition.state RETURN /* End of RxSh */