1 files changed, 59 insertions, 0 deletions
diff --git a/src/util.lisp b/src/util.lisp
new file mode 100644
index 0000000..08f9936
--- /dev/null
+++ b/src/util.lisp
@@ -0,0 +1,59 @@
+(defparameter *debug* nil)
+
+(defun next-xml-blurb (reader tag)
+  "Return the next XML document in a stream that is enclosed in a given XML tag.
+
+READER is a function that takes one argument -- number of bytes to
+read -- and returns that many octets or nil on read error or end of
+stream.
+
+TAG is a string.
+
+BUGS:
+- Case sensitive matching of tag.
+- Opening tag must contain attributes (or at least a space after the tag).
+"
+  (let ((start-tag (format nil "<~A " tag))
+	(end-tag (format nil "</~A>" tag))
+	(storing-p nil)
+	(match-count 0)
+	(acc (make-array 2048 :fill-pointer 0 :adjustable t)))
+    (when *debug* (format t "start-tag ~A~%, end-tag ~A~%" start-tag end-tag))
+    (do ((c (funcall reader 1) (funcall reader 1)))
+	((or (null c) (and storing-p (= match-count (length end-tag))))
+	 (if (null c)
+	     nil
+	     (subseq acc 0 (- (length acc) (length end-tag)))))
+      (when *debug* (format t "looking at ~A~%" c))
+      (if storing-p
+	  (progn
+	    (when *debug* (format t "pushing it~%"))
+	    (vector-push-extend c acc)
+	    (if (eql c (char-code (aref end-tag match-count)))
+		(incf match-count)
+		(setf match-count 0))
+	    (when *debug* (format t "match-count ~A~%" match-count)))
+	  (if (= match-count (length start-tag))
+	      (if (eql c (char-code #\>)) ; looking for '>'
+		  (setf storing-p t))
+	      (progn
+		(when (and *debug* nil)
+		  (format t "XXX ~A ~A " (aref start-tag match-count)
+			  (eql c (char-code (aref start-tag match-count)))))
+		(if (eql c (char-code (aref start-tag match-count))) ; looking for start-tag
+		    (incf match-count)
+		    (setf match-count 0))
+		(when *debug* (format t "match-count ~A~%" match-count))))))))
+		
+
+(let ((sock nil))
+  (defun new-reader (host port)
+    (when sock (close-reader))
+    (setf sock (usocket:socket-connect host
+				       port
+				       :element-type '(unsigned-byte 8)))
+    (lambda (n)
+      (assert (= n 1))
+      (read-byte (usocket:socket-stream sock) nil)))
+  (defun close-reader ()
+    (usocket:socket-close sock)))