summaryrefslogtreecommitdiff
path: root/src/util.lisp
blob: c6e446c07a4c86c91b8d05486d41ea4191b2566d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-

(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 taking one argument -- the 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 acc))
      (when *debug* (format t "looking at ~A~%" c))
      (vector-push-extend c acc)
      (if storing-p
	  (if (eql c (char-code (aref end-tag match-count)))
	      (incf match-count)
	      (setf match-count 0))
	  (if (= match-count (length start-tag))
	      (if (eql c (char-code #\>)) ; looking for '>'
		  (setf storing-p t))
	      (if (eql c (char-code (aref start-tag match-count))) ; looking for start-tag
		  (incf match-count)
		  (progn
		    (setf match-count 0)
		    (setf (fill-pointer acc) 0)))))))) ; discard

(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)))

(defun iso-date (universal-time &optional (include-seconds nil))
  "Return a string denoting UNIVERSAL-TIME"
  (multiple-value-bind (second minute hour day month year)
      (decode-universal-time universal-time)
    (if include-seconds
	(format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
		year month day hour minute second)
	(format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D"
		year month day hour minute))))