r2914: rename .cl files

[clsql.git] / db-postgresql / postgresql-usql.lisp

diff --git a/db-postgresql/postgresql-usql.lisp b/db-postgresql/postgresql-usql.lisp
new file mode 100644 (file)
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)))
+|#