1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: postgresql-socket-usql.sql
6 ;;;; Purpose: PostgreSQL interface for USQL routines
7 ;;;; Programmers: Kevin M. Rosenberg and onShore Development Inc
8 ;;;; Date Started: Mar 2002
10 ;;;; $Id: postgresql-socket-usql.lisp 7061 2003-09-07 06:34:45Z kevin $
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
13 ;;;; and by onShore Development Inc.
15 ;;;; CLSQL users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;; *************************************************************************
20 (in-package #:clsql-postgresql-socket)
23 (defmethod database-list-objects-of-type ((database postgresql-socket-database)
26 (cond ((stringp owner)
27 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner))
29 (format nil " AND (NOT (relowner=1))"))
34 "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
39 (defmethod database-list-tables ((database postgresql-socket-database)
41 (database-list-objects-of-type database "r" owner))
43 (defmethod database-list-views ((database postgresql-socket-database)
45 (database-list-objects-of-type database "v" owner))
47 (defmethod database-list-indexes ((database postgresql-socket-database)
49 (database-list-objects-of-type database "i" owner))
51 (defmethod database-list-attributes ((table string)
52 (database postgresql-socket-database)
55 (cond ((stringp owner)
56 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
57 ((null owner) " AND (not (relowner=1))")
62 (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'~A"
63 (string-downcase table)
68 (remove-if #'(lambda (it) (member it '("cmin"
74 ;; kmr -- added tableoid
75 "tableoid") :test #'equal))
78 (defmethod database-attribute-type (attribute (table string)
79 (database postgresql-socket-database)
82 (cond ((stringp owner)
83 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
84 ((null owner) " AND (not (relowner=1))")
89 (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~A"
90 (string-downcase table)
91 (string-downcase attribute)
95 (intern (string-upcase (car result)) :keyword))))
97 (defmethod database-create-sequence (sequence-name
98 (database postgresql-socket-database))
99 (database-execute-command
100 (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name))
103 (defmethod database-drop-sequence (sequence-name
104 (database postgresql-socket-database))
105 (database-execute-command
106 (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
108 (defmethod database-list-sequences ((database postgresql-socket-database)
110 (database-list-objects-of-type database "S" owner))
112 (defmethod database-set-sequence-position (name (position integer)
113 (database postgresql-socket-database))
118 (format nil "SELECT SETVAL ('~A', ~A)" name position)
121 (defmethod database-sequence-next (sequence-name
122 (database postgresql-socket-database))
127 (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
130 (defmethod database-sequence-last (sequence-name (database postgresql-socket-database))
135 (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')")
139 ;; Functions depending upon high-level USQL classes/functions
142 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
143 (database postgresql-socket-database))
144 (with-slots (clsql-sys::modifier clsql-sys::components)
146 (if clsql-sys::modifier
148 (clsql-sys::output-sql clsql-sys::components database)
149 (write-char #\: clsql-sys::*sql-stream*)
150 (write-char #\: clsql-sys::*sql-stream*)
151 (write-string (symbol-name clsql-sys::modifier)
152 clsql-sys::*sql-stream*)))))
154 (defmethod database-output-sql-as-type ((type (eql 'integer)) val
155 (database postgresql-socket-database))
156 (when val ;; typecast it so it uses the indexes
157 (make-instance 'clsql-sys::sql-typecast-exp