db-postgresql/postgresql-usql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   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
   9 ;;;;
  10 ;;;; $Id: postgresql-usql.lisp,v 1.2 2003/06/26 15:27:07 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  13 ;;;; and by onShore Development Inc.
  14 ;;;;
  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 ;;;; *************************************************************************
  19
  20 (in-package #:clsql-postgresql)
  21
  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"
  26                             database nil))))
  27     (if (not system-tables)
  28         (remove-if #'(lambda (table)
  29                        (equal (subseq table 0 3)
  30                               "pg_")) res)
  31       res)))
  32
  33
  34
  35 (defmethod database-list-attributes ((table string)
  36                                      (database postgresql-database))
  37   (let* ((result
  38           (mapcar #'car
  39                   (database-query
  40                    (format nil
  41                            "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
  42                    database nil))))
  43     (if result
  44         (reverse
  45          (remove-if #'(lambda (it) (member it '("cmin"
  46                                                 "cmax"
  47                                                 "xmax"
  48                                                 "xmin"
  49                                                 "oid"
  50                                                 "ctid"
  51                                                 ;; kmr -- added tableoid
  52                                                 "tableoid") :test #'equal))
  53                     result)))))
  54
  55 (defmethod database-attribute-type (attribute (table string)
  56                                     (database postgresql-database))
  57   (let ((result
  58           (mapcar #'car
  59                   (database-query
  60                    (format nil
  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"
  62                            table attribute)
  63                    database nil))))
  64     (if result
  65         (intern (string-upcase (car result)) :keyword) nil)))
  66
  67
  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))
  72
  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))
  77
  78 (defmethod database-sequence-next (sequence-name
  79                                    (database postgresql-database))
  80   (parse-integer
  81    (caar
  82     (database-query
  83      (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
  84      database nil))))
  85
  86 ;; Functions depending upon high-level USQL classes/functions
  87
  88 #|
  89 (defmethod database-output-sql ((expr clsql-sys::sql-typecast-exp)
  90                                 (database postgresql-database))
  91   (with-slots (clsql-sys::modifier clsql-sys::components)
  92     expr
  93     (if clsql-sys::modifier
  94         (progn
  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*)))))
 100
 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
 105                    :modifier 'int8
 106                    :components val)))
 107 |#