home *** CD-ROM | disk | FTP | other *** search
- /* $VER: 5.3 ArcMsgs.rexx 15 Jul 1992 (15.7.92)
- archives unread conference messages into file in users email
- copyright 1991-92 Richard Lee Stockton FREELY DISTRIBUTABLE
- */
-
- SIGNAL ON BREAK_C
- SIGNAL ON ERROR
- SIGNAL ON SYNTAX
- OPTIONS FAILAT 999999
-
- PARSE ARG name' 'single_dir' '.
- IF STRIP(single_dir)='' THEN single_dir=0
- IF name='' THEN CALL GETOUT(20)
-
- CALL CLOSE(STDOUT)
- CALL OPEN(STDOUT,'RAM:ArcMsgs.STDOUT','W')
-
- figarg='s:CONFIG.BBS'
- IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
- x=OPEN(f,figarg,'R')
- IF x=0 THEN
- DO
- SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
- CALL GETOUT(21)
- END
-
- data.=''
- DO i=1 TO 33
- data.i=READLN(f)
- END
- CALL CLOSE(f)
-
- compos=POS('/*',data.1)
- IF compos>0 THEN data.1=LEFT(data.1,compos-1)
- bbsname = STRIP(data.1)
- sysop = WORD(data.2,1)
- bbspath = WORD(data.6,1)
- IF ~EXISTS(bbspath) THEN
- DO
- SAY bbspath 'does not exist!'
- CALL GETOUT(22)
- END
- testchar=RIGHT(bbspath,1)
- IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
-
- msgpath = WORD(data.7,1)
- IF ~EXISTS(msgpath) THEN
- DO
- SAY msgpath 'does not exist!'
- CALL GETOUT(23)
- END
- testchar=RIGHT(msgpath,1)
- IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
- msgpath=msgpath'MSG'
-
- extension=WORD(data.32,1)
- arccom=data.33
- compos=POS('/*',data.33)
- IF compos>0 THEN data.33=LEFT(data.33,compos-1)
- arccom=STRIP(data.33)
- IF LEFT(extension,1)~='.' THEN
- DO
- extension='.lzh'
- arccom='lharc -m m'
- END
-
- x=OPEN(f,bbspath'Users/'name,'R')
- IF x=0 THEN
- DO
- CALL DELAY(150)
- x=OPEN(f,bbspath'Users/'name,'R')
- IF x=0 THEN
- DO
- SAY name 'user file is missing!'
- CALL GETOUT(24)
- END
- END
- data.=''
- DO i=1 TO 25
- data.i=READLN(f)
- END
- CALL CLOSE(f)
- level=data.20%1
- lastread.=0
-
- msg.=''
- IF readopen(bbspath'Lists/Conferences') THEN
- DO
- DO i=1
- line=READLN(f)
- IF line='END' THEN BREAK
- IF EOF(f) THEN BREAK
- num=WORD(line,1)
- IF DATATYPE(num,'N') THEN msg.num=WORD(line,2)
- END
- CALL CLOSE(f)
- END
- CALL SETCLIP('BBS_MSGS')
-
- CALL PRAGMA('P',-2) /* lower the priority of this task */
-
- x=OPEN(f,bbspath'Numbers/LastMail','R')
- IF x~=0 THEN lastm=READLN(f)+1
- CALL CLOSE(f)
- ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
-
- filepath=bbspath'EmailFiles/'name
- CALL MAKEDIR(filepath)
- arcname=filepath'/BBBBS_'lastm
- x=OPEN(a,arcname,'W')
- IF x=0 THEN CALL GETOUT(30)
-
- CALL WRITELN(a,'= Custom archived for' name)
- CALL WRITELN(a,'=' bbsname 'conference messages to' DATE('W') DATE() TIME('C'))
- CALL WRITELN(a,'')
- CALL newmsgs()
-
- CALL CLOSE(a)
- CALL DELAY(28)
- IF WORD(STATEF(arcname),2)<80 THEN CALL GETOUT(24)
-
- ADDRESS COMMAND arccom arcname||extension arcname
- x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
- IF x=0 THEN CALL GETOUT(26)
- subj='All New Conference Messages'
- IF single_dir>0 THEN subj=msg.single_dir' conference messages.'
- CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm||extension)
- CALL WRITELN(f,' From: BBBBS')
- CALL WRITELN(f,' To: 'name)
- CALL WRITELN(f,' Subj: 'subj)
- CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
- CALL WRITELN(f,LEFT('=',75,'='))
- CALL WRITELN(f,'Here are the archived new messages you requested.')
- CALL CLOSE(f)
- IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
- DO
- oldmess=GETCLIP('BBS_MESSAGE')
- IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
- CALL SETCLIP('BBS_MESSAGE',oldmess||'Your archived messages are waiting in Email.')
- END
- CALL GETOUT(0)
- EXIT
-
-
- /* Functions */
-
- countcheck:
- PARSE ARG fname' '.
- IF ~readopen(fname) THEN RETURN(cknum)
- retval=STRIP(READLN(f))
- CALL CLOSE(f)
- IF ~DATATYPE(retval,'N') THEN retval=0
- RETURN(retval)
-
-
- newmsgs:
- IF single_dir>0 THEN
- DO
- msgdir=single_dir
- CALL readmsg()
- RETURN
- END
- CALL WRITELN(a,'Scanning all Conferences for new messages..')
- DO newi=1 TO level
- IF msg.newi='' THEN ITERATE newi
- msgdir=newi
- CALL readmsg()
- END
- RETURN
-
-
- readmsg:
- IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
- IF WORD(data.22,msgdir)=-1 THEN RETURN; /* user excluded */
- IF DATATYPE(WORD(data.22,msgdir),'N') THEN
- lastread.msgdir=WORD(data.22,msgdir)
- lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
- frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
- temp=''
- IF lastread.msgdir>=lstwrt THEN
- DO
- lastread.msgdir=lstwrt
- RETURN
- END
- CALL WRITELN(a,'Entering' msg.msgdir 'Message Conference..')
- dirname=msgpath||msgdir
- msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
- firstmess=999999
- testlist=SHOWDIR(dirname)
- DO i=1 TO WORDS(testlist)
- test=WORD(testlist,i)
- IF test>lastread.msgdir THEN msglist.test=1
- IF test<firstmess THEN firstmess=test
- END
- IF firstmess=999999 THEN firstmess=0
- CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
- msgstatus=1
- DO msgloop=1
- lastreadnum=lastread.msgdir
- DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
- lastreadnum=lastreadnum+1
- END
- lastread.msgdir=lastreadnum
- IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN RETURN
- DO mess=lastread.msgdir TO lstwrt+1
- IF msglist.mess~=msgstatus THEN ITERATE mess
- IF msgstatus>1 THEN CALL WRITELN(a,'Following the thread, level' msgstatus-1'.')
- msglist.mess=0
- arg=dirname'/'mess
- IF ~EXISTS(arg) THEN
- DO
- CALL WRITELN(a,'Message number' mess 'is missing.')
- ITERATE mess
- END
- IF ~readopen(arg) THEN ITERATE mess
- firstline = READLN(f)
- secondline = READLN(f)
- thirdline = READLN(f)
- forthline = READLN(f)
- CALL CLOSE(f)
- IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
- DO
- thread=SUBSTR(firstline,WORDINDEX(firstline,4))
- DO tindx=1 TO WORDS(thread)
- test=WORD(thread,tindx)
- IF msglist.test~=0 THEN msglist.test=msgstatus+1
- END
- END
- CALL add_msg(arg)
- IF thread~='' THEN
- DO
- thread=''
- msgstatus=msgstatus+1
- END
- END
- IF msgstatus>1 THEN msgstatus=msgstatus-1
- END
- RETURN
-
-
- readopen:
- PARSE ARG fname
- ok=OPEN(f,fname,'R')
- IF ok~=0 THEN RETURN(1)
- SAY fname 'failed to open for reading!'
- RETURN(0)
-
-
- readlines:
- CALL CLOSE(f)
- PARSE ARG tempname readstart .
- IF ~readopen(tempname) THEN RETURN(1)
- IF readstart<2 THEN lynes.=''
- DO ri=readstart
- line=READLN(f)
- IF EOF(f) THEN BREAK
- lynes.ri=line
- END
- lynes.0=ri-1
- RETURN
-
-
- add_msg:
- ARG addname .
- x=OPEN(b,addname,'R')
- IF x=0 THEN SAY addname 'failed to open for reading!'
- ELSE
- DO
- data=READCH(b,65000)
- CALL CLOSE(b)
- CALL WRITECH(a,data)
- END
- CALL WRITELN(a,'')
- CALL WRITELN(a,'')
- RETURN
-
-
- BREAK_C:
- SAY 'BREAK_C at line' SIGL
- CALL GETOUT(1)
-
-
- ERROR:
- SYNTAX:
- GETOUT:
- ARG errorout
- CALL SETCLIP('BBS_MSGS')
- IF errorout>0 | RC>0 THEN SAY 'Error:' errorout' RC='RC' SIGL='SIGL
- EXIT(errorout)
-
- /* end of ArcMsgs.rexx */
-