1 (asdf:operate 'asdf:load-op 'clsql)
3 (in-package #:clsql-user)
5 ;; You must set these variables to appropriate values.
6 (defvar *tutorial-database-type* nil
7 "Possible values are :postgresql,:postgresql-socket :mysql or :sqlite")
8 (defvar *tutorial-database-name* ""
9 "The name of the database we will work in.")
10 (defvar *tutorial-database-user* ""
11 "The name of the database user we will work as.")
12 (defvar *tutorial-database-server* ""
13 "The name of the database server if required")
14 (defvar *tutorial-database-password* ""
15 "The password if required")
17 (clsql:def-view-class employee ()
20 :db-constraints :not-null
33 :accessor employee-email
40 :accessor employee-company
42 :db-info (:join-class company
44 :foreign-key companyid
50 :accessor employee-manager
52 :db-info (:join-class employee
56 (:base-table employee))
58 (clsql:def-view-class company ()
61 :db-constraints :not-null
72 :db-info (:join-class employee
77 :reader company-employees
79 :db-info (:join-class employee
81 :foreign-key companyid
83 (:base-table company))
85 ;; Connect to the database (see the CLSQL documentation for vendor
86 ;; specific connection specs).
87 (clsql:connect `(,*tutorial-database-server*
88 ,*tutorial-database-name*
89 ,*tutorial-database-user*
90 ,*tutorial-database-password*)
91 :database-type *tutorial-database-type*)
93 ;; Record the sql going out, helps us learn what is going
94 ;; on behind the scenes
95 (clsql:start-sql-recording)
97 ;; Create the tables for our view classes
98 ;; First we drop them, ignoring any errors
100 (clsql:drop-view-from-class 'employee)
101 (clsql:drop-view-from-class 'company))
103 (clsql:create-view-from-class 'employee)
104 (clsql:create-view-from-class 'company)
107 ;; Create some instances of our view classes
108 (defvar employee1 (make-instance 'employee
110 :first-name "Vladamir"
112 :email "lenin@soviet.org"))
114 (defvar company1 (make-instance 'company
116 :name "Widgets Inc."))
119 (defvar employee2 (make-instance 'employee
123 :email "stalin@soviet.org"))
125 ;; Lenin manages Stalin (for now)
126 (clsql:add-to-relation employee2 'manager employee1)
128 ;; Lenin and Stalin both work for Widgets Inc.
129 (clsql:add-to-relation company1 'employees employee1)
130 (clsql:add-to-relation company1 'employees employee2)
132 ;; Lenin is president of Widgets Inc.
133 (clsql:add-to-relation company1 'president employee1)
135 (clsql:update-records-from-instance employee1)
136 (clsql:update-records-from-instance employee2)
137 (clsql:update-records-from-instance company1)
139 ;; lets us use the functional
141 (clsql:locally-enable-sql-reader-syntax)
144 (format t "The email address of ~A ~A is ~A"
145 (first-name employee1)
146 (last-name employee1)
147 (employee-email employee1))
149 (setf (employee-email employee1) "lenin-nospam@soviets.org")
151 ;; Update the database
152 (clsql:update-records-from-instance employee1)
154 (let ((new-lenin (car
155 (clsql:select 'employee
156 :where [= [slot-value 'employee 'emplid] 1]))))
157 (format t "His new email is ~A"
158 (employee-email new-lenin)))
164 (clsql:select 'employee)
166 (clsql:select 'company)
168 ;; employees named Lenin
169 (clsql:select 'employee :where [= [slot-value 'employee 'last-name]
172 (clsql:select 'company :where [= [slot-value 'company 'name]
175 ;; Employees of Widget's Inc.
176 (clsql:select 'employee
177 :where [and [= [slot-value 'employee 'companyid]
178 [slot-value 'company 'companyid]]
179 [= [slot-value 'company 'name]
182 ;; Same thing, except that we are using the employee
183 ;; relation in the company view class to do the join for us,
184 ;; saving us the work of writing out the SQL!
185 (company-employees company1)
187 ;; President of Widgets Inc.
190 ;; Manager of Josef Stalin
191 (employee-manager employee2)