[pg-cvs] CVS update: pg/parsers.lisp

[Peter Van Eynde]

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