;; $Id: documentation:sql-tutorial:examples.lisp,v 1.1 2005/01/03 20:32:53 davef Exp $ (in-package "CL-USER") ;; EXAMPLES.LISP ;; Nick Levine, Ravenbrook Limited, 2002-09-27 ;; ;; These are the examples I expect to use in the tutorial on Common ;; SQL at the International Lisp Conference 2002. ;; ;; This document is mainly for my operational convenience. You might ;; want to raid fragments to help you get started when building SQL ;; applications from Common Lisp. Nothing useful will happen if you ;; try to cl:load this document into a lisp image. ;; ;; This document is incomplete and has been posted on this website for ;; internal review only. ;; ;; This document is not confidential. Please see the end of the ;; document for copyright and related information. (setf *print-pretty* t *print-length* 5) (require "odbc") (sql:connect "Agrobiodiversity") (sql:disconnect :database my-database) (use-package :SQL) (query "select SampleAreaLocation, LandUseStage from SampleAreas where SampleAreaNumber = 1") (query "select count(*) from SpeciesList where ScientificName like '%sp.'") (query "select LocalName, ScientificName from SpeciesList where SpeciesID <= 5") (multiple-value-list (decode-universal-time (caar (query "select max(Date) from TreeData")))) (print-query "select LocalName, ScientificName from SpeciesList where SpeciesID <= 5" :titles '("LocalName" "ScientificName")) (with-transaction (execute-command "insert into SpeciesList (LocalName) values ('Aardvark')") (execute-command "create table foo (bar integer)")) (execute-command "delete from SpeciesList where (LocalName = 'Aardvark')") (query "select * from SpeciesList where (LocalName = 'Aardvark')") (rollback) (query "select * from SpeciesList where (LocalName = 'Aardvark')") (list-tables) (table-exists-p "SpeciesList") (list-attributes "SpeciesList") (attribute-type "LocalName" "SpeciesList") (loop for attr in (list-attributes "TreeData") collect (attribute-type attr "TreeData")) (print-query "select * from SpeciesList where (SpeciesID between 6 and 9)" :titles (list-attributes "SpeciesList")) (start-sql-recording) (enable-sql-reader-syntax) (select [Researcher] :from [SampleAreas]) (apply (sql-operator 'and) (loop for table in '(thistime nexttime sometime never) for count from 42 collect [between (sql-expression :table table :attribute 'bar) (sql-operation '* [hip] [hop]) count] collect [like (sql-expression :table table :attribute 'baz) (sql table)])) (select [FieldType] [Researcher] :from [SampleAreas]) (select [+ [PlotNumer] [* 1000 [SampleAreaNumber]]] :from [PlotDescription] :flatp t) (select [*] :from [SpeciesList]) (select [max [+ [PlotNumer] [* 1000 [SampleAreaNumber]]]] :from [PlotDescription] :flatp t) (select [avg [+ [PlotNumer] [* 1000 [SampleAreaNumber]]]] :from [PlotDescription] :flatp t) (loop for table in (list-tables) repeat 5 collect (select table [count [*]] :from table)) (loop for column in '([*] [ScientificName]) collect (select [count column] :from [SpeciesList] :flatp t)) (select [LandUseStage] :from [Sampleareas] :flatp t) (select [LandUseStage] :from [Sampleareas] :flatp t :where [>= [SampleAreaNumber] 37]) (select [LandUseStage] :from [Sampleareas] :flatp t :distinct t) (select [LandUseStage] [count [*]] :from [Sampleareas] :group-by [LandUseStage]) (select [LandUseStage] [count [*]] :from [Sampleareas] :having [between [count [*]] 8 10] :group-by [LandUseStage]) (select [max [Height]] :from [TreeData] :flatp t :where [= [Researcher] "Fernando"]) (select [ScientificName] :from [SpeciesList] :flatp t :where [like [LocalName] "v%"]) (select [LocalName] :from [SpeciesList] :flatp t :where [null [ScientificName]]) (select [distinct [Researcher]] :from [TreeData] :flatp t) (select [Researcher] :distinct t :from [TreeData] :flatp t) (select [Researcher] :from '([TreeData] [SpeciesList]) :where [and [= [TreeData SpeciesID] [SpeciesList SpeciesID]] [like [LocalName] "v%"]] :distinct t :flatp t) (select ["table" LocalName] ["table" ScientificName] :from '([SpeciesList "table"] [SpeciesList "join"]) :where [and [= ["table" ScientificName] ["join" ScientificName]] [not [= ["table" SpeciesID] ["join" SpeciesID]]]] :order-by '(["table" ScientificName])) (select [ScientificName] :from [SpeciesList] :where [in [LocalName] [select [LocalName] :from [SpeciesList] :where [like [LocalName ] "v%"]]] :flatp t) (select [Researcher] :from '([TreeData] [SpeciesList]) :where [and [= [TreeData SpeciesID] [SpeciesList SpeciesID]] [in [LocalName] [select [LocalName] :from [SpeciesList] :where [like [LocalName] "v%"]]]] :distinct t :flatp t) (select [DemoSite] :from [SampleAreas] :group-by [DemoSite] :flatp t :where [<= [Date] [all [select [Date] :from [SpeciesData]]]]) (select [SpeciesID] :from [SpeciesData] :where [not [exists [select [*] :from [SampleAreas] :where [= [SpeciesData Date] [SampleAreas Date]]]]]) (defvar aardvark [= [LocalName] "Aardvark"]) (values (select [*] :from [SpeciesList] :where aardvark)) (with-transaction (insert-records :into [SpeciesList] :attributes '([LocalName]) :values '("Aardvark"))) (values (select [*] :from [SpeciesList] :where aardvark)) (with-transaction (update-records [SpeciesList] :where aardvark :av-pairs '(([ScientificName] "Orycteropus afer")))) (values (select [*] :from [SpeciesList] :where aardvark)) (with-transaction (delete-records :from [SpeciesList] :where aardvark)) (values (select [*] :from [SpeciesList] :where aardvark)) (map-query 'vector 'print [select [*] :from [SpeciesList] :where aardvark]) (do-query ((local scientific id) [select [*] :from [SpeciesList] :where aardvark]) (print (list local scientific id))) (loop for columns being the records of [select [*] :from [SpeciesList] :where aardvark] do (print columns)) (drop-table [foo]) (create-table [foo] '(([id] number primary key) ([name] (char 255) not null) ([comments] longchar))) (create-index [bar] :on [foo] :attributes '([id] [name])) (create-view [nullScientificName] :as [select [*] :from [SpeciesList] :where [null [ScientificName]]]) (editor:setup-indent "def-view-class" 2 2 10) (def-view-class |TreeData| () ((|TreeTagNumber| :type integer :db-kind :key) (|SpeciesID| :type integer) (|Height| :type float :reader treedata-height) (|Researcher| :type (string 50)))) (def-view-class species-list () ((local-name :column |LocalName| :type (string 50) :initarg :local-name) (scientific-name :column |ScientificName| :type (string 50) :initform nil) (species-id :db-kind :key :column |SpeciesID| :type integer :initform 0)) (:base-table |SpeciesList|)) (def-view-class tree-list (species-list) ((heights :db-kind :join :db-info (:home-key species-id :foreign-key |SpeciesID| :join-class |TreeData|))) (:base-table |SpeciesList|)) (select '|TreeData|) (describe (caar *)) (select '|TreeData| 'species-list :where [= [slot-value '|TreeData| '|SpeciesID|] [slot-value 'species-list 'species-id]]) (setf tree-1 (car (select 'tree-list :flatp t ;; equivalent to [= [|SpeciesID|] 1]... :where [= [slot-value 'tree-list 'species-id] 1]))) (inspect *) (slot-value tree-1 'heights) :d ; get inspector to redisplay tree-1 (mapcar 'treedata-height (slot-value tree-1 'heights)) :q (def-view-class |TreeData| () ((|TreeTagNumber| :type integer :db-kind :key) (|SpeciesID| :type integer) (|Height| :type float :reader treedata-height) (|Researcher| :type (string 50)) (|Date| :type universal-time))) (defun refresh-test (refresh) (let* ((select-461 [= [TreeTagNumber] 461]) (tree-461 (car (select '|TreeData| :flatp t :where select-461 :refresh refresh)))) (when (slot-boundp tree-461 '|Date|) (list (slot-value tree-461 '|Date|))))) (refresh-test nil) (refresh-test t) (do-query ((my-aardvark) [select 'species-list :where aardvark]) (print my-aardvark)) (setf my-aardvark (make-instance 'species-list :local-name "Aardvark")) (update-records-from-instance my-aardvark) (select 'species-list :where aardvark) (setf (slot-value my-Aardvark 'scientific-name) "Orycteropus Afer") (update-record-from-slot my-Aardvark 'scientific-name) (slot-value (car (select 'species-list :where aardvark :flatp t)) 'scientific-name) (odbc-common:sqlgetinfo (sql::hdbc *default-database*) odbc-common:sql_odbc_ver) (odbc-common:sqlgetinfo (sql::hdbc *default-database*) 108) (setf (aref odbc-common::+finfotype-return-types+ 108) '(:unsigned :short)) (odbc-common:sqlgetinfo (sql::hdbc *default-database*) 108) (with-transaction (when (table-exists-p "foo") (execute-command "drop table foo")) (execute-command "create table foo (bar varchar (255), primary key (bar))") (execute-command "insert into foo values ('wombat')") (execute-command "insert into foo values ('Wombat')")) (defun column-sensitive-p (column table) (let ((h (nth-value 1 (odbc-common:SQLAllocHandle odbc-common:SQL_HANDLE_STMT (sql::hdbc sql:*default-database*))))) (unwind-protect (progn (odbc-common::sqlprepare h (format nil "select ~a from ~a" column table)) (= 1 (nth-value 1 (odbc-common::sqlcolattribute h 1 odbc-common:sql_desc_case_sensitive)))) (odbc-common:sqlfreehandle odbc-common:SQL_HANDLE_STMT h)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; September 2002 ;; Copyright (c) 2002 by Xanalys LLC ;; All Rights Reserved. ;; ;; You are permitted to view, copy, print and distribute this ;; publication, subject to your agreement that: a) your use of the ;; information is for informational, personal, and non-commercial ;; purposes only, b) you will not modify the documents, publications ;; or graphics, c) you will not copy or distribute graphics separate ;; from their accompanying text and you will not quote materials out ;; of their context, d) you will display the above copyright notice ;; and other proprietary notices on every copy you make, and e) you ;; agree that Xanalys LLC may revoke this permission at any time and ;; you shall immediately stop your activities related to this ;; permission upon notice from Xanalys LLC. Use for any other purpose ;; is expressly prohibited by law, and may result in severe civil and ;; criminal penalties. Violators will be prosecuted to the maximum ;; extent possible. ;; ;; The information in this publication is provided for information ;; only, is subject to change without notice, and should not be ;; construed as a commitment by Xanalys Limited or Xanalys ;; LLC. Xanalys LLC assumes no responsibility or liability for any ;; errors or inaccuracies that may appear in this publication. ;; ;; The software described in this publication is furnished under ;; license and may only be used or copied in accordance with the terms ;; of that license. LispWorks is a registered trademark of Xanalys ;; LLC. Microsoft is a registered trademark of Microsoft ;; Corporation. Other brand or product names are the registered ;; trademarks or trademarks of their respective holders.