tests/ds-employees.lisp

   1 (in-package #:clsql-tests)
   2
   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 address3 nil)
  18 (defparameter employee-address1 nil)
  19 (defparameter employee-address2 nil)
  20 (defparameter employee-address3 nil)
  21 (defparameter employee-address4 nil)
  22 (defparameter employee-address5 nil)
  23 (defparameter employee-address6 nil)
  24
  25 (defclass thing ()
  26   ((extraterrestrial :initform nil :initarg :extraterrestrial)))
  27
  28 (def-view-class person (thing)
  29   ((height :db-kind :base :accessor height :type float
  30            :initarg :height)
  31    (married :db-kind :base :accessor married :type boolean
  32             :initarg :married)
  33    (birthday :type clsql:wall-time :initarg :birthday)
  34    (bd-utime :type clsql:universal-time :initarg :bd-utime)
  35    (hobby :db-kind :virtual :initarg :hobby :initform nil)))
  36
  37 (def-view-class employee (person)
  38   ((emplid
  39     :db-kind :key
  40     :db-constraints (:not-null :unique)
  41     :type integer
  42     :initarg :emplid)
  43    (groupid
  44     :db-kind :key
  45     :db-constraints :not-null
  46     :type integer
  47     :initarg :groupid)
  48    (first-name
  49     :accessor first-name
  50     :type (varchar 30)
  51     :initarg :first-name)
  52    (last-name
  53     :accessor last-name
  54     :type (varchar 30)
  55     :initarg :last-name)
  56    (email
  57     :accessor employee-email
  58     :type (varchar 100)
  59     :initarg :email)
  60    (ecompanyid
  61     :type integer
  62     :initarg :companyid)
  63    (company
  64     :accessor employee-company
  65     :db-kind :join
  66     :db-info (:join-class company
  67                           :home-key ecompanyid
  68                           :foreign-key companyid
  69                           :set nil))
  70    (managerid
  71     :type integer
  72     :initarg :managerid)
  73    (manager
  74     :accessor employee-manager
  75     :db-kind :join
  76     :db-info (:join-class employee
  77                           :home-key managerid
  78                           :foreign-key emplid
  79                           :set nil))
  80    (addresses
  81     :accessor employee-addresses
  82     :db-kind :join
  83     :db-info (:join-class employee-address
  84                           :home-key emplid
  85                           :foreign-key aemplid
  86                           :target-slot address
  87                           :set t)))
  88   (:base-table employee))
  89
  90 (def-view-class company ()
  91   ((companyid
  92     :db-kind :key
  93     :db-constraints :not-null
  94     :type integer
  95     :initarg :companyid)
  96    (groupid
  97     :db-kind :key
  98     :db-constraints :not-null
  99     :type integer
 100     :initarg :groupid)
 101    (name
 102     :type (varchar 100)
 103     :initarg :name)
 104    (presidentid
 105     :type integer
 106     :initarg :presidentid)
 107    (president
 108     :reader president
 109     :db-kind :join
 110     :db-info (:join-class employee
 111                           :home-key presidentid
 112                           :foreign-key emplid
 113                           :set nil))
 114    (employees
 115     :reader company-employees
 116     :db-kind :join
 117     :db-info (:join-class employee
 118                           :home-key (companyid groupid)
 119                           :foreign-key (ecompanyid groupid)
 120                           :set t))))
 121
 122 (def-view-class address ()
 123   ((addressid
 124     :db-kind :key
 125     :db-constraints :not-null
 126     :type integer
 127     :initarg :addressid)
 128    (street-number
 129     :type integer
 130     :initarg :street-number)
 131    (street-name
 132     :type (varchar 30)
 133     :void-value ""
 134     :initarg :street-name)
 135    (city
 136     :column "city_field"
 137     :void-value "no city"
 138     :type (varchar 30)
 139     :initarg :city)
 140    (postal-code
 141     :column zip
 142     :type integer
 143     :void-value 0
 144     :initarg :postal-code))
 145   (:base-table addr))
 146
 147 ;; many employees can reside at many addressess
 148 (def-view-class employee-address ()
 149   ((aemplid :type integer :initarg :emplid)
 150    (aaddressid :type integer :initarg :addressid)
 151    (verified :type boolean :initarg :verified)
 152    (address :db-kind :join
 153             :db-info (:join-class address
 154                                   :home-key aaddressid
 155                                   :foreign-key addressid
 156                                   :retrieval :immediate))
 157    (employee :db-kind :join
 158              :db-info (:join-class employee
 159                                   :home-key aemplid
 160                                   :foreign-key emplid
 161                                   :retrieval :immediate)))
 162   (:base-table "ea_join"))
 163
 164 (def-view-class deferred-employee-address ()
 165   ((aemplid :type integer :initarg :emplid)
 166    (aaddressid :type integer :initarg :addressid)
 167    (verified :type boolean :initarg :verified)
 168    (address :db-kind :join
 169             :db-info (:join-class address
 170                                   :home-key aaddressid
 171                                   :foreign-key addressid
 172                                   :retrieval :deferred
 173                                   :set nil)))
 174   (:base-table "ea_join"))
 175
 176
 177
 178 (defun initialize-ds-employees ()
 179   ;;  (start-sql-recording :type :both)
 180   (mapc #'clsql:create-view-from-class
 181         '(employee company address employee-address))
 182
 183   (setq *test-start-utime* (get-universal-time))
 184   (let* ((*db-auto-sync* t)
 185          (now-time (clsql:utime->time *test-start-utime*)))
 186     (setf company1 (make-instance 'company
 187                                   :presidentid 1
 188                                   :companyid 1
 189                                   :groupid 1
 190                                   :name "Widgets Inc.")
 191           employee1 (make-instance 'employee
 192                                    :emplid 1
 193                                    :groupid 1
 194                                    :married t
 195                                    :height (1+ (random 1.00))
 196                                    :bd-utime *test-start-utime*
 197                                    :birthday now-time
 198                                    :first-name "Vladimir"
 199                                    :last-name "Lenin"
 200                                    :email "lenin@soviet.org"
 201                                    :companyid 1)
 202           employee2 (make-instance 'employee
 203                                    :emplid 2
 204                                    :groupid 1
 205                                    :height (1+ (random 1.00))
 206                                    :married t
 207                                    :bd-utime *test-start-utime*
 208                                    :birthday now-time
 209                                    :first-name "Josef"
 210                                    :last-name "Stalin"
 211                                    :email "stalin@soviet.org"
 212                                    :managerid 1
 213                                    :companyid 1)
 214           employee3 (make-instance 'employee
 215                                    :emplid 3
 216                                    :groupid 1
 217                                    :height (1+ (random 1.00))
 218                                    :married t
 219                                    :bd-utime *test-start-utime*
 220                                    :birthday now-time
 221                                    :first-name "Leon"
 222                                    :last-name "Trotsky"
 223                                    :email "trotsky@soviet.org"
 224                                    :managerid 1
 225                                    :companyid 1)
 226           employee4 (make-instance 'employee
 227                                    :emplid 4
 228                                    :groupid 1
 229                                    :height (1+ (random 1.00))
 230                                    :married nil
 231                                    :bd-utime *test-start-utime*
 232                                    :birthday now-time
 233                                    :first-name "Nikita"
 234                                    :last-name "Kruschev"
 235                                    :email "kruschev@soviet.org"
 236                                    :managerid 1
 237                                    :companyid 1)
 238           employee5 (make-instance 'employee
 239                                    :emplid 5
 240                                    :groupid 1
 241                                    :married nil
 242                                    :height (1+ (random 1.00))
 243                                    :bd-utime *test-start-utime*
 244                                    :birthday now-time
 245                                    :first-name "Leonid"
 246                                    :last-name "Brezhnev"
 247                                    :email "brezhnev@soviet.org"
 248                                    :managerid 1
 249                                    :companyid 1)
 250           employee6 (make-instance 'employee
 251                                    :emplid 6
 252                                    :groupid 1
 253                                    :married nil
 254                                    :height (1+ (random 1.00))
 255                                    :bd-utime *test-start-utime*
 256                                    :birthday now-time
 257                                    :first-name "Yuri"
 258                                    :last-name "Andropov"
 259                                    :email "andropov@soviet.org"
 260                                    :managerid 1
 261                                    :companyid 1)
 262           employee7 (make-instance 'employee
 263                                    :emplid 7
 264                                    :groupid 1
 265                                    :height (1+ (random 1.00))
 266                                    :married nil
 267                                    :bd-utime *test-start-utime*
 268                                    :birthday now-time
 269                                    :first-name "Konstantin"
 270                                    :last-name "Chernenko"
 271                                    :email "chernenko@soviet.org"
 272                                    :managerid 1
 273                                    :companyid 1)
 274           employee8 (make-instance 'employee
 275                                    :emplid 8
 276                                    :groupid 1
 277                                    :height (1+ (random 1.00))
 278                                    :married nil
 279                                    :bd-utime *test-start-utime*
 280                                    :birthday now-time
 281                                    :first-name "Mikhail"
 282                                    :last-name "Gorbachev"
 283                                    :email "gorbachev@soviet.org"
 284                                    :managerid 1
 285                                    :companyid 1)
 286           employee9 (make-instance 'employee
 287                                    :emplid 9
 288                                    :groupid 1
 289                                    :married nil
 290                                    :height (1+ (random 1.00))
 291                                    :bd-utime *test-start-utime*
 292                                    :birthday now-time
 293                                    :first-name "Boris"
 294                                    :last-name "Yeltsin"
 295                                    :email "yeltsin@soviet.org"
 296                                    :managerid 1
 297                                    :companyid 1)
 298           employee10 (make-instance 'employee
 299                                     :emplid 10
 300                                     :groupid 1
 301                                     :married nil
 302                                     :height (1+ (random 1.00))
 303                                     :bd-utime *test-start-utime*
 304                                     :birthday now-time
 305                                     :first-name "Vladimir"
 306                                     :last-name "Putin"
 307                                     :email "putin@soviet.org"
 308                                     :managerid 1
 309                                     :companyid 1)
 310           address1 (make-instance 'address
 311                                   :addressid 1
 312                                   :street-number 10
 313                                   :street-name "Park Place"
 314                                   :city "Leningrad"
 315                                   :postal-code 123)
 316           address2 (make-instance 'address
 317                                   :addressid 2)
 318           address3 (make-instance 'address
 319                                   :addressid 3)
 320           employee-address1 (make-instance 'employee-address
 321                                            :emplid 1
 322                                            :addressid 1
 323                                            :verified t)
 324           employee-address2 (make-instance 'employee-address
 325                                            :emplid 2
 326                                            :addressid 2
 327                                            :verified t)
 328           employee-address3 (make-instance 'employee-address
 329                                            :emplid 3
 330                                            :addressid 1
 331                                            :verified nil)
 332           employee-address4 (make-instance 'employee-address
 333                                            :emplid 1
 334                                            :addressid 2
 335                                            :verified nil)
 336           employee-address5 (make-instance 'employee-address
 337                                            :emplid 3
 338                                            :addressid 2)
 339           employee-address6 (make-instance 'employee-address
 340                                            :emplid 4
 341                                            :addressid 3)))
 342
 343   ;; sleep to ensure birthdays are no longer at current time
 344   ;(sleep 1) ;want to find the test that depends on it, put the sleep there.
 345
 346   #||
 347   ;; Lenin manages everyone             ;
 348   (clsql:add-to-relation employee2 'manager employee1)
 349   (clsql:add-to-relation employee3 'manager employee1)
 350   (clsql:add-to-relation employee4 'manager employee1)
 351   (clsql:add-to-relation employee5 'manager employee1)
 352   (clsql:add-to-relation employee6 'manager employee1)
 353   (clsql:add-to-relation employee7 'manager employee1)
 354   (clsql:add-to-relation employee8 'manager employee1)
 355   (clsql:add-to-relation employee9 'manager employee1)
 356   (clsql:add-to-relation employee10 'manager employee1)
 357   ;; Everyone works for Widgets Inc.    ;
 358   (clsql:add-to-relation company1 'employees employee1)
 359   (clsql:add-to-relation company1 'employees employee2)
 360   (clsql:add-to-relation company1 'employees employee3)
 361   (clsql:add-to-relation company1 'employees employee4)
 362   (clsql:add-to-relation company1 'employees employee5)
 363   (clsql:add-to-relation company1 'employees employee6)
 364   (clsql:add-to-relation company1 'employees employee7)
 365   (clsql:add-to-relation company1 'employees employee8)
 366   (clsql:add-to-relation company1 'employees employee9)
 367   (clsql:add-to-relation company1 'employees employee10)
 368   ;; Lenin is president of Widgets Inc. ;
 369   (clsql:add-to-relation company1 'president employee1)
 370   ||#
 371
 372   ;; store these instances
 373   #||
 374   (clsql:update-records-from-instance employee1)
 375   (clsql:update-records-from-instance employee2)
 376   (clsql:update-records-from-instance employee3)
 377   (clsql:update-records-from-instance employee4)
 378   (clsql:update-records-from-instance employee5)
 379   (clsql:update-records-from-instance employee6)
 380   (clsql:update-records-from-instance employee7)
 381   (clsql:update-records-from-instance employee8)
 382   (clsql:update-records-from-instance employee9)
 383   (clsql:update-records-from-instance employee10)
 384   (clsql:update-records-from-instance company1)
 385   (clsql:update-records-from-instance address1)
 386   (clsql:update-records-from-instance address2)
 387   ||#
 388   )
 389
 390
 391  (def-dataset *ds-employees*
 392    (:setup initialize-ds-employees)
 393    (:cleanup (lambda ()
 394                (mapc #'clsql-sys:drop-view-from-class
 395                      '(employee company address employee-address))
 396                (ignore-errors
 397                  (clsql-sys:execute-command "DROP TABLE ea_join")))))
 398