db-sqlite/sqlite-usql.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          sqlite-usql.lisp
   6 ;;;; Purpose:       SQLite interface for USQL routines
   7 ;;;; Programmers:   Aurelio Bignoli
   8 ;;;; Date Started:  Aug 2003
   9 ;;;;
  10 ;;;; $Id: sqlite-usql.lisp,v 1.3 2004/03/09 20:58:38 aurelio Exp $
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2003 by Aurelio Bignoli
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package :clsql-sqlite)
  20
  21 (defmethod database-list-tables ((database sqlite-database) &key owner)
  22   (declare (ignore owner))
  23   ;; Query is copied from .table command of sqlite comamnd line utility.
  24   (remove-if #'(lambda (s)
  25                  (and (>= (length s) 10)
  26                       (string= (subseq s 0 10) "_usql_seq_")))
  27              (mapcar #'car (database-query
  28                             "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
  29                             database '()))))
  30
  31 (defmethod database-list-views ((database sqlite-database)
  32                                 &key (owner nil))
  33   (declare (ignore owner))
  34   (mapcar #'car (database-query
  35                  "SELECT name FROM sqlite_master WHERE type='view' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='view' ORDER BY name"
  36                  database nil)))
  37
  38 (defmethod database-list-indexes ((database sqlite-database)
  39                                   &key (owner nil))
  40   (declare (ignore owner))
  41   (mapcar #'car (database-query
  42                  "SELECT name FROM sqlite_master WHERE type='index' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='index' ORDER BY name"
  43                  database nil)))
  44
  45 (declaim (inline sqlite-table-info))
  46 (defun sqlite-table-info (table database)
  47   (database-query (format nil "PRAGMA table_info('~A')" table)
  48                           database '()))
  49
  50 (defmethod database-list-attributes (table (database sqlite-database)
  51                                            &key (owner nil))
  52   (declare (ignore owner))
  53   (mapcar #'(lambda (table-info) (second table-info))
  54           (sqlite-table-info table database)))
  55
  56 (defmethod database-attribute-type (attribute table
  57                                     (database sqlite-database)
  58                                     &key (owner nil))
  59   (declare (ignore owner))
  60   (loop for field-info in (sqlite-table-info table database)
  61         when (string= attribute (second field-info))
  62         return (third field-info)))
  63
  64 (defun %sequence-name-to-table-name (sequence-name)
  65   (concatenate 'string "_usql_seq_" (sql-escape sequence-name)))
  66
  67 (defun %table-name-to-sequence-name (table-name)
  68   (and (>= (length table-name) 10)
  69        (string= (subseq table-name 0 10) "_usql_seq_")
  70        (subseq table-name 10)))
  71
  72 (defmethod database-create-sequence (sequence-name
  73                                      (database sqlite-database))
  74   (let ((table-name (%sequence-name-to-table-name sequence-name)))
  75     (database-execute-command
  76      (concatenate 'string "CREATE TABLE " table-name
  77                   " (id INTEGER PRIMARY KEY)")
  78      database)
  79     (database-execute-command
  80      (format nil "INSERT INTO ~A VALUES (-1)" table-name)
  81      database)))
  82
  83 (defmethod database-drop-sequence (sequence-name
  84                                    (database sqlite-database))
  85   (database-execute-command
  86    (concatenate 'string "DROP TABLE "
  87                 (%sequence-name-to-table-name sequence-name))
  88    database))
  89
  90 (defmethod database-list-sequences ((database sqlite-database)
  91                                     &key (owner nil))
  92   (declare (ignore owner))
  93   (mapcan #'(lambda (s)
  94               (let ((sn (%table-name-to-sequence-name (car s))))
  95                 (and sn (list sn))))
  96           (database-query
  97            "SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name"
  98            database '())))
  99
 100 (defmethod database-sequence-next (sequence-name (database sqlite-database))
 101   (let ((table-name (%sequence-name-to-table-name sequence-name)))
 102     (database-execute-command
 103      (format nil "UPDATE ~A SET id=(SELECT id FROM ~A)+1"
 104              table-name table-name)
 105      database)
 106     (sqlite:sqlite-last-insert-rowid (sqlite-db database))
 107     (parse-integer
 108      (caar (database-query (format nil "SELECT id from ~A" table-name)
 109                            database nil)))))
 110
 111 (defmethod database-set-sequence-position (sequence-name
 112                                            (position integer)
 113                                            (database sqlite-database))
 114   (let ((table-name (%sequence-name-to-table-name sequence-name)))
 115     (database-execute-command
 116      (format nil "UPDATE ~A SET id=~A" table-name position)
 117      database)
 118     (sqlite:sqlite-last-insert-rowid (sqlite-db database))))
 119
 120 (defmethod database-sequence-last (sequence-name (database sqlite-database))
 121   (declare (ignore sequence-name database)))