home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / amigalibdisks / disk949 / bbbbs / bbbbs65.lha / rexx / bbsQUICKOUT.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-09-30  |  12.8 KB  |  514 lines
  1. /* $VER: bbsQUICKOUT.rexx 6.4 © 1993 Richard Lee Stockton (29.9.93) 
  2.       copyright 1993 Richard Lee Stockton and Gramma Software
  3.       - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -
  4.  
  5.  Gathers and archives all NEW mail, messages, and file descriptions
  6.       into an emailfile called QUICK_n.lha for later download.
  7. */
  8.  
  9. CR='0D'x
  10. LF='0A'x
  11.  
  12. SIGNAL ON ERROR
  13. SIGNAL ON SYNTAX
  14. SIGNAL ON FAILURE
  15. OPTIONS FAILAT 666
  16.  
  17. PARSE ARG name level lastbrowse sincedate excludelist 
  18.  
  19. figarg='s:CONFIG.BBS'
  20. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  21. x=OPEN(f,figarg,'R')
  22. IF x=0 THEN
  23.   DO
  24.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  25.     CALL GETOUT(20)
  26.   END
  27.  
  28. lynes.=''
  29. DO i=1 TO 8
  30.   lynes.i=READLN(f)
  31. END
  32. CALL CLOSE(f)
  33.  
  34. compos=POS('/*',lynes.1)
  35. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  36. bbsname=STRIP(lynes.1)
  37. sysop=WORD(lynes.2,1)
  38. sysoplevel=WORD(lynes.5,1)
  39. bbspath=WORD(lynes.6,1)
  40. IF name='' THEN name=sysop
  41.  
  42. /* wait up to 5 minutes for QUICKIN to finish processing */
  43.  
  44. DO i=1 TO 100 WHILE GETCLIP('BBS_'name)='QUICKIN'
  45.   CALL DELAY(150)
  46. END
  47.  
  48. /* Should only be one QUICKOUT process at a time per user */
  49.  
  50. IF GETCLIP('BBS_'name)='QUICK' THEN EXIT
  51.  
  52. CALL CLOSE(STDOUT)
  53. CALL OPEN(STDOUT,'RAM:QUICKOUT.STDOUT','W')
  54. SAY STRIP(SUBSTR(SOURCELINE(1),10))
  55. SAY
  56. CALL PRAGMA('P',-1)
  57. CALL TIME('R')
  58. CALL SETCLIP('BBS_'name,'QUICK')
  59. DO i=1
  60.   IF GETCLIP('BBS_QUICKOUT'i)='' THEN  /* info clip for external STOP */
  61.     DO
  62.       CALL SETCLIP('BBS_QUICKOUT'i,name)
  63.       clipnum=i
  64.       LEAVE i
  65.     END
  66. END
  67. CALL MAKEDIR(bbspath'EmailFiles/'name)
  68. IF level='' THEN
  69.   DO
  70.     level=99
  71.     x=OPEN(f,bbspath'Users/'name,'R')
  72.     IF x=0 THEN EXIT 22
  73.     data.=''
  74.     DO i=1
  75.       line=READLN(f)
  76.       IF EOF(f) THEN LEAVE i
  77.       data.i=line
  78.     END
  79.     data.0=i-1
  80.     CALL CLOSE(f)
  81.     city=docity(data.3)
  82.     data.13=DATE('S')'  'TIME('C')
  83.     lastbrowse=WORD(data.16,1)
  84.     sincedate=WORD(data.16,2)
  85.     IF FIND(noquick,'FILELIST')=0 THEN
  86.       data.16=countcheck('LastFile') DATE('S') TIME()
  87.     excludelist=data.21
  88.     IF FIND(noquick,'MESSAGES')=0 THEN
  89.       DO
  90.         CALL SETCLIP('BBS_'name'_22',data.22)
  91.         temp=''
  92.         DO i=1 TO level
  93.           IF WORD(data.22,i)=-1 THEN temp=STRIP(temp -1)
  94.           ELSE temp=STRIP(temp countcheck('LastMessage'i))
  95.         END
  96.         data.22=temp
  97.       END
  98.     noquick=UPPER(data.26)
  99.     x=OPEN(f,bbspath'Users/'name,'W')
  100.     IF x~=0 THEN
  101.       DO i=1 TO data.0
  102.         CALL WRITELN(f,data.i)
  103.       END
  104.     CALL CLOSE(f)
  105.   END
  106. ELSE
  107.   DO
  108.     city=GETCLIP('BBS_city')
  109.     CALL SETCLIP('BBS_city')
  110.     noquick=UPPER(GETCLIP('BBS_'name'_26'))
  111.     CALL SETCLIP('BBS_'name'_26')
  112.   END
  113.  
  114. IF ~EXISTS(bbspath'Users/'name) THEN CALL GETOUT(21)
  115. CALL check_abort()
  116.  
  117. IF FIND(noquick,'MESSAGES')=0 THEN CALL ArcMsgs.rexx(name)
  118. CALL check_abort()
  119.  
  120. x=OPEN(f,bbspath'Numbers/LastMail','R')
  121. IF x=0 THEN CALL GETOUT(27)
  122. lastm=READLN(f)+1
  123. CALL CLOSE(f)
  124. ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
  125.  
  126.  
  127. /* add Messages, Libraries, and Conferences to archive */
  128.  
  129. frn=bbspath'Friends/'name
  130. IF EXISTS(frn) THEN
  131.   ADDRESS COMMAND 'c:copy' frn bbspath'EmailFiles/'name'/Friends'
  132.  
  133. CALL PRAGMA('D',bbspath'EmailFiles/'name)
  134. nlist=''
  135. IF EXISTS('Conferences') THEN nlist='Conferences'
  136. IF EXISTS('Libraries') THEN nlist=STRIP(nlist 'Libraries')
  137. IF EXISTS('Friends') THEN nlist=STRIP(nlist 'Friends')
  138. IF EXISTS('Marked') THEN nlist=STRIP(nlist 'Marked')
  139. CALL strip_ansi(bbspath'EmailFiles/'name nlist)
  140. IF EXISTS('Messages') THEN nlist=STRIP(nlist 'Messages')
  141. comm='CD' bbspath'EmailFiles/'name LF 'lha -2amN m'
  142. comm=comm 'QUICK_'lastm'.lha'
  143. SAY comm
  144. SAY nlist
  145. ADDRESS COMMAND comm nlist
  146. CALL check_abort()
  147.  
  148.  
  149. /* gather and archive email and emailfiles */
  150.  
  151. mailfiles=''
  152. email=SHOWDIR(bbspath'Email/'name)
  153. DO i=1 TO WORDS(email)
  154.   x=OPEN(f,bbspath'Email/'name'/'WORD(email,i),'R')
  155.   IF x=0 THEN ITERATE i
  156.   line=READLN(f)
  157.   CALL CLOSE(f)
  158.   file=WORD(line,4)
  159.   IF file='' | ~EXISTS(bbspath'EmailFiles/'name'/'file) THEN ITERATE i
  160.   IF LEFT(UPPER(file),6)='QUICK_' THEN ITERATE i
  161.   IF WORD(STATEF(bbspath'EmailFiles/'name'/'file),2)>0 THEN
  162.     DO
  163.       mailfiles=STRIP(mailfiles 'EmailFiles/'name'/'file)
  164.       xdl=bbspath'EmailFiles/'name'/'file'.xdl'
  165.       IF EXISTS(xdl) THEN
  166.         CALL RENAME(xdl,bbspath'EmailFiles/'name'/QUICK_'lastm'.lha.xdl')
  167.     END
  168. END
  169.  
  170. CALL check_abort()
  171. IF mailfiles~='' THEN
  172.   DO
  173.     comm='CD' bbspath LF 'lha -2axmN m'
  174.     comm=comm 'EmailFiles/'name'/QUICK_'lastm'.lha' mailfiles
  175.     SAY comm
  176.     ADDRESS COMMAND comm
  177.   END
  178. SAY
  179.  
  180. CALL check_abort()
  181. IF email~='' THEN
  182.   DO
  183.     CALL strip_ansi(bbspath'Email/'name email)
  184.     comm='CD' bbspath LF 'lha -2axmN m'
  185.     comm=comm 'EmailFiles/'name'/QUICK_'lastm'.lha Email/'name'/#?'
  186.     SAY comm
  187.     ADDRESS COMMAND comm
  188.   END
  189. SAY
  190.  
  191.  
  192. /* Gather WELCOME(s), UNTIL(s), GOODBYE and all
  193.    new Information files into "Notices" drawer */
  194.  
  195. CALL check_abort()
  196. CALL MAKEDIR(bbspath'EmailFiles/'name'/Notices')
  197.  
  198. ulist=''
  199. IF FIND(noquick,'HELLO')=0 & EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  200.   ulist='HELLO'
  201. IF FIND(noquick,'WELCOME')=0 & EXISTS(bbspath'BBS_TEXT/WELCOME') THEN
  202.   ulist=STRIP(ulist 'WELCOME')
  203. arg='WELCOME.'RIGHT(DATE('S'),4)
  204. IF EXISTS(bbspath'BBS_TEXT/'arg) THEN ulist=STRIP(ulist arg)
  205. arg='WELCOME.'LEFT(DATE('W'),3)
  206. IF EXISTS(bbspath'BBS_TEXT/'arg) THEN ulist=STRIP(ulist arg)
  207. IF FIND(noquick,'GOODBYE')=0 & EXISTS(bbspath'BBS_TEXT/GOODBYE') THEN
  208.   ulist=STRIP(ulist 'GOODBYE')
  209. untils.=''
  210. IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
  211.   DO
  212.     DO ui=1 TO untils.0
  213.       IF RIGHT(untils.ui,8)<DATE('S') THEN ITERATE ui
  214.       ELSE ulist=STRIP(ulist untils.ui)
  215.     END
  216.   END
  217. DROP untils.
  218.  
  219. CALL check_abort()
  220. DO i=1 TO WORDS(ulist)
  221.   comm='CD' bbspath'BBS_TEXT'LF'copy'
  222.   comm=comm WORD(ulist,i) bbspath'EmailFiles/'name'/Notices'
  223.   ADDRESS COMMAND comm
  224. END
  225.  
  226. CALL check_abort()
  227. ulist=''
  228. dm=DATE(,sincedate,'S')
  229. PARSE VAR dm da' 'mo' 'yr .
  230. yr=RIGHT(yr,2)
  231. sincedate=da'-'mo'-'yr
  232. arg=bbspath'Information'
  233. ADDRESS COMMAND 'C:LIST >ram:infolist' arg 'NOHEAD DATES SINCE' sincedate
  234. IF WORD(STATEF('ram:infolist'),2)>3 THEN
  235.   DO
  236.     x=OPEN(f,'ram:infolist','R')
  237.     IF x=0 THEN SAY 'ram:infolist failed to open for reading!'
  238.     ELSE
  239.       DO i=1
  240.         line=READLN(f)
  241.         IF EOF(f) THEN LEAVE i
  242.         IF LEFT(line,1)=':' THEN ITERATE i
  243.         fyle=WORD(line,1)
  244.         IF FIND(noquick,UPPER(fyle))>0 THEN ITERATE i
  245.         ulist=STRIP(ulist fyle)
  246.         readcount=STATEF(bbspath'Information/'fyle)
  247.         readcount=WORD(readcount,8)
  248.         IF ~DATATYPE(readcount,'W') THEN readcount=0
  249.         ADDRESS COMMAND 'C:filenote' bbspath'Information/'fyle readcount+1
  250.       END
  251.     CALL CLOSE(f)
  252.   END
  253.  
  254. CALL check_abort()
  255. DO i=1 TO WORDS(ulist)
  256.   comm='CD' bbspath'Information'LF'copy'
  257.   comm=comm WORD(ulist,i) bbspath'EmailFiles/'name'/Notices'
  258.   ADDRESS COMMAND comm
  259. END
  260.  
  261. CALL check_abort()
  262. IF FIND(noquick,'STATS.BBS')=0 THEN CALL bbsSTATS.rexx(name 0)
  263. IF FIND(noquick,'HOURLY')=0 THEN CALL ShowHourly.rexx(name 99 0)
  264.  
  265. CALL check_abort()
  266. IF level>=sysoplevel THEN
  267.   DO
  268.     ADDRESS COMMAND 'info >'bbspath'EmailFiles/'name'/Notices/Info_Devs'
  269.     ADDRESS COMMAND 'rxset >'bbspath'EmailFiles/'name'/Notices/Info_Clips'
  270.     ADDRESS COMMAND 'avail >'bbspath'EmailFiles/'name'/Notices/Info_Memory'
  271.     temp=bbspath'Lists/NEW_USERS'
  272.     IF EXISTS(temp) THEN
  273.       ADDRESS COMMAND 'copy' temp bbspath'EmailFiles/'name'/Notices'
  274.     temp=bbspath'Lists/CBV_USERS'
  275.     IF EXISTS(temp) THEN
  276.       ADDRESS COMMAND 'copy' temp bbspath'EmailFiles/'name'/Notices'
  277.   END
  278.  
  279. CALL check_abort()
  280. IF WORDS(bbspath'EmailFiles/'name'/Notices')>0 THEN
  281.   DO
  282.     temp=bbspath'EmailFiles/'name'/Notices'
  283.     CALL strip_ansi(temp SHOWDIR(temp))
  284.     comm='CD' bbspath'EmailFiles/'name||LF'lha -2axmN m'
  285.     comm=comm bbspath'EmailFiles/'name'/QUICK_'lastm'.lha Notices/#?'
  286.     SAY comm
  287.     ADDRESS COMMAND comm
  288.   END
  289.  
  290.  
  291. /* archive NEW file descriptions by date */
  292.  
  293. CALL check_abort()
  294. IF FIND(noquick,'FILELIST')=0 THEN
  295.   DO
  296.     x=OPEN(f,bbspath'Lists/Libraries','R')
  297.     IF x=0 THEN
  298.       DO
  299.         SAY 'Libraries list did not open!'
  300.         CALL GETOUT(26)
  301.       END
  302.     libs.=''
  303.     liblist=''
  304.     DO i=1
  305.       line=READLN(f)
  306.       IF EOF(f) | line='END' THEN LEAVE i
  307.       num=WORD(line,1)
  308.       lib=WORD(line,2)
  309.       IF DATATYPE(num,'N') THEN
  310.         DO
  311.           num=num%1
  312.           IF num>0 & num<=level THEN
  313.             DO
  314.               IF FIND(UPPER(excludelist),UPPER(lib))=0 THEN
  315.                 liblist=STRIP(liblist lib)
  316.             END
  317.         END
  318.     END
  319.     CALL CLOSE(f)
  320.     CALL ArcBrowse.rexx(name lastbrowse 'D A' liblist)
  321.   END
  322.  
  323.  
  324. /* Make an ID file for the archive(s) */
  325.  
  326. x=OPEN(f,bbspath'EmailFiles/'name'/.ID','W')
  327. IF x=0 THEN CALL GETOUT(22)
  328. CALL WRITELN(f,' USER:' name)
  329. CALL WRITELN(f,' CITY:' city)
  330. CALL WRITELN(f,'  BBS:' bbsname)
  331. CALL WRITELN(f,'SYSOP:' sysop)
  332. CALL WRITELN(f,' DATE:' TIME('C') DATE())
  333. CALL WRITELN(f,' KEYS:' lastm level sysoplevel TIME('E'))
  334. CALL WRITELN(f,'')
  335. CALL CLOSE(f)
  336.  
  337.  
  338. /* add FileList to archive */
  339.  
  340. CALL check_abort()
  341. IF EXISTS('FileList') THEN
  342.   DO
  343.     comm='CD' bbspath'EmailFiles/'name LF 'lha -2amN m'
  344.     comm=comm 'QUICK_'lastm'.lha FileList'
  345.     SAY comm
  346.     ADDRESS COMMAND comm
  347.   END
  348. ELSE IF EXISTS('File1') THEN
  349.   DO i=1 WHILE EXISTS('File'i)
  350.     comm='CD' bbspath'EmailFiles/'name LF 'lha -2amN m'
  351.     comm=comm 'QUICK_'lastm'-'i'.lha File'i
  352.     SAY comm
  353.     ADDRESS COMMAND comm
  354.     comm='CD' bbspath'EmailFiles/'name LF 'lha -2amN a'
  355.     comm=comm 'QUICK_'lastm'-'i'.lha .ID'
  356.     SAY comm
  357.     ADDRESS COMMAND comm
  358.   END
  359.  
  360. x=OPEN(f,bbspath'EmailFiles/'name'/.ID','W')
  361. IF x=0 THEN CALL GETOUT(22)
  362. CALL WRITELN(f,' USER:' name)
  363. CALL WRITELN(f,' CITY:' city)
  364. CALL WRITELN(f,'  BBS:' bbsname)
  365. CALL WRITELN(f,'SYSOP:' sysop)
  366. CALL WRITELN(f,' DATE:' TIME('C') DATE())
  367. CALL WRITELN(f,' KEYS:' lastm level sysoplevel TIME('E'))
  368. CALL WRITELN(f,'')
  369. CALL CLOSE(f)
  370.  
  371. comm='CD' bbspath'EmailFiles/'name LF 'lha -2amN m'
  372. comm=comm 'QUICK_'lastm'.lha .ID'
  373. SAY comm
  374. ADDRESS COMMAND comm
  375. CALL check_abort()
  376.  
  377.  
  378. /* If user is still online, write email and signal */
  379.  
  380. IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
  381.   DO
  382.     x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
  383.     IF x=0 THEN CALL GETOUT(26)
  384.     CALL WRITELN(f,' Mail: 'lastm'   FILE: QUICK_'lastm'.lha')
  385.     CALL WRITELN(f,' From: BBBBS')
  386.     CALL WRITELN(f,'   To: 'name)
  387.     CALL WRITELN(f,' Subj: BBS activity since your last call.')
  388.     CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
  389.     CALL WRITELN(f,LEFT('=',75,'='))
  390.     CALL WRITELN(f,'Here is the QUICK archive you requested.')
  391.     CALL CLOSE(f)
  392.     oldmess=GETCLIP('BBS_MESSAGE')
  393.     IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
  394.     newmess='Your QUICK archive is waiting in Email.'
  395.     CALL SETCLIP('BBS_MESSAGE',oldmess||newmess)
  396.   END
  397. SAY 'QUICKOUT archive for' name 'sucessfully completed at' TIME('C')
  398. temp=''
  399. secs=TIME('E')
  400. mins=secs%60
  401. hrs=mins%60
  402. secs=secs//60
  403. mins=mins//60
  404. IF hrs=1 THEN temp='1 hour'
  405. ELSE IF hrs>0 THEN temp=hrs 'hours'
  406. IF mins=1 THEN temp=temp '1 minute'
  407. ELSE IF mins>0 THEN temp=temp mins 'minutes'
  408. IF secs=1 THEN temp=temp '1 second'
  409. ELSE IF secs>0 THEN temp=temp secs 'seconds'
  410. temp=temp 'to process this file'
  411. SAY ' -' temp '-'
  412. SAY
  413. CALL GETOUT(0)
  414. EXIT
  415.  
  416.  
  417. GETOUT:
  418. ARG err 
  419. IF err>0 THEN SAY 'Error:' err'  'ERRORTEXT(RC) 'RC='RC'  LINE#='SIGL
  420. ERROR:
  421. SYNTAX:
  422. FAILURE:
  423. IF RC>0 THEN SAY 'RC='RC'  SIGL='SIGL
  424. IF GETCLIP('BBS_'name)='QUICK' THEN CALL SETCLIP('BBS_'name)
  425. CALL SETCLIP('BBS_QUICKOUT'clipnum)
  426. CALL DELETE(bbspath'EmailFiles/'name'/Notices')
  427. EXIT err
  428.  
  429.  
  430. check_abort:
  431. t=GETCLIP('BBS_STOP_QUICKOUT'clipnum)
  432. IF t='' THEN RETURN
  433. CALL SETCLIP('BBS_STOP_QUICKOUT'clipnum)
  434. SAY 'Aborted at' TIME('C')
  435. IF t='DELETE' THEN
  436.   DO
  437.     CALL DELETE(bbspath'EmailFiles/'name'/QUICK_'lastm'.lha')
  438.     ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/Notices ALL'
  439.   END
  440. CALL GETOUT(0)
  441. RETURN
  442.  
  443.  
  444. strip_ansi:
  445. PARSE ARG path tlist 
  446. IF tlist='' THEN RETURN
  447. olddir=PRAGMA('D',path)
  448. DO j=1 TO WORDS(tlist)
  449.   data.=''
  450.   changed=0
  451.   x=OPEN(f,WORD(tlist,j),'R')
  452.   IF x=0 THEN
  453.     DO
  454.       SAY WORD(tlist,j) 'failed to open to read!'
  455.       ITERATE j
  456.     END
  457.   DO i=1
  458.     line=READLN(f)
  459.     IF EOF(f) THEN LEAVE i
  460.     n=POS('1B'x,line)
  461.     DO WHILE n>0
  462.       DO k=2
  463.         IF DATATYPE(SUBSTR(line,n+k,1),M) | (n+k+1)>LENGTH(line) THEN
  464.           leave k
  465.       END
  466.       line=DELSTR(line,n,k+1)
  467.       n=POS('1B'x,line)
  468.       changed=1
  469.     END
  470.     data.i=line
  471.   END
  472.   data.0=i-1
  473.   CALL CLOSE(f)
  474.   IF changed=0 THEN ITERATE j
  475.   CALL DELAY(50)
  476.   x=OPEN(f,WORD(tlist,j),'W')
  477.   IF x=0 THEN
  478.     DO
  479.       SAY WORD(tlist,j) 'failed to open to write!'
  480.       ITERATE j
  481.     END
  482.   DO i=1 TO data.0
  483.     CALL WRITELN(f,data.i)
  484.   END
  485.   CALL CLOSE(f)
  486. END
  487. CALL PRAGMA('D',olddir)
  488. RETURN
  489.  
  490.  
  491. docity:
  492. PARSE ARG citi
  493. citi=TRANSLATE(citi,'          ','+-.,*/()<>')
  494. DO i=WORDS(citi) TO 1 BY -1
  495.   IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  496.   IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
  497. END
  498. citi=SPACE(citi,1)
  499. RETURN STRIP(citi)
  500.  
  501.  
  502. countcheck:
  503. PARSE ARG filename
  504. IF filename='' THEN RETURN 0
  505. filename=bbspath'Numbers/'filename
  506. x=OPEN(f,filename,'R')
  507. IF x=0 THEN RETURN 0
  508. cc=READLN(f)
  509. CALL CLOSE(f)
  510. RETURN cc
  511.  
  512.  
  513. /* bbsQUICKOUT.rexx */
  514.