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
10 ;;;; $Id: postgresql-usql.cl,v 1.1 2002/08/01 03:06:26 kevin Exp $
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 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
21 (in-package :clsql-postgresql)
23 (defmethod database-list-tables ((database postgresql-database)
24 &key (system-tables nil))
25 (let ((res (mapcar #'car (database-query
26 "SELECT tablename FROM pg_tables"
28 (if (not system-tables)
29 (remove-if #'(lambda (table)
30 (equal (subseq table 0 3)
36 (defmethod database-list-attributes ((table string)
37 (database postgresql-database))
42 "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
46 (remove-if #'(lambda (it) (member it '("cmin"
52 ;; kmr -- added tableoid
53 "tableoid") :test #'equal))
56 (defmethod database-attribute-type (attribute (table string)
57 (database postgresql-database))
62 "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"
66 (intern (string-upcase (car result)) :keyword) nil)))
69 (defmethod database-create-sequence (sequence-name
70 (database postgresql-database))
71 (database-execute-command
72 (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) database))
74 (defmethod database-drop-sequence (sequence-name
75 (database postgresql-database))
76 (database-execute-command
77 (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
79 (defmethod database-sequence-next (sequence-name
80 (database postgresql-database))
84 (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
87 ;; Functions depending upon high-level USQL classes/functions
90 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
91 (database postgresql-database))
92 (with-slots (clsql-sys::modifier clsql-sys::components)
94 (if clsql-sys::modifier
96 (clsql-sys::output-sql clsql-sys::components database)
97 (write-char #\: clsql-sys::*sql-stream*)
98 (write-char #\: clsql-sys::*sql-stream*)
99 (write-string (symbol-name clsql-sys::modifier)
100 clsql-sys::*sql-stream*)))))
102 (defmethod database-output-sql-as-type ((type (eql 'integer)) val
103 (database postgresql-database))
104 (when val ;; typecast it so it uses the indexes
105 (make-instance 'clsql-sys::sql-typecast-exp