home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / pc / termprog / ca28_3.zoo / bbmaint4.cmd < prev    next >
Encoding:
Text File  |  1991-05-21  |  12.6 KB  |  449 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS file maintenance script (MAIL file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT4.CMD, produces the main window for
  8. ;    Mail functions of BBMAINT, and implements its functions.  It is
  9. ;    not directly callable itself.
  10. ; -----------------------------------------------------------------------
  11. ;
  12. ;    This script is intended ONLY to be used for FCALL
  13. ;
  14.     IF NOT FCALLED
  15.        WOPEN 10,10,13,70 (cont) NOMAEsc
  16.        ATSAY 10,12 (cont) " BBS Mail "
  17.        ATSAY 11,12 (cont) " The script: "*"_SCRIPT"
  18.        ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT"
  19.        ATSAY 13,26 (cont) " Press any key to continue "
  20.        ;
  21.        ;    Wait a keypress
  22.        ;
  23.        KEYGET S0        ; Wait for any key
  24.        WCLOSE        ; Close open window
  25.        EXIT         ; Terminate right here
  26.        ENDIF
  27.     GOSUB Mailfile        ; Invoke function
  28.     FRETURN         ; Return to caller
  29. ; -----------------------------------------------------------------------
  30. ; ----- NoMail:  Inform that there's no BBS-Mail file to modify
  31. ;
  32. NoMail:
  33.     WOPEN 10,10,13,70 (cont) NOMAEsc
  34.     ATSAY 10,12 (cont) " BBS MailDir "
  35.     ATSAY 11,12 (cont) " The file: "*S24&"\BBS-Mail"
  36.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  37.     ATSAY 13,26 (cont) " Press any key to continue "
  38.     ;
  39.     ;    Wait a keypress
  40.     ;
  41.     KEYGET S0        ; Wait for any key
  42.     WCLOSE
  43. NOMAEsc:
  44.     RETURN
  45. ; -----------------------------------------------------------------------
  46. ; ----- Subroutine: MailFile -> Update Mail directory
  47. ;
  48. MailFile:
  49.     GOSUB NewMail        ; Create if not there
  50.     IF NOT ISFILE S24&"\BBS-Mail"
  51.        GOSUB NoMail     ; Inform there's no file
  52.        RETURN        ; .. so we can't continue
  53.        ENDIF
  54. ;
  55. ;    Paint a new window
  56. ;
  57.     WOPEN 0,0 23,79 (defa) Mail_Esc
  58.     ATSAY 0,2 (defa)   " BBS Mail "
  59.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  60. MAFI100:
  61.     CLEAR            ; Clear window
  62.     LOCATE 2,2
  63.  
  64.     MESS " 1) Clean up mail directory"
  65.     MESS " 2) Delete notes older than ..."
  66.     MESS "_______________________________________"
  67.     MESS " "
  68.     MESS "Select item (carriage return = previous): "
  69. ;
  70. ;    Wait for entry, and interpret
  71. ;
  72.     GET S0 1        ; Wait for it
  73.     SWITCH S0        ; Act according to keyget
  74.       CASE "1"
  75.            GOSUB ClrMail
  76.            ENDCASE
  77.       CASE "2"
  78.            GOSUB DelMail
  79.            ENDCASE
  80.       CASE "_NULL"          ; c/r alone is exit
  81.            WCLOSE        ; Close window...
  82.            RETURN        ; and return to caller
  83.            ENDCASE
  84.       DEFAULT        ; None of the above
  85.            SOUND 100,100    ; Bronx cheer
  86.            ENDCASE
  87.       ENDSWITCH
  88.     GOTO MAFI100        ; Repaint screen and ask again
  89. ;
  90. ;    End of mail procedure
  91. ;
  92. Mail_Esc:
  93.     S0 = ""                 ; Fake a null entry
  94.     RETURN            ; Leave Mail routine
  95. ; -----------------------------------------------------------------------
  96. ; ----- ClrMail:  Clear mail directory of unneeded entries
  97. ;
  98. ClrMail:
  99.     FOPENI S24&"\BBS-Mail" TEXT
  100.     IF NOT SUCCESS        ; Open failed
  101.        S0 = "Error opening: "*S24&"\BBS-Mail"
  102.        GOSUB Error        ; Report
  103.        RETURN        ; And we're done
  104.        ENDIF
  105.  
  106.     FOPENO S24&"\TempMail" TEXT
  107.     IF NOT SUCCESS        ; Open failed
  108.        S0 = "Error opening: "*S24&"\TempMail"
  109.        GOSUB Error        ; Report
  110.        RETURN        ; And we're done
  111.        ENDIF
  112. ;
  113. ;    Initialize
  114. ;
  115.     CLEAR            ; Clear window
  116.     N9 = 0            ; Count recs written
  117. ;
  118. ;    Read loop (40 chars at a time to allow PRESERVE)
  119. ;
  120. CLMA100:
  121.     READ S10 40 N0        ; Read a record
  122.     IF EOF GOTO CLMA200    ; Skip on EOF
  123.     IF STRCMP S10(0:0) "*" GOTO CLMA115 ; Copy comments
  124.     IF ZERO N0 GOTO CLMA115 ; Copy blank lines
  125. ;
  126. ;    Test for the existence of the indicated file
  127. ;
  128. CLMA110:
  129.     S0 = S24&"\"*S10(25:37) ; Make a file name
  130.     IF NOT ISFILE S0    ; Test existence
  131.        MESS S0*" does not exist - deleting record"
  132.        GOTO CLMA130     ; Remove entry
  133.        ENDIF
  134.     MESS S0*" exists - copying record"
  135. ;
  136. ;    Count the write
  137. ;
  138. CLMA115:
  139.     INC N9            ; Count recs written
  140. ;
  141. ;    Copy record just read to output file
  142. ;
  143. CLMA120:
  144.     PRESERVE S10        ; Save !'s and ^'s
  145.     WRITE S10        ; Write text
  146.  
  147.     IF N0 LT 40        ; If we wrote end of record
  148.        WRITE "!"            ; Finish w/cr/lf
  149.        GOTO CLMA100     ; And continue copying
  150.        ENDIF
  151.     READ S10 40 N0        ; Read remainder of rec
  152.     IF NOT EOF GOTO CLMA120 ; Skip if not eof
  153.     WRITE "!"               ; Finish record
  154.     GOTO CLMA200        ; End of file
  155. ;
  156. ;    Throw away the current record
  157. ;
  158. CLMA130:
  159.     IF N0 LT 40 GOTO CLMA100
  160.     READ S10 40 N0         ; Read remainder of rec
  161.     IF NOT EOF GOTO CLMA130 ; Skip if not eof
  162. ;
  163. ;    We have end-of-file
  164. ;
  165. CLMA200:
  166.     WRITE "^Z"              ; Finish ASCII file
  167.     FCLOSEO         ; Close output
  168.     FCLOSEI         ; Close input
  169.     DELETE S24&"\BBS-Mail"  ; Delete original
  170.     RENAME S24&"\TempMail" S24&"\BBS-Mail"
  171.     IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file
  172.     RETURN
  173. ; -----------------------------------------------------------------------
  174. ; ----- DelMail:  Delete mail files older than some date...
  175. ;    .. Note this only works through current and last year
  176. ;
  177. DelMail:
  178.     FOPENI S24&"\BBS-Mail" TEXT
  179.     IF NOT SUCCESS        ; Open failed
  180.        S0 = "Error opening: "*S24&"\BBS-Mail"
  181.        GOSUB Error        ; Report
  182.        RETURN        ; And we're done
  183.        ENDIF
  184.  
  185.     FOPENO S24&"\TempMail" TEXT
  186.     IF NOT SUCCESS        ; Open failed
  187.        S0 = "Error opening: "*S24&"\TempMail"
  188.        GOSUB Error        ; Report
  189.        GOTO DEMAErr     ; And we're done
  190.        ENDIF
  191.     N9 = 0            ; Counter for recs written
  192. ;
  193. ;    Initialize
  194. ;    .. (N2 = # days to keep, N3 = today's julian dayno, N4 = current yr)
  195. ;
  196.     S0 = "Enter age in days of the oldest file to keep"
  197.     GOSUB Get_Number    ; Ask for a value
  198.     IF FLAG(0) GOTO DEMAERR ; IF ESCAPE pressed...
  199.     IF N0 LE 0 N0 = 1    ; No negative dates
  200.     N2 = N0         ; Save value for later
  201.  
  202.     DATE S0 1        ; get current date (mm/dd/yyyy)
  203.     N4 = S0(6:9)        ; Save current year number
  204.     GOSUB Julian        ; make Julian date from current date
  205.     N3 = N0         ; Save current julian day number
  206.  
  207.     CLEAR            ; Clear window
  208. ;
  209. ;    Read loop (40 chars at a time to allow PRESERVE)
  210. ;
  211. DEMA100:
  212.     READ S10 40 N10     ; Read a record
  213.     IF EOF GOTO DEMA200    ; Skip on EOF
  214.     IF STRCMP S10(0:0) "*" GOTO DEMA115 ; Copy comments
  215.     IF ZERO N10 GOTO DEMA115; Copy blank lines
  216. ;
  217. ;    Test for the existence of the indicated file
  218. ;
  219. DEMA110:
  220.     S1 = S24&"\"*S10(25:37) ; Make a file name
  221.     IF NOT ISFILE S1    ; Test existence
  222.        MESS S1*" does not exist - cleaning dir"
  223.        GOTO DEMA130     ; Remove entry
  224.        ENDIF
  225. ;
  226. ;    Find the date of the file.  NOTE: The years we limit this code
  227. ;    .. to recognizing are the current and previous years.
  228. ;
  229.     FDATE S0 S1 1        ; Get the file's date into S0 (mm/dd/yyyy)
  230.     N5 = N4-S0(6:9)     ; Compute # years difference fdate and cur yr
  231.     IF N5 LT 0        ; If file year is future....
  232.        MESS S1*" date is in the future... saving(!!)"
  233.        GOTO DEMA115     ; Save the entry
  234.        ENDIF
  235.     IF N5 GT 1        ; if file older than 1 year
  236.        MESS S1*" more than a year old ... deleting"
  237.        DELETE S1        ; Delete the file...
  238.        GOTO DEMA130     ; Delete the entry
  239.        ENDIF
  240.     GOSUB Julian        ; Convert date to Julian day no
  241. ;
  242. ;    Compute the days difference and act according to user set max
  243. ;
  244.     IF N5 EQ 0        ; if file date same year as current...
  245.        N1 = N3-N0        ; Same year... N1 = age of file
  246.     ELSE            ; If file date previous year
  247.        N1 = N3-(N1-N0)    ; [Julian returns N1 = #days that year]
  248.        ENDIF
  249.     IF N1 GT N2        ; If fileage > max age
  250.        MESS S1*" is "*N1*" days old - deleting"
  251.        DELETE S1        ; Delete the file...
  252.        GOTO DEMA130     ; Delete the entry
  253.        ENDIF
  254.     MESS S1*" is "*N1*" days old - keeping"
  255. ;
  256. ;    Count the write
  257. ;
  258. DEMA115:
  259.     INC N9            ; Count recs written
  260. ;
  261. ;    Copy record just read to output file
  262. ;
  263. DEMA120:
  264.     PRESERVE S10        ; Save !'s and ^'s
  265.     WRITE S10        ; Write text
  266.  
  267.     IF N10 LT 40        ; If we wrote end of record
  268.        WRITE "!"            ; Finish w/cr/lf
  269.        GOTO DEMA100     ; And continue copying
  270.        ENDIF
  271.     READ S10 40 N10     ; Read remainder of rec
  272.     IF NOT EOF GOTO DEMA120 ; Skip if not eof
  273.     WRITE "!"               ; Finish record
  274.     GOTO DEMA200        ; End of file
  275. ;
  276. ;    Throw away the current record
  277. ;
  278. DEMA130:
  279.     IF N10 LT 40 GOTO DEMA100
  280.     READ S10 40 N10     ; Read remainder of rec
  281.     IF NOT EOF GOTO DEMA130 ; Skip if not eof
  282. ;
  283. ;    We have end-of-file
  284. ;
  285. DEMA200:
  286.     WRITE "^Z"              ; Finish ASCII file
  287.     FCLOSEO         ; Close output
  288.     FCLOSEI         ; Close input
  289.     DELETE S24&"\BBS-Mail"  ; Delete original
  290.     RENAME S24&"\TempMail" S24&"\BBS-Mail"
  291.     IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file
  292.     RETURN
  293. ;
  294. ;    Error exit
  295. ;
  296. DEMAERR:
  297.     FCLOSEO         ; Close output
  298.     FCLOSEI         ; Close input
  299.     RETURN
  300. ; -------------------------------------------------------------------------
  301. ; ----- Get_Number
  302. ;    S0 passes the prompt
  303. ;    N0 returns the value entered
  304. ;    FLAG(0) returned true indicates ESC was pressed
  305. ;
  306. Get_Number:
  307.     SET FLAG(0) OFF     ; ESCAPE flag
  308.     WOPEN 10,10,13,70 (cont) GENU_ESC
  309.     ATSAY 10,12 (cont) " Enter Value "
  310.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  311.     ATSAY 12,12 (cont) "-> "
  312.     ATSAY 13,26 (cont) " Press any key to continue "
  313.     ;
  314.     ;    Wait a keypress
  315.     ;
  316. GENU100:
  317.     LOCATE 12,15
  318.     GET S0 5        ; Wait for a number
  319.     IF NOT FLAG(0)        ; If wasn't ESCAPE
  320.        ATOI S0 N0        ; Convert w/o err msg
  321.        IF ERROR        ; If couldn't convert
  322.           SOUND 100,100    ; Bronx cheer
  323.           GOTO GENU100    ; Ask again
  324.           ENDIF
  325.        ENDIF
  326.     WCLOSE            ; Close open window
  327.     RETURN
  328.     ;
  329.     ;    Escape during GET
  330.     ;
  331. GENU_Esc:
  332.     SET FLAG(0) ON        ; Flag Escape pressed
  333.     RETURN
  334. ; -----------------------------------------------------------------------
  335. ; ----- Subroutine: NewMail -> Create a new BBS-Mail file
  336. ;
  337. NewMail:
  338.     IF ISFILE S24&"\BBS-Mail" RETURN
  339.     FOPENO S24&"\BBS-Mail" TEXT
  340.     IF NOT SUCCESS RETURN    ; Open failed
  341.     WRITE "!^Z"             ; Make it empty
  342.     FCLOSEO         ; Done with it
  343.     RETURN
  344. ;--------------------------------------------------------------------------
  345. ;------ Julian: Simple (not true) Julian date conversion
  346. ;
  347. ;    Passed: S0 contains a date formatted: mm/dd/yyyy left justified
  348. ;        as per COM-AND "DATE Sx 1" format
  349. ;    Rtnd:    N0 returns the julian date number (1-366)
  350. ;        N1 returns 365 or 366 as the total # days in the given year
  351. ;        if SUCCESS is set
  352. ;
  353. ;    NOTE: This routine is placed near beginning of file to speed access.
  354. ;    This script exceeds the 100 label limit of COM-AND's cache!
  355. ;
  356. Julian:
  357.     IF NOT (NUMERIC S0(0) and NUMERIC S0(3) and NUMERIC S0(6)) GOTO JULERR
  358.     N0 = S0(3:4)            ; Extract day number
  359.     N1 = S0(0:1)            ; Set default value to be rtnd
  360.     SWITCH N1            ; Switch on Month #
  361.        CASE 1            ; January
  362.          GOTO JUL200        ; And continue
  363.          ENDCASE
  364.        CASE 2            ; February
  365.          N0 = N0+31         ; Preceeding mo has 31 days
  366.          GOTO JUL200        ; And continue
  367.          ENDCASE
  368.        CASE 3            ; March
  369.          N0 = N0+59         ; Preceeding mo has 28 days
  370.          GOTO JUL100        ; And continue
  371.          ENDCASE
  372.        CASE 4            ; April
  373.          N0 = N0+90         ; Preceeding mo has 31 days
  374.          GOTO JUL100        ; And continue
  375.          ENDCASE
  376.        CASE 5            ; May
  377.          N0 = N0+120        ; Preceeding mo has 30 days
  378.          GOTO JUL100        ; And continue
  379.          ENDCASE
  380.        CASE 6            ; June
  381.          N0 = N0+151        ; Preceeding mo has 31 days
  382.          GOTO JUL100        ; And continue
  383.          ENDCASE
  384.        CASE 7            ; July
  385.          N0 = N0+181        ; Preceeding mo has 30 days
  386.          GOTO JUL100        ; And continue
  387.          ENDCASE
  388.        CASE 8            ; August
  389.          N0 = N0+212        ; Preceeding mo has 31 days
  390.          GOTO JUL100        ; And continue
  391.          ENDCASE
  392.        CASE 9            ; September
  393.          N0 = N0+243        ; Preceeding mo has 31 days
  394.          GOTO JUL100        ; And continue
  395.          ENDCASE
  396.        CASE 10            ; October
  397.          N0 = N0+273        ; Preceeding mo has 30 days
  398.          GOTO JUL100        ; And continue
  399.          ENDCASE
  400.        CASE 11            ; November
  401.          N0 = N0+304        ; Preceeding mo has 31 days
  402.          GOTO JUL100        ; And continue
  403.          ENDCASE
  404.        CASE 12            ; December
  405.          N0 = N0+334        ; Preceeding mo has 30 days
  406.          GOTO JUL100        ; And continue
  407.          ENDCASE
  408.        DEFAULT            ; Month not 1-12
  409.          GOTO JULERR        ; And continue
  410.          ENDCASE
  411.        ENDSWITCH
  412. ;
  413. ;    Month is after February - handle leap year
  414. ;    .. leap year is divisible by 4 but not by 400
  415. ;
  416. JUL100:
  417.     IF (NOT ZERO (S0(6:9)\4)) or ZERO (S0(6:9)\400) GOTO JUL200
  418.     INC N0                ; Add a day for leap year
  419.     N1 = 366            ; Set value to be rtnd (total # days)
  420. ;
  421. ;    Return with a number 1-366 in N0
  422. ;
  423. JUL200:
  424.     IF N1 LT 366 N1 = 365        ; Total # days
  425.     SET SUCCESS ON            ; Indicate success
  426.     RETURN
  427. ;
  428. ;    Error in passed date
  429. ;
  430. JULERR:
  431.     SET SUCCESS OFF         ; Indicate FAILURE
  432.     RETURN
  433. ; -----------------------------------------------------------------------
  434. ; ----- Error:    Open a window, display a message, and wait for keypress
  435. ;    S0 passes the error message
  436. ;
  437. Error:
  438.     WOPEN 10,10,12,70 (cont) Err_Esc
  439.     ATSAY 10,12 (cont) " Error "
  440.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  441.     ATSAY 12,26 (cont) " Press any key to continue "
  442.     ;
  443.     ;    Wait a keypress
  444.     ;
  445.     KEYGET S0        ; Wait for any key
  446.     WCLOSE
  447. Err_Esc:
  448.     RETURN
  449.