X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql%2Fpostgresql-usql.lisp;fp=db-postgresql%2Fpostgresql-usql.lisp;h=bdf69388523679c8c21d58d2122c363beead0efa;hb=7d50938ba2db52a713498e49aa1679deae6f0b6b;hp=0000000000000000000000000000000000000000;hpb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;p=clsql.git

diff --git a/db-postgresql/postgresql-usql.lisp b/db-postgresql/postgresql-usql.lisp
new file mode 100644
index 0000000..bdf6938
--- /dev/null
+++ b/db-postgresql/postgresql-usql.lisp
@@ -0,0 +1,108 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          postgresql-usql.sql
+;;;; Purpose:       PostgreSQL interface for USQL routines
+;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
+;;;; Date Started:  Mar 2002
+;;;;
+;;;; $Id: postgresql-usql.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
+;;;;
+;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and by onShore Development Inc.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :clsql-postgresql)
+
+(defmethod database-list-tables ((database postgresql-database)
+                                 &key (system-tables nil))
+  (let ((res (mapcar #'car (database-query
+			    "SELECT tablename FROM pg_tables"
+			    database nil))))
+    (if (not system-tables)
+        (remove-if #'(lambda (table)
+                       (equal (subseq table 0 3)
+                              "pg_")) res)
+      res)))
+
+
+
+(defmethod database-list-attributes ((table string)
+				     (database postgresql-database))
+  (let* ((result
+	  (mapcar #'car
+		  (database-query
+		   (format nil
+			   "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
+		   database nil))))
+    (if result
+	(reverse
+         (remove-if #'(lambda (it) (member it '("cmin"
+                                                "cmax"
+                                                "xmax"
+                                                "xmin"
+						"oid"
+                                                "ctid"
+						;; kmr -- added tableoid
+						"tableoid") :test #'equal)) 
+		    result)))))
+
+(defmethod database-attribute-type (attribute (table string)
+				    (database postgresql-database))
+  (let ((result
+	  (mapcar #'car
+		  (database-query
+		   (format nil
+			   "SELECT pg_type.typname FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid"
+			   table attribute)
+		   database nil))))
+    (if result
+	(intern (string-upcase (car result)) :keyword) nil)))
+
+
+(defmethod database-create-sequence (sequence-name
+				     (database postgresql-database))
+  (database-execute-command
+   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) database))
+
+(defmethod database-drop-sequence (sequence-name
+				   (database postgresql-database))
+  (database-execute-command
+   (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
+
+(defmethod database-sequence-next (sequence-name 
+				   (database postgresql-database))
+  (parse-integer
+   (caar
+    (database-query
+     (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
+     database nil))))
+
+;; Functions depending upon high-level USQL classes/functions
+
+#|
+(defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp) 
+				(database postgresql-database))
+  (with-slots (clsql-sys::modifier clsql-sys::components)
+    expr
+    (if clsql-sys::modifier
+        (progn
+          (clsql-sys::output-sql clsql-sys::components database)
+          (write-char #\: clsql-sys::*sql-stream*)
+          (write-char #\: clsql-sys::*sql-stream*)
+          (write-string (symbol-name clsql-sys::modifier) 
+			clsql-sys::*sql-stream*)))))
+
+(defmethod database-output-sql-as-type ((type (eql 'integer)) val
+					(database postgresql-database))
+  (when val   ;; typecast it so it uses the indexes
+    (make-instance 'clsql-sys::sql-typecast-exp
+                   :modifier 'int8
+                   :components val)))
+|#