X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql-socket%2Fpostgresql-socket-sql.lisp;h=352198aade2d73059e09c45ab16d6f9b16f5f57b;hb=b50166ae0ba2bc09a9094c0e675ec92010b7293e;hp=aaa5fcbfc22b7701e57ae9b2904ca8b9af78a116;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246;p=clsql.git

diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index aaa5fcb..352198a 100644
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -7,9 +7,7 @@
 ;;;; Authors:  Kevin M. Rosenberg based on original code by Pierre R. Mai
 ;;;; Created:  Feb 2002
 ;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
 ;;;;
 ;;;; CLSQL users are granted the rights to distribute and use this software
@@ -72,35 +70,17 @@
            nil)))))
 
 (defun canonicalize-type-list (types auto-list)
-  "Ensure a field type list meets expectations.
-Duplicated from clsql-uffi package so that this interface
-doesn't depend on UFFI."
-  (let ((length-types (length types))
-        (new-types '()))
+  "Ensure a field type list meets expectations.  Essentially if we get a
+   generic term for a type that our auto typer pulls a better type for,
+   use it instead"
+  (let ((length-types (length types)))
     (loop for i from 0 below (length auto-list)
-          do
-          (if (>= i length-types)
-              (push t new-types) ;; types is shorted than num-fields
-              (push
-               (case (nth i types)
-                 (:int
-                  (case (nth i auto-list)
-                    (:int32
-                     :int32)
-                    (:int64
-                     :int64)
-                    (t
-                     t)))
-                 (:double
-                  (case (nth i auto-list)
-                    (:double
-                     :double)
-                    (t
-                     t)))
-                 (t
-                  t))
-               new-types)))
-    (nreverse new-types)))
+          for auto = (nth i auto-list)
+          collect
+       (if (or (>= i length-types)
+               (member (nth i types) (list T :int :double)))
+           auto
+           (nth i types)))))
 
 
 (defun convert-to-clsql-warning (database condition)
@@ -324,19 +304,21 @@ doesn't depend on UFFI."
             (wait-for-query-results (database-connection database)))))))
 
 (defmethod database-create (connection-spec (type (eql :postgresql-socket)))
-  (destructuring-bind (host name user password) connection-spec
-    (let ((database (database-connect (list host "template1" user password)
+  (destructuring-bind (host name user password &optional port options tty) connection-spec
+    (let ((database (database-connect (list host "postgres" user password)
                                       type)))
+      (setf (slot-value database 'clsql-sys::state) :open)
       (unwind-protect
-           (execute-command (format nil "create database ~A" name))
+           (database-execute-command (format nil "create database ~A" name) database)
         (database-disconnect database)))))
 
 (defmethod database-destroy (connection-spec (type (eql :postgresql-socket)))
-  (destructuring-bind (host name user password) connection-spec
-    (let ((database (database-connect (list host "template1" user password)
+  (destructuring-bind (host name user password &optional port optional tty) connection-spec
+    (let ((database (database-connect (list host "postgres" user password)
                                       type)))
+      (setf (slot-value database 'clsql-sys::state) :open)
       (unwind-protect
-          (execute-command (format nil "drop database ~A" name))
+          (database-execute-command (format nil "drop database ~A" name) database)
         (database-disconnect database)))))