OS/2 Shareware BBS: 3 Comm/03-Comm.zip/AUTOPO.ZIP/READBBS.CMD

OS/2 REXX Batch file | 1991-08-21 | 24KB | 784 lines

/* REXX to program to READ messages from OS/2 EEP BBS

   READBBS 0.07  (c) 1991, University of Missouri

   Written by: Rick Wilkeson
               Computer Programmer Analyst II
               Administrative Data Processing
               University of Missouri-Rolla
                  Internet: [e-mail]



   DISCLAIMER:  This program is distributed "ASIS" no support is given.
   If you locate a bug you can send be a note, but I don't know when I could
   work on fixing it...But you can modify the program yourself.  If you
   do modify this code please give credit where credit is due.  Also, all
   rights are retained by the University of Missouri, so you can't sell it.

   I wrote this in a week, so if there are no bugs it will be a miracle.
   Also very little error checking is done.  If you try I'm sure you can
   cause it to crash.

   Note:
   Ansi screen routines written by:  Michael J Antonio
                                     (MikeA) [e-mail]
*/
'@echo off'
Parse Arg params
If params='' | translate(params)='/H' then
   Call Usage
Parse Var params infile .
Call Init
Call Openfile
Call Indexfile
/*  File is open ready to read file */
readpos=stream(infile,'c','seek +0')
say ''
/*  Main conference loop */
curconf=1
do while curconf<=numconf
   if confer.curconf.count>0 then
      do
         Call AnsiSay(color.menuconf)
         say '***' confer.curconf.count '('confer.curconf.minidx'..'confer.curconf.maxidx') messages in' confer.curconf.name
         say 'Read Now? [Y]es, [N]o, [+] next, [-] prev, [Q]uit'
         ch=GetChar()
         select
            when ch='Y'|ch='' then
               do
                  lastmess=false
                  Call ReadConference
               end
            when ch='-' then
               do
                  if curconf>1 then
                     curconf=curconf-1
                  iterate
               end
            when ch='Q' then
               Leave
            when ch='N' | ch='+' then
               nop
         otherwise
            iterate
         end  /* select */
      end
   curconf=curconf+1
end /* do */
Call WriteConfigfile
say
Call AnsiSay(color.attention)
say 'Reading Complete.'||ansi.bblack||ansi.fwhite
Exit

/* Get a character from STDIN: */
GetChar: Procedure
ch=strip(Translate(left(LINEIN(),1)))
Return ch

/* Get a line from STDIN: */
GetLine: Procedure
input=linein()
Return input

/*  Initialize READBBS */
Init:
revision='0.07'
true=1
false=0
'ANSI ON >nul'
Ansi.=''
Call SetAnsi
/*  Check for command line options */
params=translate(params)
If pos('/I',params)>0 then
   indexflag=true
else
   indexflag=false
If pos('/C',params)>0 then
   Parse Var params '/C' cfgfile
else
   cfgfile=''
If pos('NOLASTREAD',params)>0 | pos('NLR',params)>0 then
   nlrflag=true
else
   nlrflag=false
if cfgfile='' then
   do
      Parse Source os . prgfullname
      pdrive=filespec('drive',prgfullname)
      ppath=filespec('path',prgfullname)
      pfname=filespec('name',prgfullname)
      Parse Var pfname pfilename '.' pext
      cfgfile = pdrive || ppath || pfilename || '.CFG'
   end

/* Read Config file */
cfgfile=strip(cfgfile)
rc = stream(cfgfile,'c','query exists')
If rc='' then
   do
      say 'Config file ('cfgfile') not found.'
      exit
   end
rc=stream(cfgfile,'c','open read')
If substr(rc,1,5)<>'READY' then
   do
      say 'Error opening' cfgfile 'for READ.'
      exit
   end
indata = linein(cfgfile)
if substr(indata,1,7)<>'READBBS' then
   do
      say 'Config file ('cfgfile') not in correct format.'
      exit
   end
do while lines(cfgfile)
   select
      when translate(substr(indata,1,12))= 'CONFERENCES:' then
         do
            Parse Upper Var indata 'CONFERENCES:' numconf
            do i = 1 to numconf
                indata = linein(cfgfile)
                Parse Var indata confer.i.num confer.i.name '[' confer.i.lastread ']'
                if confer.i.lastread='' then
                  confer.i.lastread=0
                confer.i.name=strip(confer.i.name)
             end /* do */
         end
      when translate(substr(indata,1,6))='COLOR:' then
         do
            do i = 1 to 6
               indata=linein(cfgfile)
               Parse Upper Var indata colortype foreground background
               color.fore.colortype=foreground
               color.back.colortype=background
               foreground='f'||strip(foreground)
               background='b'||strip(background)
               interpret 'color.'colortype'=ansi.'foreground'||ansi.'background
            end /* do */
         end /* do */

   otherwise
   end /* select */
   indata=linein(cfgfile)
end
rc = stream(cfgfile,'c','close')
numconf=numconf+1
confer.numconf.name  = 'Conference Not Found'
confer.numconf.num = '99'
drive=filespec('drive',infile)
path=filespec('path',infile)
fname=filespec('name',infile)
Parse Var fname filename '.' ext
beginthreadidx=0
cont=1
ch =' '
messidx=0
return


/* Conference has been selected and ready to read messages */
ReadConference:
messidx=0
if \nlrflag & (confer.curconf.lastread >=confer.curconf.minidx & confer.curconf.lastread <= confer.curconf.maxidx) then
   do
      ch=confer.curconf.lastread+1
      Call FindMessageNumber
   end /* do */
do while cont
   select
      when ch='?' then
         do
            say ' [Number].......Goto closest specified message number.'
            say ' [+], [Return]..Display next message.'
            say ' [-]............Display previous message.'
            say ' [R]............Reply to current message.'
            say ' [T]............Search subject to find next matching message.'
            say ' [S]............Search subject for specified string.'
            say ' [L]............List message number and subject for current conference.'
            say ' [Q]............Quit messages'
            say ' [?]............Display this screen.'
            say
            say '[Return] to return to message.'
            junk=GetChar()
            Call DisplayMessage
         end
      when ch='R' then
         do
            Call ReplyMessage
            call DisplayMessage
         end /* do */
      when ch='T' then
         do
            if beginthreadidx=0 then
               beginthreadidx=messidx
            call SearchThread
            call GetNextMessage
            call DisplayMessage
         end /* do */
      when ch='S' then
         do
            Call SearchSubject
            Call GetNextMessage
            Call DisplayMessage
         end /* do */
      when ch='L' then
         do
            Call ListSubjects
            Call DisplayMessage
         end /* do */
      when datatype(ch)='NUM' then
         do
            say 'Searching for message number' strip(ch)'...'
            beginthreadidx=0
            Call FindMessageNumber
            Call GetNextMessage
            Call DisplayMessage
         end
      when ch='Q' then
         cont=0
      when ch='+' then
         do
            beginthreadidx=0
            if messidx<confer.curconf.count then
               messidx=messidx+1
            Call GetNextMessage
            Call DisplayMessage
         end /* do */
      when ch='-' then
         do
            If messidx<>1 then
               messidx=messidx-1
            beginthreadidx=0
            Call GetNextMessage
            Call DisplayMessage
         end
   otherwise
      do
         if lastmess then
            cont=false
         else
            do
               beginthreadidx=0
               if messidx<confer.curconf.count then
                  messidx=messidx+1
               Call GetNextMessage
               Call DisplayMessage
            end
      end
   end  /* select */

   nextline='** Message('mess.curconf.messidx.num') **'
   If lastmess then
      nextline=nextline || color.attention||' Last message in' confer.curconf.name
   Call AnsiSay(color.menumess)
   say nextline
   Call AnsiSay(color.menumess)
   say '['confer.curconf.minidx'..'confer.curconf.maxidx'], [+] or [Return] next, [-] prev'
   say '[R]eply, [T]hread, [S]ubject Search, [L]ist Subjects, [Q]uit, [?] help'
   ch=Translate(GetLine())
   If ch='Q' | (lastmess & ch='') then
      return
end
Return

/* Search subject lines for IDENTICAL subject */
SearchThread:
cursubject=mess.curconf.messidx.subject
conf=confer.curconf.name
say 'Searching' strip(conf)'...'
Do i = messidx+1 to confer.curconf.count
   If mess.curconf.i.subject=cursubject then
      do
         messidx=i
         return
      end /* do */
end /* do */
say 'No more message in thread.  Returning to start of thread.'
say '---More---'
ch=GetChar()
rc = stream(infile,'c','seek ='mess.curconf.beginthreadidx.pos)
messidx=beginthreadidx
beginthreadidx=0
return

/*  Search Subject lines for phrase */
SearchSubject:
saveidx=messidx
if symbol('srchsubject')='LIT' then
   srchsubject='**No Phrase**'
say 'Enter Phrase to search on: [Return] for "'srchsubject'"'
ssubject=GetLine()
if ssubject<>'' | srchsubject='**No Phrase**' then
   srchsubject=ssubject
srchsubject=translate(srchsubject)
conf=confer.curconf.name
say 'Searching' strip(conf) 'for "'srchsubject'"...'
Do i = messidx+1 to confer.curconf.count
   If pos(srchsubject,translate(mess.curconf.i.subject))<>0 then
      do
         messidx=i
         return
      end /* do */
end /* do */
say 'Subject Phrase Not Found.'
say '---More---'
/*Pull ch*/
ch=GetChar()
rc = stream(infile,'c','seek ='mess.curconf.saveidx.pos)
return

FindMessageNumber:
do i=1 to confer.curconf.count while mess.curconf.i.num<ch
end /* do */
If i<=confer.curconf.count then
   do
      messidx=i
      Call GetNextMessage
   end /* do */
else
   do
      say color.attention||'Message number' ch 'not found in' confer.curconf.name'.'
      say 'Press any key to continue.'
      /*pull junk*/
      junk=GetChar()
   end
return

GetNextMessage:
rc=stream(infile,'c','seek ='mess.curconf.messidx.pos)
if rc<>mess.curconf.messidx.pos then
   do
      say 'Error in index file.'
      say 'Tried to move to position' mess.messidx.pos'.'
      say 'rc=' rc
      exit
   end /* do */
indata=linein(infile)
do while lines(infile)
   Parse Var indata '****' conf '****'
   if conf<>'' then
      return
   if substr(indata,1,9)='Message :' then
      do
         header.1=indata
         do i=2 to 5
            header.i=linein(infile)
         end /* do */
         i=1
         indata=linein(infile)
         do while lines(infile) & substr(indata,1,9)<>'Message :'
            message.i = indata
            indata=linein(infile)
            i=i+1
         end /* do */
         messagelength=i-1

         return
      end /* do */
   indata=linein(infile)
end
return

DisplayMessage:
'cls'
lastmess=false
If mess.curconf.messidx.num=confer.curconf.maxidx then
   lastmess=true
Call AnsiSay(color.header)
do i=1 to 5
   say header.i
end /* do */
Call AnsiSay(color.message)
j=5
do i=1 to messagelength
   if j>21 then
      do
         say '--More-- [Return] to continue, [Q]uit'
         /*PULL ch*/
         ch=GetChar()
         if ch='Q' then
            return
         j=1
      end
   Parse Var message.i '****' mconf '****'
   if mconf <>'' then
      do
         do k=1 to numconf
            if mconf=confer.k.name then
               return
         end /* do */
         say message.i
      end /* do */
   else
      say message.i
   j=j+1
end /* do */
confer.curconf.lastread=mess.curconf.messidx.num
return

ListSubjects:
say
say 'Listing Subject for' confer.curconf.name
say
say 'Num  Subject                      From                To'
say copies('-',79)
do i =1 to confer.curconf.count
   if i//21=0 then
      do
         say '---More--- [Return] to continue, [Q]uit'
         /*pull junk*/
         junk=GetChar()
         If junk='Q' then
            return
         say 'Num  Subject                      From                To'
         say copies('-',79)
      end
   lineout=copies(' ',79)
   lineout=overlay(mess.curconf.i.num||'  '||mess.curconf.i.subject,lineout,1)
   lineout=overlay(mess.curconf.i.from,lineout,35)
   lineout=overlay(mess.curconf.i.to,lineout,55)
   say lineout
end /* do */
say 'Press [Return] to return to message.'
/*pull junk*/
junk=GetChar()
return

ReplyMessage:
Parse Var header.1 'Message :' replynum .
Parse Var header.2 'From... :' first last .
initials= substr(first,1,1)||substr(last,1,1)
outfile=drive||path||'REP' || strip(replynum) ||'.'||curconf
rc=stream(outfile,'c','query exist')
if rc <>'' then
   do
      'erase' outfile
   end /* do */
rc = stream(outfile,'c','open write')
do i = 1 to messagelength
   outdata = initials||'>'||message.i
   call lineout outfile,outdata
end /* do */
rc = stream(outfile,'c','close')
'e' outfile
return

Openfile:
If infile='' then
   do
      say '*** No mail file specified.***'
      call usage
      exit
   end
rc = stream(infile,'c','query exists')
If rc='' then
   do
      say infile 'does not exist.'
      exit
   end /* do */
fullname = stream(infile,'c','open read')
If substr(fullname,1,5)<>'READY' then
   do
      say 'Error opening' infile
      exit
   end /* do */
return

Indexfile:
indexfile=drive||path||filename||'.idx'
indexexists=stream(indexfile,'c','query exists')
If indexexists=''| indexflag then
   do
      Say 'Creating index file...Please wait...'
      Call Reindex
   end /* do */
else
   say 'Reading index file...'
rc=stream(indexfile,'c','close')
rc=stream(indexfile,'c','open read')
Call ReadIndex
rc=stream(indexfile,'c','close')
return

ReadIndex:
indata=linein(indexfile)
Parse Var indata prgname prgver ofilesize '-' odatetime
If prgname <>'READBBS' then
   do
      say indexfile 'not in correct format.'
      exit
   end /* do */
filesize=stream(infile,'c','query size')
datetime=stream(infile,'c','query datetime')
if ofilesize <> filesize | datetime <> odatetime then
   do
      say infile 'does not match' indexfile'.  Re-Createing index...'
      Call Reindex
      rc=stream(indexfile,'c','close')
      rc=Stream(indexfile,'c','open read')
      indata=linein(indexfile)
   end
Do i=1 to numconf while lines(indexfile)
   indata=linein(indexfile)
   Parse Var indata '['confer.i.name']['confer.i.count']['confer.i.minidx']['confer.i.maxidx']'
   j=0
   Do k=1 to confer.i.count while lines(indexfile)
      indata=linein(indexfile)
      if substr(indata,1,3)<>'DUP' then
         do
            j=j+1
            Parse Var indata '   ['mess.i.j.pos']['mess.i.j.num']['mess.i.j.subject']['mess.i.j.date']['mess.i.j.to']['mess.i.j.from']'
         end
   end
   confer.i.count=j
end
return

reindex:
do i=1 to numconf
   confer.i.maxidx=0
   confer.i.minidx=0
   confer.i.count=0
end /* do */
messcnt=0
say '   Reading Message Headers...'
readpos=stream(infile,'c','seek +0')
datain=linein(infile)
do while lines(infile)
      if substr(datain,1,9)='Message :' then
         do
            header.1=datain
            do i=2 to 4
               header.i=linein(infile)
            end /* do */
            Parse Var header.1 'Message :' mnum  mconf 'Date... :' mdate '(' .
            Parse Var header.2 'From... :' mfrom 'Refer'
            Parse Var header.3 'To..... :' mto "Sec'ty"
            Parse Var header.4 'Subject :' msubject "Rec'vd" .
            mconf=strip(mconf)
            mconf=strip(substr(mconf,2,length(mconf)-2))
            do confcnt=1 to 7 while mconf <> confer.confcnt.name
               nop
            end /* do */
            confer.confcnt.count=confer.confcnt.count+1
            messcnt=confer.confcnt.count
            mess.confcnt.messcnt.num=mnum
            mess.confcnt.messcnt.subject=msubject
            mess.confcnt.messcnt.date = strip(mdate)
            mess.confcnt.messcnt.to = strip(mto)
            mess.confcnt.messcnt.from= strip(mfrom)
            mess.confcnt.messcnt.pos=readpos
            If mess.confcnt.messcnt.num < confer.confcnt.minidx | confer.confcnt.minidx=0 then
               confer.confcnt.minidx=mess.confcnt.messcnt.num
            If mess.confcnt.messcnt.num > confer.confcnt.maxidx | confer.confcnt.maxidx=0 then
               confer.confcnt.maxidx=mess.confcnt.messcnt.num
            DROP header.
         end /* do */
   readpos=stream(infile,'c','seek +0')
   datain=linein(infile)
end /* do */
say '   Sorting Messages...'
Call SortConfers
say '   Writing Index File...'
filesize=stream(infile,'c','query size')
datetime=stream(infile,'c','query datetime')
if indexexists<>'' then
   do
      rc=stream(indexfile,'c','close')
      'del' indexfile
   end
rc=stream(indexfile,'c','open write')
Call lineout indexfile,'READBBS' revision filesize '-' datetime
do i=1 to numconf
   Call lineout indexfile,'['confer.i.name']['confer.i.count']['confer.i.minidx']['confer.i.maxidx']'
   savenum=0
   do j=1 to confer.i.count
      if mess.i.j.num<>savenum then
         do
            Call lineout indexfile,'   ['mess.i.j.pos']['mess.i.j.num']['strip(mess.i.j.subject)']['mess.i.j.date']['mess.i.j.to']['mess.i.j.from']'
            savenum=mess.i.j.num
         end
      else
         do
            Call lineout indexfile, 'DUP['mess.i.j.pos']['mess.i.j.num']['strip(mess.i.j.subject)']['mess.i.j.date']['mess.i.j.to']['mess.i.j.from']'
         end
   end /* do */
end /* do */
DROP mess.
return

sortconfers:
do n=1 to numconf
   stackheight=1
   lstack.1=1
   rstack.1=confer.n.count
   do forever
      left=lstack.stackheight
      right=rstack.stackheight
      stackheight=stackheight-1
      do forever
         i=left
         j=right
         a=trunc((left+right)/2)
         median = mess.n.a.num
         do forever
            do while mess.n.i.num < median
               i=i+1
            end /* do */
            do while median < mess.n.j.num
               j=j-1
            end /* do */
            if i<=j then
               do
                  save.num=mess.n.i.num
                  save.pos=mess.n.i.pos
                  save.sub=mess.n.i.subject
                  save.to =mess.n.i.to
                  save.from=mess.n.i.from
                  save.date=mess.n.i.date
                  mess.n.i.num=mess.n.j.num
                  mess.n.i.pos=mess.n.j.pos
                  mess.n.i.subject=mess.n.j.subject
                  mess.n.i.to=mess.n.j.to
                  mess.n.i.from=mess.n.j.from
                  mess.n.i.date=mess.n.j.date
                  mess.n.j.num=save.num
                  mess.n.j.pos=save.pos
                  mess.n.j.subject=save.sub
                  mess.n.j.to=save.to
                  mess.n.j.from=save.from
                  mess.n.j.date=save.date
                  i=i+1
                  j=j-1
               end /* do */
            if i>j then
               leave
         end /* i <= j */
         if i<right then
            do
               stackheight=stackheight+1
               lstack.stackheight=i
               rstack.stackheight=right
            end
         right=j
         if left>=right then
            leave
      end /* left < right  */
      if stackheight=0  then
         leave
   end /* stackheight <> 0 */
end /* do */
drop save.
return

WriteConfigFile:
if symbol('confer.1.num')='VAR' then
   do
      'del' cfgfile
      rc=stream(cfgfile,'c','open write')
      numconf=numconf-1
      call lineout cfgfile, 'READBBS' revision
      call lineout cfgfile, 'conferences:' numconf
      do i=1 to numconf
         call lineout cfgfile, confer.i.num confer.i.name '['confer.i.lastread']'
      end /* do */
      call lineout cfgfile,'color:'
      call lineout cfgfile,'  message' color.fore.message color.back.message
      call lineout cfgfile,'  header' color.fore.header color.back.header
      call lineout cfgfile,'  help' color.fore.help color.back.help
      call lineout cfgfile,'  menumess' color.fore.menumess color.back.menumess
      call lineout cfgfile,'  menuconf' color.fore.menuconf color.back.menuconf
      call lineout cfgfile,'  attention' color.fore.attention color.back.attention
   end
else
   say 'Could not update Config file ('cfgfile').'
return

Usage:

say 'Usage:'
say
say 'READBBS  {text filename} /I /C {config file} NOLASTREAD'
say
say '{text filename} is the "captured" text file from the BBS.'
say '/I tells READBBS to recreate the index file.  Each message file will have an'
say '    index file created for it.'
say
say '/C {config file} tells READBBS to read specified configuration file.  The'
say '    default config filename will be READBBS.CFG (if you renamed READBBS.CMD to'
say '    'something else'.CMD the default will be the 'something else'.CFG)'
say
say 'NOLASTREAD tell READBBS to disregard the last message number read and display'
say '    first message of each conference.  READBBS keeps track of the LARGEST'
say '    message number read for each conference.  If that number is between the'
say '    message numbers for the current conference, READDBBS will automatically'
say '    display the message AFTER the LASTREAD message.'
Exit


/*************************************************************************
 *
 *  SetAnsi:  Puts the ANSI escape codes and a few usefull constants
 *            in the Ansi. stem variable
 *
 ************************************************************************/
SetAnsi: PROCEDURE EXPOSE Ansi.
   escCd = '1B'x || "["

   /** Constants **/
   Ansi.esc = escCd

   /* Row and column variables */
   Ansi.rows=25; Ansi.cols=80
   Ansi.row=1;  Ansi.col=1

   /* Move charactos - Up, Down, Left, Right */
   Ansi.moveTable = "ABDC"
   Ansi.userTable = '+-<>'

   /** Escape codes : NS = Not Supported under OS/2 **/

   Ansi.cls    = escCd || "2J"  /* Clears the screen */
   Ansi.erase  = escCd || "K"   /* Erase to End-Of-Line */

   /** Screen Attributes:  Used with ScrAttr */

   /* Styles */
   Ansi.plain  = escCd || "0m"  /* All attributes off */
   Ansi.bold   = escCd || "1m"  /* Bold type */
   Ansi.faint  = escCd || "2m"  /* Faint type -NS */
   Ansi.italic = escCd || "3m"  /* Italic type */
   Ansi.blink  = escCd || "5m"  /* Blink type */
   Ansi.rblink = escCd || "6m"  /* Rapid-Blink type - NS */
   Ansi.rev    = escCd || "7m"  /* Reverse video */
   Ansi.hidden = escCd || "8m"  /* Concealed type */
   Ansi.subscr = escCd || "48m" /* Subscript */
   Ansi.supscr = escCd || "49m" /* Superscript */

   /* Colors, (b)ackground and (f)oreground */
   Ansi.fblack   = escCd || "30m"; Ansi.bblack   = escCd || "40m"
   Ansi.fred     = escCd || "31m"; Ansi.bred     = escCd || "41m"
   Ansi.fgreen   = escCd || "32m"; Ansi.bgreen   = escCd || "42m"
   Ansi.fyellow  = escCd || "33m"; Ansi.byellow  = escCd || "43m"
   Ansi.fblue    = escCd || "34m"; Ansi.bblue    = escCd || "44m"
   Ansi.fmagenta = escCd || "35m"; Ansi.bmagenta = escCd || "45m"
   Ansi.fcyan    = escCd || "36m"; Ansi.bcyan    = escCd || "46m"
   Ansi.fwhite   = escCd || "37m"; Ansi.bwhite   = escCd || "47m"

   /* Screen modes 40x25 = 40 X 25, B = Black and White.  C = Color */
   Ansi.40x25B   = escCd || "=0h"; Ansi.40x25C   = escCd || "=1h"
   Ansi.80x25B   = escCd || "=2h"; Ansi.80x25C   = escCd || "=3h"
   Ansi.320x200B = escCd || "=4h"
   Ansi.640x200B = escCd || "=5h"; Ansi.640x200C = escCd || "=6h"
   Ansi.Wrap     = escCd || "=7h"; Ansi.UnWrap   = escCd || "=7I"
RETURN


AnsiSay: PROCEDURE EXPOSE Ansi.
PARSE ARG attribs
rc = charout(, attribs)
RETURN 0