Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv12704
Modified Files: parsers.lisp Log Message: added type-to-oid table and lookup-type function to aid in bpe operations Date: Mon Mar 8 09:37:37 2004 Author: pvaneynde
Index: pg/parsers.lisp diff -u pg/parsers.lisp:1.1 pg/parsers.lisp:1.2 --- pg/parsers.lisp:1.1 Fri Mar 5 13:08:08 2004 +++ pg/parsers.lisp Mon Mar 8 09:37:36 2004 @@ -59,7 +59,10 @@ (defvar *parsers* '())
- +(defvar *type-to-oid* + (make-hash-table :test #'eq) + "Is a hashtable for turning a typename into a OID. +Needed to define the type of objects in pg-prepare")
(defvar *type-parsers* `(("bool" . ,'bool-parser) @@ -96,6 +99,8 @@
;; FIXME switch to a specialized float parser (defun float-parser (str) + (declare (type simple-string str)) + (let ((*read-eval* nil)) (read-from-string str)))
@@ -103,12 +108,14 @@ (defun text-parser (str) str)
(defun bool-parser (str) + (declare (type simple-string str)) (cond ((string= "t" str) t) ((string= "f" str) nil) (t (error 'protocol-error :reason "Badly formed boolean from backend: ~s" str))))
(defun parse-timestamp (str) + (declare (type simple-string str)) (let* ((year (parse-integer (subseq str 0 4))) (month (parse-integer (subseq str 5 7))) (day (parse-integer (subseq str 8 10))) @@ -172,8 +179,8 @@ ;; which we convert to a CL universal time (defun date-parser (str) (let ((year (parse-integer (subseq str 0 4))) - (month (parse-integer (subseq str 5 7))) - (day (parse-integer (subseq str 8 10)))) + (month (parse-integer (subseq str 5 7))) + (day (parse-integer (subseq str 8 10)))) (encode-universal-time 0 0 0 day month year)))
(defun initialize-parsers (connection) @@ -185,14 +192,33 @@ (let* ((typname (first tuple)) (oid (parse-integer (second tuple))) (type (assoc typname *type-parsers* :test #'string=))) - (if (consp type) - (push (cons oid (cdr type)) *parsers*)))) + (cond + ((consp type) + (setf (gethash (intern typname :keyword) *type-to-oid*) + oid) + (push (cons oid (cdr type)) *parsers*)) + (t + #+debug + (warn "Unknown postgresSQL type found: '~A' oid: '~A'" + typname + oid))))) tuples)))
(defun parse (str oid) + (declare (type simple-string str)) (let ((parser (assoc oid *parsers* :test #'eql))) (if (consp parser) (funcall (cdr parser) str) str))) + +(defun lookup-type (type) + "Given the name of a type, returns the oid of the type or NIL if +not found" + (let ((type (etypecase type + (symbol + type) + (string + (intern type :keyword))))) + (gethash type *type-to-oid*)))
;; EOF