/* ** $VER: statty.rexx 3.0 (3.7.96) Rolf Rotvel ** ** Uses rexxtricks.library, locale.library and rexxlocaldates.library */ area.mmtaglen = 30 /* In MM log tagnames are cut off after x chars */ path.cfg = 'mail:statty.cfg' /* Default path to cfg file */ /* ** Initializing */ signal on syntax signal on error /* Load libraries */ call addlib('rexxsupport.library', 0, -30, 0) call addlib('rexxtricks.library', 0, -30, 0) call addlib('locale.library', 0, -30, 0) call addlib('rexxlocaldates.library', 0, -30, 0) /* Parse argument - if any */ if arg() > 0 then do parse arg path.cfg if path.cfg = '?' then do options prompt 'CONFIGFILE: ' parse pull path.cfg if path.cfg = '' then exit end end /* Get localized error strings */ cat = opencatalog('statty.catalog', 'english',) msg.err_cfg = getcatalogstr(cat, 1, "Couldn't read configfile:") msg.err_tosser = getcatalogstr(cat, 2, "Statty doesn't support:") call closecatalog(cat) /* Read & parse cfg file */ if ~readfile(path.cfg, cfg) then call errorexit(msg.err_cfg||' "'||path.cfg||'"') do c = 1 to cfg.0 interpret cfg.c end drop cfg. /* Check tosser */ uptosser = upper(tosser) select when uptosser = 'FOOZLE' then nop when uptosser = 'SPOT' then nop when uptosser = 'MAILMANAGER' then nop otherwise call errorexit(msg.err_tosser||' "'||tosser||'"') end /* Get rest of error strings */ cat = opencatalog('statty.catalog', 'english',) msg.err_read = getcatalogstr(cat, 3, "Couldn't read") msg.err_find = getcatalogstr(cat, 4, "Couldn't find") msg.err_del = getcatalogstr(cat, 5, "Couldn't delete") msg.err_create = getcatalogstr(cat, 6, "Couldn't create") msg.err_write = getcatalogstr(cat, 7, "Couldn't write") /* Message strings */ if keeplog? then msg.bak_log = getcatalogstr(cat, 20, 'Backing up log to') msg.no_msgs = getcatalogstr(cat, 21, 'No new messages to process') msg.read = getcatalogstr(cat, 22, 'Reading') msg.fin = getcatalogstr(cat, 23, 'Finished') msg.calcdb = getcatalogstr(cat, 26, 'Calculating database') msg.write = getcatalogstr(cat, 27, 'Writing') if tosser = 'MailManager' then msg.dup_area = getcatalogstr(cat, 25, 'added to') else do msg.dup_area = getcatalogstr(cat, 24, 'Found areaname "%s" twice in') if tosser = 'Spot' then do msg.xport_start = getcatalogstr(cat, 28, 'Export started') msg.xport_end = getcatalogstr(cat, 29, 'Export ended') end end /* Strings used in outputfile */ msg.out_1 = getcatalogstr(cat, 100, 'echomail database created by Statty') msg.out_2 = getcatalogstr(cat, 101, 'Database was started:') msg.out_3 = getcatalogstr(cat, 102, 'Messages in database:') msg.out_4 = getcatalogstr(cat, 103, 'to you') msg.out_5 = getcatalogstr(cat, 104, 'from you') msg.out_6 = getcatalogstr(cat, 105, 'This update') msg.out_7 = getcatalogstr(cat, 106, 'Last update') msg.out_8 = getcatalogstr(cat, 107, 'new messages') msg.out_9 = getcatalogstr(cat, 108, 'in %s areas') msg.out_10 = getcatalogstr(cat, 109, 'Areas') msg.out_11 = getcatalogstr(cat, 110, 'Total') msg.out_12 = getcatalogstr(cat, 111, 'New') call closecatalog(cat) /* Check paths */ if ~exists(path.log) then call errorexit(msg.err_find||' '||path.log) if ~exists(path.area) then call errorexit(msg.err_find||' '||path.area) /* ** Main */ /* Datestamp */ start.thisdb = date('i')||'.'||time('s') /* Multitasking... */ call pragma('p', -1) /* Backup logfile */ if keeplog? then do if path.keeplog ~= '' then oldpath = makepath(pathpart(path.log), path.keeplog) else oldpath = path.log||'.statty' say msg.bak_log||' '||oldpath if exists(oldpath) then call copyfile(path.log, oldpath, 'a') else call copyfile(path.log, oldpath, 'c') end /* Read excludefile */ if path.exc = '' then path.exc = makepath(pathpart(path.db), 'statty.exclude') if ~readfile(path.exc, area.exc) then area.exc.0 = 0 /* Parse db and area files */ if exists(path.db) then do say msg.read||' '||path.db if ~readfile(path.db, line) then call errorexit(msg.err_read||' '||path.db) parse var line.1 start.firstdb start.lastdb start.areastamp . parse value statef(path.area) with . . . . days mins ticks . chkstamp = days||mins||ticks if start.areastamp ~= chkstamp then do start.areastamp = chkstamp interpret 'call '||tosser||'area()' num = 1 do d = 2 to line.0 parse var line.d _msgs '"' _name '"' _toyou _fromyou . db.name.num = _name db.msgs.num = _msgs db.toyou.num = _toyou db.fromyou.num = _fromyou say count(num) num = num + 1 end db.name.0 = num - 1 end else do num = 1 do d = 2 to line.0 parse var line.d _msgs '"' _name '"' _toyou _fromyou . if area.exc.0 > 0 then do if lsearch(_name, area.exc) ~= -1 then iterate end area.name.num = _name db.name.num = _name db.msgs.num = _msgs db.toyou.num = _toyou db.fromyou.num = _fromyou say count(num) num = num + 1 end area.name.0 = num - 1 db.name.0 = area.name.0 end end else do interpret 'call '||tosser||'area()' start.firstdb = start.thisdb start.lastdb = start.thisdb parse value statef(path.area) with . . . . days mins ticks . start.areastamp = days||mins||ticks do a = 1 to area.name.0 db.name.a = area.name.a db.msgs.a = 0 db.toyou.a = 0 db.fromyou.a = 0 end end /* Parse log file */ log.name.0 = 0 interpret 'call '||tosser||'log()' if log.name.0 = 0 then say msg.no_msgs else do call calculatedb() /* Calculate database */ call putdb() /* Write database */ call genoutput() /* Write output */ end if ~delete(path.log) then call errorexit(msg.err_del||' '||path.log) say msg.fin exit ERROREXIT: say arg(1) exit 10 SPOTAREA: procedure expose area. msg. path. say msg.read||' '||path.area if ~readfile(path.area, line) then call errorexit(msg.err_read||' '||path.area) num = 1 do a = 1 to line.0 chk = upper(line.a) /* Skip separator, bad, default & netmail areas */ if pos(' SEPARATOR', chk) > 0 | pos(' BAD', chk) > 0 |, pos(' DEFAULT', chk) > 0 | pos(' NETMAIL', chk) > 0 then iterate parse var line.a . '"' . '"' '"' _user '"' /* Is areaname in excludefile? */ if area.exc.0 > 0 then do if lsearch(_user, area.exc) ~= -1 then iterate end /* A duplicate (user) areaname?!? */ if lsearch(_user, area.name) ~= -1 then call errorexit, (replace(msg.dup_area, '%s', _user)||' '||path.area||'!') area.name.num = _user area.name.0 = num /* Needed for lsearch() */ say count(num) num = num + 1 end return FOOZLEAREA: procedure expose area. msg. path. say msg.read||' '||path.area if ~open('tmp', path.area, 'r') then call errorexit(msg.err_read||' '||path.area) num = 1 null = '0'x do forever _name = readch('tmp', 24) /* Read areaname */ if eof('tmp') then leave /* Break condition */ tag = upper(strip(readch('tmp', 24), 't', null)) /* Read tagname */ dir = compress(readch('tmp', 32), null) /* Read areadir */ call seek('tmp', 128 + 520) /* Skip rest of area definition */ /* Iterate if not valid area ? */ if dir = '' | ~exists(dir) | tag = 'BAD' |, tag = 'MATRIX' then iterate _name = strip(_name, 't', null) /* Is areaname in excludefile? */ if area.exc.0 > 0 then do if lsearch(_name, area.exc) ~= -1 then iterate end /* A duplicate areaname?!? */ if lsearch(_name, area.name) ~= -1 then call errorexit, (replace(msg.dup_area, '%s', _name)||' '||path.area||'!') area.name.num = _name area.name.0 = num /* Needed for lsearch() */ say count(num) num = num + 1 end call close('tmp') return MAILMANAGERAREA: procedure expose area. msg. path. say msg.read||' '||path.area if ~readfile(path.area, line) then call errorexit(msg.err_read||' '||path.area) num = 1 start = 1 do forever /* Skip bad, netmail, fileecho & tick areas */ a = lsearch("'#ECHOAREA #?", line, start,, pattern) if a = -1 then leave start = a + 1 parse var line.a . '"' . '"' _name . /* Is areaname in excludefile? */ if area.exc.0 > 0 then do if lsearch(_name, area.exc) ~= -1 then iterate end if length(_name) > area.mmtaglen then do subname = left(_name, area.mmtaglen) chk = lsearch(subname||'#?', area.name,,, 'p') if chk ~= -1 then do say '"'||_name||'" '||msg.dup_area||' '||path.exc if area.exc.0 > 0 then call open('tmp', path.exc, 'a') else do if ~open('tmp', path.exc, 'w') then call errorexit(msg.err_create||' '||path.exc) area.exc.0 = 1 end call writeln('tmp', _name) call close('tmp') end end area.name.num = _name area.name.0 = num say count(num) num = num + 1 end return SPOTLOG: procedure expose log. area. msg. path. say msg.read||' '||path.log if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log) num = 1 export? = 0 do l = 1 to line.0 first = left(line.l, 1) select when pos(msg.xport_start, line.l) > 0 then export? = 1 when pos(msg.xport_end, line.l) > 0 then export? = 0 when first = '*' | first = '!' then do parse var line.l . "'" _name "'" rest /* Iterate if it's not a valid areaname */ if lsearch(_name, area.name) = -1 then iterate /* Find amount of msgs imported */ wds = words(rest) do w = 1 to wds _msgs = word(rest, w) if datatype(_msgs, 'w') then leave end /* Parse rest of line if any msgs for you */ if ~export? then do if first = '*' then do ww = w + 1 to wds _toyou = word(rest, ww) if datatype(_toyou, 'w') then leave end else _toyou = 0 /* Is it first time we find this areaname in logfile? */ chk = lsearch(_name, log.name) if chk = -1 then do /* Initialize variables */ log.name.num = _name log.msgs.num = _msgs log.toyou.num = _toyou log.fromyou.num = 0 log.name.0 = num /* Need this for lsearch() */ say count(num) num = num + 1 end else do /* Update variables */ log.msgs.chk = log.msgs.chk + _msgs log.toyou.chk = log.toyou.chk + _toyou end end else do /* Export! */ chk = lsearch(_name, log.name) if chk = -1 then do /* Initialize variables */ log.name.num = _name log.msgs.num = _msgs log.toyou.num = 0 log.fromyou.num = _msgs log.name.0 = num /* Need this for lsearch() */ say count(num) num = num + 1 end else do /* Update variables */ log.msgs.chk = log.msgs.chk + _msgs log.fromyou.chk = log.fromyou.chk + _msgs end end end otherwise nop end end return FOOZLELOG: procedure expose log. area. path. msg. say msg.read||' '||path.log if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log) num = 1 do l = 1 to line.0 if word(line.l, 4) = 'Area' then do parse var line.l . '"' _name '"' rest /* Iterate if it's not a valid areaname */ if lsearch(_name, area.name) = -1 then iterate /* Find amount of msgs imported */ wds = words(rest) do w = 1 to wds _msgs = word(rest, w) if datatype(_msgs, 'w') then leave end /* Parse rest of line if any msgs for you */ if right(line.l, 7) = 'for you' then do ww = w + 1 to wds _toyou = word(rest, ww) if datatype(_toyou, 'w') then leave end else _toyou = 0 /* Is it first time we find this areaname in logfile? */ chk = lsearch(_name, log.name) if chk = -1 then do /* Initialize variables */ log.name.num = _name log.msgs.num = _msgs log.toyou.num = _toyou log.fromyou.num = 0 /* Foozle doesn't support this...*/ log.name.0 = num /* Need this for lsearch() */ say count(num) num = num + 1 end else do /* Update variables */ log.msgs.chk = log.msgs.chk + _msgs log.toyou.chk = log.toyou.chk + _toyou end end end return MAILMANAGERLOG: procedure expose log. area. msg. path. say msg.read||' '||path.log if ~readfile(path.log, line) then call errorexit(msg.err_read||' '||path.log) num = 1 startimp = 'Import Statistics' endimp = 'Import Used' startexp = 'Start Export Function' endexp = 'End Export Function' action = '' do l = 1 to line.0 if action = '' then do select when pos(startimp, line.l) > 0 then action = 'imp' when pos(startexp, line.l) > 0 then action = 'exp' otherwise nop end end else do select when pos(endimp, line.l) > 0 then action = '' when pos(endexp, line.l) > 0 then action = '' when word(line.l, 7) = 'Area' then do if action = 'imp' then do parse var line.l . 'Area' _name _msgs '(' _toyou ')' /* Iterate if it's not a valid areaname */ if length(_name) < area.mmtaglen then chk = lsearch(_name, area.name) else chk = lsearch(_name||'#?', area.name,,, 'p') if chk = -1 then iterate _msgs = strip(_msgs) _toyou = strip(_toyou) /* Is it first time we find this areaname in logfile? */ chk = lsearch(_name, log.name) if chk = -1 then do /* Initialize variables */ log.name.num = _name log.msgs.num = _msgs log.toyou.num = _toyou log.fromyou.num = 0 log.name.0 = num /* Need this for lsearch() */ say count(num) num = num + 1 end else do /* Update variables */ log.msgs.chk = log.msgs.chk + _msgs log.toyou.chk = log.toyou.chk + _toyou end end else do /* Standalone export */ parse var line.l . 'Area' _name _fromyou . if length(_name) < area.mmtaglen then chk = lsearch(_name, area.name) else chk = lsearch(_name||'#?', area.name,,, 'p') if chk = -1 then iterate chk = lsearch(_name, log.name) if chk = -1 then do /* Initialize variables */ log.name.num = _name log.msgs.num = _fromyou log.toyou.num = 0 log.fromyou.num = _fromyou log.name.0 = num /* Need this for lsearch() */ say count(num) num = num + 1 end else do /* Update variables */ log.msgs.chk = log.msgs.chk + _fromyou log.fromyou.chk = log.fromyou.chk + _fromyou end end end otherwise nop end end end return CALCULATEDB: procedure expose area. msg. log. db. say msg.calcdb area.length = 0 area.maxmsgs = 0 area.maxtoyou = 0 area.maxnewmsgs = 0 area.maxnewtoyou = 0 area.maxfromyou = 0 area.maxnewfromyou = 0 area.totalmsgs = 0 area.totaltoyou = 0 area.totalfromyou = 0 area.totallogmsgs = 0 area.totallogtoyou = 0 area.totallogfromyou = 0 do a = 1 to area.name.0 say count(a) chklog = lsearch(area.name.a, log.name) if chklog = -1 then do newmsgs = 0 newtoyou = 0 newfromyou = 0 end else do newmsgs = log.msgs.chklog newtoyou = log.toyou.chklog newfromyou = log.fromyou.chklog end chkdb = lsearch(area.name.a, db.name) if chkdb = -1 then do dbmsgs = 0 dbtoyou = 0 dbfromyou = 0 end else do dbmsgs = db.msgs.chkdb dbtoyou = db.toyou.chkdb dbfromyou = db.fromyou.chkdb end _msgs = newmsgs + dbmsgs _toyou = newtoyou + dbtoyou _fromyou = newfromyou + dbfromyou area.totallogmsgs = area.totallogmsgs + newmsgs area.totallogtoyou = area.totallogtoyou + newtoyou area.totallogfromyou = area.totallogfromyou + newfromyou area.totalmsgs = area.totalmsgs + _msgs area.totaltoyou = area.totaltoyou + _toyou area.totalfromyou = area.totalfromyou + _fromyou area.length = max(area.length, length(area.name.a)) db.string.a = _msgs||' "'||area.name.a||'" '||_toyou||' '||_fromyou area.string.a = db.string.a||' '||newmsgs||' '||newtoyou||' '||newfromyou /* These variables needed when calculating/formatting output */ area.maxmsgs = max(_msgs, area.maxmsgs) area.maxtoyou = max(_toyou, area.maxtoyou) area.maxfromyou = max(_fromyou, area.maxfromyou) area.maxnewmsgs = max(newmsgs + newtoyou, area.maxnewmsgs) area.maxnewtoyou = max(newtoyou, area.maxnewtoyou) area.maxnewfromyou = max(newfromyou, area.maxnewfromyou) end db.string.0 = area.name.0 area.string.0 = area.name.0 drop log. return PUTDB: procedure expose db. start. msg. path. say msg.write||' '||path.db line = start.firstdb||' '||start.thisdb||' '||start.areastamp call steminsert(db.string, 1,, line) if ~writefile(path.db, db.string) then call errorexit(msg.err_write||' '||path.db) drop db. return GENOUTPUT: procedure expose start. area. msg. path. tosser toyou? allareas? say msg.write||' '||path.out /* Convert datestamps to normal dates */ template = '%e %B %Y %R' loc = openlocale() parse var start.thisdb ds.days '.' ds.seconds start.thisdb = strip(formatdate(loc, ds, template)) if start.firstdb ~= start.thisdb then do parse var start.firstdb ds.days '.' ds.seconds start.firstdb = strip(formatdate(loc, ds, template)) parse var start.lastdb ds.days '.' ds.seconds start.lastdb = strip(formatdate(loc, ds, template)) end else do start.firstdb = start.thisdb start.lastdb = start.thisdb end call closelocale(loc) /* Sort areas */ call qsort(area.string,, 'num', 1) if area.totalfromyou > 0 then fromyou? = 1 else fromyou? = 0 msg_len = length(area.maxmsgs) newmsg_len = length(area.maxnewmsgs) if toyou? then do toyou_len = length(area.maxtoyou) newtoyou_len = length(area.maxnewtoyou) pad_len = msg_len + 1 + 1 + toyou_len + 1 /* A space + '()' */ if fromyou? then do fromyou_len = length(area.maxfromyou) newfromyou_len = length(area.maxnewfromyou) pad_len = pad_len + 1 + fromyou_len /* A space */ end end else pad_len = msg_len totallen = length(msg.out_11) + 1 width = 3 do while width + pad_len < totallen width = width + 1 end spaces = makespaces(width) spaces_minus_one = makespaces(width - 1) /* '100%' kludge */ line.1 = tosser||' '||msg.out_1||' '||word(sourceline(2), 4) line.2 = '' line.3 = msg.out_2||' '||start.firstdb line.4 = msg.out_3||' '||area.totalmsgs if toyou? then do if fromyou? then line.4 = line.4||' ('||area.totaltoyou||' '||msg.out_4||', '||area.totalfromyou||' '||msg.out_5||')' else line.4 = line.4||' ('||area.totaltoyou||' '||msg.out_4||')' end line.5 = '' line.6 = msg.out_6||' '||start.thisdb line.7 = msg.out_7||' '||start.lastdb line.8 = area.totallogmsgs||' '||msg.out_8 if toyou? then do if fromyou? then line.8 = line.8||' ('||area.totallogtoyou||' '||msg.out_4||', '||area.totallogfromyou||' '||msg.out_5||')' else line.8 = line.8||' ('||area.totallogtoyou||' '||msg.out_4||')' end line.8 = line.8||' '||replace(msg.out_9, '%s', area.string.0) line.9 = '' line.10 = left(msg.out_10, area.length)||spaces||left('%', 5)||spaces||, left(msg.out_11, pad_len + width)||msg.out_12 line.11 = '' num = 12 /* Number of lines in header + 1 */ do q = area.string.0 to 1 by -1 parse var area.string.q _msgs '"' areaname '"' _toyou _fromyou newmsgs newtoyou newfromyou . if ~allareas? & _msgs = 0 then leave _msgs = strip(_msgs) if toyou? then do if fromyou? then do youtotal = ' ('||right(_toyou, toyou_len)||' '||right(_fromyou, fromyou_len)||')' younew = ' ('||right(newtoyou, newtoyou_len)||' '||right(newfromyou, newfromyou_len)||')' end else do youtotal = ' ('||right(_toyou, toyou_len)||')' younew = ' ('||right(newtoyou, newtoyou_len)||')' end end else do youtotal = '' younew = '' end line.num = left(strip(areaname), area.length)||spaces_minus_one||, format(((_msgs / area.totalmsgs) * 100), 3, 2)||spaces||, right(_msgs, msg_len)||youtotal||spaces||, right(newmsgs, newmsg_len)||younew say count(num) num = num + 1 end line.0 = num - 1 if ~writefile(path.out, line) then call errorexit(msg.err_write||' '||path.out) return /* ** Generic procedures */ MAKESPACES: procedure return copies(' ', arg(1)) COUNT: procedure return ' '||arg(1)||'9b'x||'A' FORMAT: procedure arg number, before, after /* Reformats the number to NUMERIC DIGITS setting */ num = number + 0 /* Return the reformatted number if other options not specified */ if before = '' & after = '' then return num /* Split the number into fraction and integer */ parse var num integer '.' fraction /* Set defaults for non-spec'd arguments */ if before = '' then before = length(integer) if after = '' then after = length(fraction) /* [before] argument must be at least as long as integer */ if before < length(integer) then return '**ERROR**' /* add an appropriate value of .5 to number to round it */ if after ~= length(fraction) then do fraction = trunc(('.'||fraction||'0') + ('.'||copies('0', after)||'5'), after) /* Numbers created as text strings are still numbers */ integer = integer + (fraction % 1) fraction = substr(fraction, 3) end if fraction >= 0 then return right(integer, before)||'.'||fraction else return right(integer, before) /* ** copyfile(sourcefile, destfile) */ COPYFILE: procedure parse arg from, to , mode sz = word(statef(from), 2) call open('s', from, 'r') if upper(mode) = 'A' then call open('d', to, 'a') else call open('d', to, 'w') do (sz % 65535) + 1 call writech('d', readch('s', 65535)) end call close('d') call close('s') return /* ** Replace(string, old, new) */ REPLACE: procedure parse arg src, old, new str = '' do while src ~= '' chk = pos(old, src) parse var src pre (old) src str = str||pre if chk > 0 then str = str||new end return str /* ** Use while developing... */ SYNTAX: ERROR: trace o err = rc ; line = sigl if datatype(err, 'n') then do errline = 'Error '||err||': '||errortext(err)||'0a'x||'in line '||line sayit? = 1 if show('p', 'rexx_ced') then do parse source . . filename . options results address 'rexx_ced' 'cedtofront' 'ow' filename 'jump to line' line 'okay1' errline sayit? = 0 end else say errline end exit