1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: postgresql-usql.sql
6 ;;;; Purpose: PostgreSQL interface for USQL routines
7 ;;;; Programmers: Kevin M. Rosenberg and onShore Development Inc
8 ;;;; Date Started: Mar 2002
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)
22 (defmethod database-list-tables ((database postgresql-database)
23 &key (system-tables nil))
24 (let ((res (mapcar #'car (database-query
25 "SELECT tablename FROM pg_tables"
27 (if (not system-tables)
28 (remove-if #'(lambda (table)
29 (equal (subseq table 0 3)
35 (defmethod database-list-attributes ((table string)
36 (database postgresql-database))
41 "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
45 (remove-if #'(lambda (it) (member it '("cmin"
51 ;; kmr -- added tableoid
52 "tableoid") :test #'equal))
55 (defmethod database-attribute-type (attribute (table string)
56 (database postgresql-database))
61 "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"
65 (intern (string-upcase (car result)) :keyword) nil)))
68 (defmethod database-create-sequence (sequence-name
69 (database postgresql-database))
70 (database-execute-command
71 (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) database))
73 (defmethod database-drop-sequence (sequence-name
74 (database postgresql-database))
75 (database-execute-command
76 (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
78 (defmethod database-sequence-next (sequence-name
79 (database postgresql-database))
83 (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
86 ;; Functions depending upon high-level USQL classes/functions
89 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
90 (database postgresql-database))
91 (with-slots (clsql-sys::modifier clsql-sys::components)
93 (if clsql-sys::modifier
95 (clsql-sys::output-sql clsql-sys::components database)
96 (write-char #\: clsql-sys::*sql-stream*)
97 (write-char #\: clsql-sys::*sql-stream*)
98 (write-string (symbol-name clsql-sys::modifier)
99 clsql-sys::*sql-stream*)))))
101 (defmethod database-output-sql-as-type ((type (eql 'integer)) val
102 (database postgresql-database))
103 (when val ;; typecast it so it uses the indexes
104 (make-instance 'clsql-sys::sql-typecast-exp