;;; -*- Mode:Common-Lisp; Package:ZWEI; Base:10; Fonts:(CPTFONT HL12B HL12I MEDFNB) -*-


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1;;*
;1;; This file contains functions to read the system newsgroups (READ-SYSTEM-*
;1;; NEWSGROUPS) and newsrc newsgroups (READ-NEWSRC-NEWSGROUPS) and build the*
;1;; corresponding newsgroup data structures.  The system newsgroup information is*
;1;; gotten by issuing an NNTP LIST command and reading the output stream.  The*
;1;; newsgroup information is gotten by reading the newsrc file.*
;1;;*
;1;; SYSTEM NEWSGROUPS:*
;1;;*
;1;; A flavor instance of NEWSGROUP-COMPONENT will be created for each system*
;1;; newsgroup.  Each flavor instance will be placed into the hash table*
;1;; *NEWSGROUP-COMPONENT-TABLE* using the name of the newsgroup as the key (the*
;1;; key is a string).  Each newsgroup string is added to *system-list* in the order*
;1;; received.*
;1;;*
;1;; The format of the system newsgroup line is as follows:*
;1;;*
;1;;     <newsgroup> <high-article-number> <low-article-number> <moderated>.*
;1;;*
;1;;     Example:  foo.bar 00000 00009 m*
;1;;*
;1;; NEWSRC NEWSGROUPS:*
;1;;*
;1;; The newsgroup is looked up in the *NEWSGROUP-COMPONENT-TABLE*.  If a*
;1;; NEWSGROUP-COMPONENT flavor instance is found for this newsgroup, then the*
;1;; newsrc information is added to this instance and the newsgroup string is added*
;1;; to *NEWSRC-LIST* in the order received.*
;1;;*
;1;; Bogus newsgroups are added to *BOGUS-NEWSGROUP-LIST*.  A bogus newsgroup is*
;1;; a newsgroup found in the newsrc file but not the system newsgroup list.*
;1;;*
;1;; Currently the newsrc OPTION keyword and continuation indicator are detected but*
;1;; ignored.*
;1;;*
;1;; The format of a line of text from the newsrc file is as follows:*
;1;;*
;1;;   <newsgroup><subscribed character> <articles read>*
;1;;*
;1;;   Example:  foo.bar: 1-10,15*
;1;;*
;1;; FUNCTIONS:*
;1;;*
;1;;   READ-SYSTEM-NEWSGROUPS will process the system newsgroup information.*
;1;;   READ-NEWSRC-NEWSGROUPS will process the newsrc file newsgroup information*
;1;;                                 (must be called after READ-SYSTEM-NEWSGROUPS).*
;1;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun 4READ-SYSTEM-NEWSGROUPS* ()
  "2Read and build the system newsgroup information from the remote server.*"
  (format *query-io* "~:|Reading the system newsgroups from ~a..." *nntp-host*)
  ;1;Clear all news data structures.*
  (setf *system-list* nil)
  (setf *newsrc-list* nil)
  (setf *bogus-newsgroup-list* nil)
  (clrhash *newsgroup-component-table*)
  ;1;Send the nntp list command to the remote server and prepare a stream for reading.*
  (unless (nntp:list-command *nntp-stream*)
    (ferror 'read-system-newsgroups "Error accessing the NNTP server on ~a" *nntp-host*))
  ;1;Read the nntp stream and build the system newsgroup data structures.*
  (let (result line)
    (unless (multiple-value-setq (result line) (build-system-components *nntp-stream*))
      (ferror 'read-system-newsgroups "Error reading the system newsgroups.~%The line in question is:~%~a" line))))


(defun 4READ-NEWSRC-NEWSGROUPS* ()
  "2Read and build the newsrc newsgroup information from the newsrc file.*"
  (format *query-io* "~:|Reading the newsrc file ~a..." *user-default-newsrc-file*)
  (with-open-file (fp *user-default-newsrc-file* :direction :input :error nil)
    (cond
      ((errorp fp)
       (format *query-io* "~:|~a does not exist." *user-default-newsrc-file*))
      (t
       (let (result line)
	 (unless (multiple-value-setq (result line) (build-newsrc-components fp))
	   (ferror 'read-newsrc-newsgroups "Error reading the newsrc file ~s.~%The line in question is:~%~a"
		   (send fp :truename) line)))))))


(defun 4BUILD-SYSTEM-COMPONENTS* (nntp-stream)
  "2Build the system components from the NNTP stream.  Return T if successful.
Otherwise return NIL and the line of text in error.  The remaining output is
flushed on error.*"
  (loop with line and eof and newsgroup-component do
	(multiple-value-setq (line eof) (send nntp-stream :line-in))
	(cond
	  (eof (return t))
	  ;1;Ignore blank lines.*
	  ((zerop (length line)) t)
	  (t
	   (setf newsgroup-component (make-instance 'newsgroup-component))
	   (cond
	     ;1;Parse line.*
	     ((not (send newsgroup-component :parse-system-line line))
	      (let ((saved-line (copy line)))	;1must save line because it gets overwritten during flush.*
		(nntp:flush-nntp-stream nntp-stream)
		(return nil saved-line)))
	     ;1;No errors.  Save component.*
	     (t
	      (put-newsgroup-component newsgroup-component)
	      (setf *system-list* (append *system-list* (list newsgroup-component)))))))))


(defun 4BUILD-NEWSRC-COMPONENTS* (nntp-stream)
  "2Build the newsrc components from the newsrc file stream.  Return T if
successful.  Otherwise return NIL and line of text in error. The remaining output
is flushed on error.*"
    (loop with line and eof and result and newsgroup-string and subscribed-p and articles-read-string and
	  newsgroup-component and line-number = 0 do
      (multiple-value-setq (line eof) (send nntp-stream :line-in t))
      (incf line-number)
      (cond
	;1;End of file.*
	(eof (return t))
	;1;Continuation line (ignore).*
	((equal (aref line 0) #\space) :continuation)
	;1;Option keyword line (ignore).*
	((lisp:search *newsrc-keyword* line :start2 0 :end2 (length *newsrc-keyword*) :test #'string-equal) :option)
	;1;Otherwise, parse newsrc line.*
	(t
	 (multiple-value-setq (result newsgroup-string subscribed-p articles-read-string) (parse-newsrc-line line))
	 (cond
	   ;1;Error parsing newsrc line.  Return error.*
	   ((not result)
	    (return nil line))
	   ;1;Get newsgroup.*
	   ((not (setf newsgroup-component (get-newsgroup-component newsgroup-string)))
	    (setf *bogus-newsgroup-list* (append *bogus-newsgroup-list* (list (cons line-number line)))))
	   ;1;Add newsgroup-component to the newsrc list.*
	   ((not (add-newsgroup-component-to-newsrc-list newsgroup-component subscribed-p articles-read-string))
	    (return nil line))
	   ;1;No errors.*
	   (t
	    t))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1;;*
;1;; All items are required.  No value checking is done.  Each field can be seperated by*
;1;; one or more blanks.*
;1;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PARSE-SYSTEM-LINE (line)
  "2Parse a system newsgroup line of text. * 2Return T, the newsgroup string, the*
 2high* 2article number object,* 2the low article number object, and the moderated*
 2character. * 2Return NIL if* 2error.*"
  (let (s1 e1 s2 e2 s3 e3 s4)
    ;1;Locate the start and end position of the newsgroup.*
    (unless (and (setf s1 (position #\space line :start 0 :test-not #'string-equal))
		 (setf e1 (position #\space line :start s1 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the start and end position of the high article number.*
    (unless (and (setf s2 (position #\space line :start (1+ e1) :test-not #'string-equal))
		 (setf e2 (position #\space line :start s2 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the start and end position of the low article number.*
    (unless (and (setf s3 (position #\space line :start (1+ e2) :test-not #'string-equal))
		 (setf e3 (position #\space line :start s3 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the moderated character.*
    (unless (setf s4 (position #\space line :start (1+ e3) :test-not #'string-equal))
      (return-from parse-system-line nil))
    (values t
	    (subseq line s1 e1)
	    (read-from-string (subseq line s2 e2) nil)
	    (read-from-string (subseq line s3 e3) nil)
	    (aref line s4))))

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1;;*
;1;; The newsgroup and subscribed character is required.  The articles read is optional.*
;1;; If the articles read is not specified then "0" is used.  Blanks between the items*
;1;; are ignored.  The only value checking done is on the subscribed character.*
;1;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun 4PARSE-NEWSRC-LINE* (line)
  "2Parse a line of text from the newsrc file. * 2Return* 2T, the newsgroup,* 2the
subscribed character, and the articles read. * 2Return NIL if error.*"
  (let (s1 e1 s2 e2 s3 e3)
    ;1;Locate the start and end positions of the newsgroup.*
    (unless (setf s1 (position #\space line :start 0 :test-not #'string-equal))
      (return-from parse-newsrc-line nil))
    (unless (setf e1 (string-search-set `(,*subscribed* ,*unsubscribed*) line s1))
      (return-from parse-newsrc-line nil))
    (if (equal s1 e1)
      (return-from parse-newsrc-line nil))
    ;1;Locate the subscribed character.*
    (setf s2 e1)
    (setf e2 (1+ s2))
    ;1;Locate the start and end positions of the articles read string.*
    (setf s3 (position #\space line :start e2 :test-not #'string-equal))
    (setf e3 (position #\space line :start s3))
    (values t
	    (string-right-trim '(#\space) (subseq line s1 e1))
	    (aref line s2)
	    (if s3 (subseq line s3 e3) "0"))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1;;*
;1;; The format of the text is:  <newsgroup> <high-article-number>*
;1;; <low-article-number> <moderated character>.  All items are required.  No value*
;1;; checking is done.  Each field can be seperated by one or more blanks.*
;1;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PARSE-SYSTEM-LINE (line)
  "2Parse a line of text from the system file. * 2Return T, the newsgroup, the high*
 2article number,* 2the low article number, and the moderated field.  Return NIL if error.*"
  (let (s1 e1 s2 e2 s3 e3 s4)
    ;1;Locate the start and end position of the newsgroup.*
    (unless (and (setf s1 (position #\space line :start 0 :test-not #'string-equal))
		 (setf e1 (position #\space line :start s1 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the start and end position of the high article number.*
    (unless (and (setf s2 (position #\space line :start (1+ e1) :test-not #'string-equal))
		 (setf e2 (position #\space line :start s2 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the start and end position of the low article number.*
    (unless (and (setf s3 (position #\space line :start (1+ e2) :test-not #'string-equal))
		 (setf e3 (position #\space line :start s3 :test #'string-equal)))
      (return-from parse-system-line nil))
    ;1;Locate the moderated character.*
    (unless (setf s4 (position #\space line :start (1+ e3) :test-not #'string-equal))
      (return-from parse-system-line nil))
    (values t
	    (subseq line s1 e1)
	    (read-from-string (subseq line s2 e2) nil)
	    (read-from-string (subseq line s3 e3) nil)
	    (aref line s4))))

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1;;*
;1;; The format of the text is <newsgroup><subscribed character> <articles read>.*
;1;; <newsgroup> and <subscribed character> are required.  <articles read> is optional.*
;1;; If <articles read> is not found then "0" is used.  Blanks between the items are*
;1;; ignored.*
;1;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun 4PARSE-NEWSRC-LINE* (line)
  "2Parse a line of text from the newsrc file. * 2Return* 2T, the newsgroup,* 2the
subscribed character, and the articles read. * 2Return NIL if error.*"
  (let (s1 e1 s2 e2 s3 e3)
    ;1;Locate the start and end positions of the newsgroup.*
    (unless (setf s1 (position #\space line :start 0 :test-not #'string-equal))
      (return-from parse-newsrc-line nil))
    (unless (setf e1 (string-search-set `(,*subscribed* ,*unsubscribed*) line s1))
      (return-from parse-newsrc-line nil))
    (if (equal s1 e1)
      (return-from parse-newsrc-line nil))
    ;1;Locate the subscribed character.*
    (setf s2 e1)
    (setf e2 (1+ s2))
    ;1;Locate the start and end positions of the articles read string.*
    (setf s3 (position #\space line :start e2 :test-not #'string-equal))
    (setf e3 (position #\space line :start s3))
    (values t
	    (string-right-trim '(#\space) (subseq line s1 e1))
	    (aref line s2)
	    (if s3 (subseq line s3 e3) "0"))))