/*    $VER: 5.1 ArcMsgs.rexx 2 Jul 1992 (1.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 8
  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'

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 'lha m' arcname'.lha' 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'.lha')
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 */