1 (in-package #:clsql-tests)
3 (clsql-sys:file-enable-sql-reader-syntax)
4 (defparameter company1 nil)
5 (defparameter employee1 nil)
6 (defparameter employee2 nil)
7 (defparameter employee3 nil)
8 (defparameter employee4 nil)
9 (defparameter employee5 nil)
10 (defparameter employee6 nil)
11 (defparameter employee7 nil)
12 (defparameter employee8 nil)
13 (defparameter employee9 nil)
14 (defparameter employee10 nil)
15 (defparameter address1 nil)
16 (defparameter address2 nil)
17 (defparameter employee-address1 nil)
18 (defparameter employee-address2 nil)
19 (defparameter employee-address3 nil)
20 (defparameter employee-address4 nil)
21 (defparameter employee-address5 nil)
24 ((extraterrestrial :initform nil :initarg :extraterrestrial)))
26 (def-view-class person (thing)
27 ((height :db-kind :base :accessor height :type float
29 (married :db-kind :base :accessor married :type boolean
31 (birthday :type clsql:wall-time :initarg :birthday)
32 (bd-utime :type clsql:universal-time :initarg :bd-utime)
33 (hobby :db-kind :virtual :initarg :hobby :initform nil)))
35 (def-view-class employee (person)
38 :db-constraints (:not-null :unique)
43 :db-constraints :not-null
55 :accessor employee-email
62 :accessor employee-company
64 :db-info (:join-class company
66 :foreign-key companyid
72 :accessor employee-manager
74 :db-info (:join-class employee
79 :accessor employee-addresses
81 :db-info (:join-class employee-address
86 (:base-table employee))
88 (def-view-class company ()
91 :db-constraints :not-null
96 :db-constraints :not-null
104 :initarg :presidentid)
108 :db-info (:join-class employee
109 :home-key presidentid
113 :reader company-employees
115 :db-info (:join-class employee
116 :home-key (companyid groupid)
117 :foreign-key (ecompanyid groupid)
120 (def-view-class address ()
123 :db-constraints :not-null
128 :initarg :street-number)
132 :initarg :street-name)
135 :void-value "no city"
142 :initarg :postal-code))
145 ;; many employees can reside at many addressess
146 (def-view-class employee-address ()
147 ((aemplid :type integer :initarg :emplid)
148 (aaddressid :type integer :initarg :addressid)
149 (verified :type boolean :initarg :verified)
150 (address :db-kind :join
151 :db-info (:join-class address
153 :foreign-key addressid
154 :retrieval :immediate))
155 (employee :db-kind :join
156 :db-info (:join-class employee
159 :retrieval :immediate)))
160 (:base-table "ea_join"))
162 (def-view-class deferred-employee-address ()
163 ((aemplid :type integer :initarg :emplid)
164 (aaddressid :type integer :initarg :addressid)
165 (verified :type boolean :initarg :verified)
166 (address :db-kind :join
167 :db-info (:join-class address
169 :foreign-key addressid
172 (:base-table "ea_join"))
176 (defun initialize-ds-employees ()
177 ;; (start-sql-recording :type :both)
178 (let ((*backend-warning-behavior*
179 (if (member *test-database-type* '(:postgresql :postgresql-socket))
182 (mapc #'clsql:create-view-from-class
183 '(employee company address employee-address)))
186 (setq *test-start-utime* (get-universal-time))
187 (let* ((*db-auto-sync* t)
188 (now-time (clsql:utime->time *test-start-utime*)))
189 (setf company1 (make-instance 'company
193 :name "Widgets Inc.")
194 employee1 (make-instance 'employee
198 :height (1+ (random 1.00))
199 :bd-utime *test-start-utime*
201 :first-name "Vladimir"
203 :email "lenin@soviet.org"
205 employee2 (make-instance 'employee
208 :height (1+ (random 1.00))
210 :bd-utime *test-start-utime*
214 :email "stalin@soviet.org"
217 employee3 (make-instance 'employee
220 :height (1+ (random 1.00))
222 :bd-utime *test-start-utime*
226 :email "trotsky@soviet.org"
229 employee4 (make-instance 'employee
232 :height (1+ (random 1.00))
234 :bd-utime *test-start-utime*
237 :last-name "Kruschev"
238 :email "kruschev@soviet.org"
241 employee5 (make-instance 'employee
245 :height (1+ (random 1.00))
246 :bd-utime *test-start-utime*
249 :last-name "Brezhnev"
250 :email "brezhnev@soviet.org"
253 employee6 (make-instance 'employee
257 :height (1+ (random 1.00))
258 :bd-utime *test-start-utime*
261 :last-name "Andropov"
262 :email "andropov@soviet.org"
265 employee7 (make-instance 'employee
268 :height (1+ (random 1.00))
270 :bd-utime *test-start-utime*
272 :first-name "Konstantin"
273 :last-name "Chernenko"
274 :email "chernenko@soviet.org"
277 employee8 (make-instance 'employee
280 :height (1+ (random 1.00))
282 :bd-utime *test-start-utime*
284 :first-name "Mikhail"
285 :last-name "Gorbachev"
286 :email "gorbachev@soviet.org"
289 employee9 (make-instance 'employee
293 :height (1+ (random 1.00))
294 :bd-utime *test-start-utime*
298 :email "yeltsin@soviet.org"
301 employee10 (make-instance 'employee
305 :height (1+ (random 1.00))
306 :bd-utime *test-start-utime*
308 :first-name "Vladimir"
310 :email "putin@soviet.org"
313 address1 (make-instance 'address
316 :street-name "Park Place"
319 address2 (make-instance 'address
321 employee-address1 (make-instance 'employee-address
325 employee-address2 (make-instance 'employee-address
329 employee-address3 (make-instance 'employee-address
333 employee-address4 (make-instance 'employee-address
337 employee-address5 (make-instance 'employee-address
341 ;; sleep to ensure birthdays are no longer at current time
342 ;(sleep 1) ;want to find the test that depends on it, put the sleep there.
345 ;; Lenin manages everyone ;
346 (clsql:add-to-relation employee2 'manager employee1)
347 (clsql:add-to-relation employee3 'manager employee1)
348 (clsql:add-to-relation employee4 'manager employee1)
349 (clsql:add-to-relation employee5 'manager employee1)
350 (clsql:add-to-relation employee6 'manager employee1)
351 (clsql:add-to-relation employee7 'manager employee1)
352 (clsql:add-to-relation employee8 'manager employee1)
353 (clsql:add-to-relation employee9 'manager employee1)
354 (clsql:add-to-relation employee10 'manager employee1)
355 ;; Everyone works for Widgets Inc. ;
356 (clsql:add-to-relation company1 'employees employee1)
357 (clsql:add-to-relation company1 'employees employee2)
358 (clsql:add-to-relation company1 'employees employee3)
359 (clsql:add-to-relation company1 'employees employee4)
360 (clsql:add-to-relation company1 'employees employee5)
361 (clsql:add-to-relation company1 'employees employee6)
362 (clsql:add-to-relation company1 'employees employee7)
363 (clsql:add-to-relation company1 'employees employee8)
364 (clsql:add-to-relation company1 'employees employee9)
365 (clsql:add-to-relation company1 'employees employee10)
366 ;; Lenin is president of Widgets Inc. ;
367 (clsql:add-to-relation company1 'president employee1)
370 ;; store these instances
372 (clsql:update-records-from-instance employee1)
373 (clsql:update-records-from-instance employee2)
374 (clsql:update-records-from-instance employee3)
375 (clsql:update-records-from-instance employee4)
376 (clsql:update-records-from-instance employee5)
377 (clsql:update-records-from-instance employee6)
378 (clsql:update-records-from-instance employee7)
379 (clsql:update-records-from-instance employee8)
380 (clsql:update-records-from-instance employee9)
381 (clsql:update-records-from-instance employee10)
382 (clsql:update-records-from-instance company1)
383 (clsql:update-records-from-instance address1)
384 (clsql:update-records-from-instance address2)
389 (def-dataset *ds-employees*
390 (:setup initialize-ds-employees)
392 (mapc #'clsql-sys:drop-view-from-class
393 '(employee company address employee-address))
395 (clsql-sys:execute-command "DROP TABLE ea_join")))))