/* fix the "last written" date of mr2 messages. This will find the date: header and use it to set the last-written-to date. It will also change last-written-to-date of FOLDER.NDX files (when a file, in the same directory as a FOLDER.NDX file, has had it's date updated). Require REXXLIB */ signal on syntax name goterr;signal on error name goterr signal on halt name goterr;call on failure name goterr2 /* Load up advanced REXX functions */ foo=rxfuncquery('sysloadfuncs') if foo=1 then do foo=RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs') if foo=0 then call SysLoadFuncs end foo=rxfuncquery('rexxlibregister') if foo=1 then do foo=rxfuncadd('rexxlibregister','rexxlib', 'rexxlibregister') if foo=0 then call rexxlibregister end foo=rxfuncquery('rexxlibregister') if foo=1 then do say "Sorry, this utility requires the REXXLIB library " exit end say "Utility to fix the 'last-written' date of MR2 message files " parse arg filestring if filestring='' | filestring='?' | filestring='-?' then do say say ' Enter fully qualified dir\file string(s) (* are okay).' say " All the files that match this string will be checked. " say " To also check subdirectories, end with a /S (no intervening spaces)" say " To exclude a file, include a -X=filename (no path, just the name, * okay)" say " Examples: " say " E:\MR2\MYSTUFF\*/S " say " E:\MR2\MYSTUFF\*/S -X=MR2I.OUT " say " * [ * is shorthand for: *.OUT/S *.RCV/S -X=MR2I.OUT ]" say " E:\MR2\ACCT1\*.RCV E:\MR2\ACCT1\*.OUT " say " E:\MR2\WORK\*.OUT/S E:\MR2\PLAY\*.OUT " say " (this means 'all subdirs of WORK, but not of PLAY') " say " Note: as of this version, dir\file strings can NOT have embedded spaces." say call charout, "Dir\File string? " pull filestring if filestring='' then exit end if filestring='*' then filestring='*.RCV/S *.OUT/S -X=MR2I.OUT' fils.0=0 filestring0=filestring say nf='' excs.=0 do forever /* remove -X= modifiers */ if filestring0='' then leave parse upper var filestring0 a1 filestring0 a1=strip(a1) if abbrev(a1,'-X=')=0 then do nf=nf||a1||' ' end else do nexcs=excs.0+1 parse var a1 . '-X=' excs.nexcs . excs.0=nexcs say " Excluding: "excs.nexcs end end filestring0=nf do forever if filestring0='' then leave parse upper var filestring0 astring filestring0 astring=strip(astring) if astring='/S' then iterate usesubs='F' if right(astring,2)='/S' then do astring=left(astring,length(astring)-2) usesubs='FS' end oo=sysfiletree(astring,'fils0.',usesubs) if fils0.0=0 then do say "No files matching: " astring iterate end do ij=1 to fils0.0 ijj=fils.0+ij fils.ijj=fils0.ij end fils.0=ijj say fils0.0 "files match "astring end if fils.0=0 then do say "No files match: " filestring exit end say '=======' say fils.0 "files match "filestring say dirlist.='' cc2='0a0a'x cr2='0d0a0d0a'x cr1='0a'x do kk=1 to fils.0 if (kk//100)==1 then say "Processing file # "kk " of " fils.0 parse var fils.kk date time . . afile /* check exclusions */ nm=filespec('n',afile) do mm=1 to excs.0 if wild_match(nm,excs.mm)<>0 then iterate kk end afile=strip(afile) afile=stream(afile,'c','query exists') if afile='' then iterate oo=stream(afile,'c','open read') if abbrev(translate(strip(oo)),'READY')<>1 then do say ' unable to open: 'afile '('oo call charout,' hit any key to continue ' foo=sysgetkey('noecho') say bb=stream(afile,'c','close') iterate end ii=stream(afile,'c','query size') stuff=charin(afile,1,min(1000,ii)) pp=pos(cr2,stuff) if pp=0 then pp=pos(cc2,stuff) if pp=0 then do stuff=charin(afile,1,min(25000,ii)) pp=pos(cr2,stuff) if pp=0 then pp=pos(cc2,stuff) end if pp=0 then do say "Not an MR2 file: "afile call charout,' hit any key to continue ' foo=sysgetkey('noecho') say bb=stream(afile,'c','close') iterate end bb=stream(afile,'c','close') parse var stuff hdrs (cr2) . parse upper var hdrs . 'DATE:' adate (cr1) . adate=translate(adate,' ','0d0a000901'x) /* THU, 19 APR 2001 15:21:41 -0700*/ if pos(',',adate)>0 then parse var adate dd ',' adat amonth ayr atime . else parse var adate dd adat amonth ayr atime . if datatype(adat)<>'NUM' then do /* probably day of week is missing */ parse var adate adat amonth ayr atime . end select when ayr<80 then ayr ='20'||ayr when ayr<100 then ayr='19'||ayr otherwise end yy=dateconv(adat' 'amonth' 'ayr,'N','S') tt=space(translate(atime,' ',':'),0) if length(tt)=4 then tt=tt||'00' if length(yy)<>8 | length(tt)<>6 | datatype(yy)<>'NUM' , | datatype(tt)<>'NUM' then do say "Bad date field in: " afile say " : " adate call charout,' hit any key to continue (and skip this file) ' foo=sysgetkey('noecho') ;say iterate end gg=dosfdate(afile,yy,tt) if gg=0 then do say " problem fixing date of " afile','yy','tt call charout,' hit any key to continue ' foo=sysgetkey('noecho'); say iterate end /* store this dir, and it's date? */ adir='!'||filespec('d',afile)||filespec('p',afile) if dirlist.adir='' then do dirlist.adir=1 dirlist.0=dirlist.0' 'adir dirlist.adir.1=yy ; dirlist.adir.2=tt end else do if dirlist.adir.1'' (is a prior return from sref_wild_match), then the current match is compared to this oldresu. If the current match is "better" (has more matching characters early in the string), then : return match info If it's worse (or the same): return 0 Basically, -1 means "exact match", 0 means "no match" or "not better match" (if oldresu not specified, 0 always means "no match"), and everything else means "wild card match". */ wild_match:procedure parse upper arg needle, haystack,oldresu aresu=awild_match(needle,haystack) if aresu=0 then return aresu /* no match */ if aresu=-1 | oldresu=' ' then return aresu /* exact match, or first wildcard match */ /* Is this a better WILDCARD MATCH */ wrdsnew=words(ARESU);wrdsold=words(oldRESU) useold=1 do Nmm=1 to max(wrdsold,wrdsnew) if Nmm>wrdsnew then leave if Nmm>wrdsold then do useold=0; leave end a1=strip(word(oldresu,Nmm)) a2=strip(word(aresu,Nmm)) if a1=a2 then iterate if a2>a1 then leave /* new matching element > old matching element, thus new is worse match */ useold=0 /* found a matching element in new < then corresponding element in old*/ leave /* thus, new is better match */ end IF USEold=0 THEN return aresu return 0 /* non superior match (might be same, in which case old is used*/ awild_match:procedure parse upper arg needle, haystack ; haystack=strip(haystack) needle=strip(needle) if needle=haystack then return -1 /* -1 signals exact match */ ast1=pos('*',haystack) if ast1=0 then return 0 /* 0 means no match */ if haystack='*' then do if length(needle)=0 then return 100000 else return length(needle) end ff=haystack ii=0 do until ff="" ii=ii+1 parse var ff hw.ii '*' ff hw.ii=strip(hw.ii) end if hw.ii='' then ii=ii-1 hw.0=ii /* check each component of haystackw against needle -- all components must be there */ resu=' ' istart=1 ; ido=2 if ast1>1 then do /* first check abbrev */ if abbrev(needle,hw.1)=0 then return 0 aresu=length(hw.1) if hw.0=1 then do do nm=1 to aresu resu=resu||' '||nm end /* do */ return resu /* if haystacy of form abc*, we have a match */ end ido=2 ; istart=aresu+1 do mm=1 to aresu resu=resu||' '||mm end /* do */ end /* if here, then first part (a non wildcard) of haystack matches first part of needle Now check sequentially that each remaining part also exists */ do mm=ido to hw.0 igoo=pos(hw.mm,needle,istart) if igoo=0 then return 0 tres=length(hw.mm) istart=igoo+tres do nn=igoo to (istart-1) resu=resu||' '||nn end /* do */ end if istart >= length(needle) | right(haystack,1)='*' then return resu return 0