/* $VER: MM_ShoveMsgs 0.6 (28-7-97) ©1997 Neil Williams */ parse arg args options cache options failat 99 options results signal on break_c signal on break_d signal on break_e signal on break_f signal on halt signal on ioerr signal on syntax address 'MAILMANAGER' Main: call Init call Header call Read_Cfg do i = 1 to config.count call ShoveMsgs(i) end call Quit(0, 'All done.') exit break_c:; break_d:; break_e:; break_f:; halt: signal off break_c signal off break_d signal off break_e signal off break_f signal off halt return_code = 5 error_line = 0 error_msg = 'Execution halted!!!' rc = 0 signal Exit Exit: select when return_code>=40 then error = 'INTERNAL-ERROR:' when return_code>=30 then error = 'IO-ERROR:' when return_code>=20 then error = 'ERROR:' when return_code>=10 then error = 'WARNING:' when return_code>=5 then error = 'INFO:' otherwise error = '' end call Log() call Log('***' strip(error error_msg) '***', '+') call Log(,'\') call setclip('MM_LogPre', system.mm.logpre) exit return_code Get_Arg: procedure Expose args system. arg keyword, mode, old uargs = upper(args) p = find(uargs, keyword) if p=0 then do p = pos(' 'keyword'=', ' 'uargs) if p>0 then args = overlay(' ', args, p+length(keyword)) p = find(upper(args), keyword) end system.cmdopt.keyword = p>0 select when mode=0 then if p>0 then do ret = 1 args = delword(args, p, 1) end else ret = old when mode=1 then if p>0 then do left = subword(args, 1, p-1) rest = subword(args, p+1) if left(rest, 1)='"' then parse var rest . '"' ret '"' rest else parse var rest ret rest args = strip(left strip(rest)) end else ret = old when mode=2 then do if left(args, 1)='"' then parse var args . '"' ret '"' args else parse var args ret args if strip(ret)='' then ret = old end otherwise exit 99 end args = strip(args) ret = strip(ret, 'b', '" ') return ret Get_Version: procedure parse arg mode parse value sourceline(3-mode) with . . ver . parse var ver tst 'ß' . if ~datatype(strip(tst, 'b', '/c '), 'N') then if ~mode then ver = Get_Version(1) else exit 99 return ver Header: call Log(,'/') call Log('***' system.prg.id '***', '+') call Log(' 'system.prg.cr) call Log() return Init: system. = 0 system.prg.ver = Get_Version(0) system.prg.name = 'MM_ShoveMsgs' system.prg.id = system.prg.name 'v'system.prg.ver system.prg.cfg = 'MM:Config/'system.prg.name'.cfg' system.prg.cr = '(C)1997 Neil Williams' system.tmpfile = 'T:'system.prg.name'.tmp' system.mm.logpre = getclip('MM_LogPre') system.prg.logpre = system.mm.logpre'|' call setclip('MM_LogPre', system.prg.logpre) system.prg.loglevel = 3 call Include_Lib('rexxsupport') return Include_Lib: procedure Expose system. parse arg lib, prio if right(upper(lib), 8)~='.LIBRARY' then lib = lib'.library' if prio='' then prio = 0 if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!') return IOerr: signal off ioerr return_code = 20 error_line = sigl error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']') rc = 0 signal Exit Log: procedure Expose system. parse arg text, pre, level if ~datatype(level, 'N') then level = system.prg.loglevel tmp = word('PRG MM', (pre~='')+1) text = system.tmp.logpre || pre' 'text MM_WriteLog 'text' level return Quit: parse arg return_code, error_msg error_line = 0 rc = 0 signal Exit Read_Cfg: procedure Expose config. system. MM_ReadStem system.prg.cfg 'cfg' if RC~=0 then call Quit(31, 'Unable to read' system.prg.cfg'!!!') call Log('Reading config...') cnt = 0 entry = 0 do l=0 to cfg.count-1 parse value strip(translate(cfg.l, ' ', '9'x)) with key args ';' . key = upper(strip(key)) args = strip(args) select when key='' then iterate when key='#GATEENTRY' then do entry = entry+1 config.entry.label = args end when key='ONEAREA' then config.entry.onearea = args when key='ONEADDRESS' then config.entry.oneaddress = args when key='ONEFLAGS' then config.entry.oneflags = upper(args) when key='ONETO' then config.entry.oneto = args when key='ONEFROM' then config.entry.onefrom = args when key='ONESUBJECT' then config.entry.onesubject = args when key='TWOAREA' then config.entry.twoarea = args when key='TWOADDRESS' then config.entry.twoaddress = args when key='TWOFLAGS' then config.entry.twoflags = upper(args) when key='TWOTO' then config.entry.twoto = args when key='TWOFROM' then config.entry.twofrom = args when key='TWOSUBJECT' then config.entry.twosubject = args when key='ORIGIN' then config.entry.origin = args otherwise say '*** CFG-ERROR: Unknown keword "'key'" at line' l'!!!' end cnt = cnt+1 end if entry = 0 then Quit(20,'No #GATEENTRY found!! You need at least one!') config.count = entry return Replace: procedure parse arg string, new, old do while index(string, old) ~= 0 interpret "parse var string l '"old"' r" string = l || new || r end return string Syntax: signal off syntax return_code = 40 error_line = sigl error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']' rc = 0 signal Exit Usage: rx. = '' rx.0.0 = '[rx] ' rx.0.1 = '[.rexx]' m = pos('/e', system.prg.ver)>0 say say 'Usage:' rx.m.0 || system.prg.name || rx.m.1 system.cmdopts say call Quit(0, 'Usage requested.') ShoveMsgs: procedure Expose config. system. parse arg entry call Log() call Log('Currently Gating Nº 'right(entry,2)': 'config.entry.label) call Log() drop MSGS. drop RMSG. drop WMSG. if ((config.entry.oneflags = 'READONLY') & (config.entry.twoflags = 'WRITEONLY')) | ((config.entry.oneflags = 'TWOWAY') & ((config.entry.twoflags = 'TWOWAY') | (config.entry.twoflags = 'WRITEONLY')) ) then do call Log('Searching for messages to gate in 'config.entry.onearea) MM_SearchMsgs config.entry.onearea MSGS '"'config.entry.onefrom'"' '"'config.entry.oneto'"' '"'config.entry.onesubject'"' !SENT IMP if RC = 4 then Quit(20, 'Configured area one doesn''t exist!') if MSGS.COUNT > 0 then do call Log('... 'MSGS.COUNT' messages to gate') do i = 0 to MSGS.COUNT-1 MM_ReadMsg config.entry.onearea MSGS.i RMSG call open(fh,system.tmpfile,'W') writeln(fh,'1'x'DATED: 'RMSG.DATE) do j = 0 to RMSG.TEXT.COUNT-1 writeln(fh,RMSG.TEXT.j) end writeln(fh,(Replace(RMSG.FOOT.0, '-+- ', '--- '))) writeln(fh,(Replace(RMSG.FOOT.1, ' # Origin: ', ' * Origin: '))) call close(fh) WMSG.FROM = RMSG.FROM WMSG.FROMADDR = config.entry.twoaddress WMSG.TO = RMSG.TO WMSG.TOADDR = '' WMSG.SUBJ = RMSG.SUBJ WMSG.TEAR = system.prg.id WMSG.ORIGIN = config.entry.origin WMSG.FLAGS = RMSG.FLAGS WMSG.FILE = system.tmpfile MM_WriteMsg config.entry.twoarea WMSG end /* do loop */ end /* for loop */ else call log('No messages to gate') end if ((config.entry.twoflags = 'READONLY') & (config.entry.oneflags = 'WRITEONLY')) | ((config.entry.twoflags = 'TWOWAY') & ((config.entry.oneflags = 'TWOWAY') | (config.entry.oneflags = 'WRITEONLY')) ) then do call Log('Searching for messages to gate in 'config.entry.twoarea ) MM_SearchMsgs config.entry.twoarea MSGS '"'config.entry.twofrom'"' '"'config.entry.twoto'"' '"'config.entry.twosubject'"' !SENT IMP if RC = 4 then Quit(20, 'Configured area two doesn''t exist!') if MSGS.COUNT > 0 then do call Log('... 'MSGS.COUNT' messages to gate') do i = 0 to MSGS.COUNT-1 MM_ReadMsg config.entry.twoarea MSGS.i RMSG call open(fh,system.tmpfile,'W') writeln(fh,'1'x'DATED: 'RMSG.DATE) do j = 0 to RMSG.TEXT.COUNT-1 writeln(fh,RMSG.TEXT.j) end writeln(fh,(Replace(RMSG.FOOT.0, '-+- ', '--- '))) writeln(fh,(Replace(RMSG.FOOT.1, ' # Origin: ', ' * Origin: '))) call close(fh) WMSG.FROM = RMSG.FROM WMSG.FROMADDR = config.entry.onearea WMSG.TO = RMSG.TO WMSG.TOADDR = '' WMSG.SUBJ = RMSG.SUBJ WMSG.TEAR = system.prg.id WMSG.ORIGIN = config.entry.origin WMSG.FLAGS = '' WMSG.FILE = system.tmpfile MM_WriteMsg config.entry.onearea WMSG end /* do loop */ end /* for loop */ else call log('No messages to gate') end address command 'delete >NIL: 'system.tmpfile return