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   (let ((*backend-warning-behavior*
 181          (if (member *test-database-type* '(:postgresql :postgresql-socket))
 182              :ignore
 183              :warn)))
 184     (mapc #'clsql:create-view-from-class
 185           '(employee company address employee-address)))
 186
 187
 188   (setq *test-start-utime* (get-universal-time))
 189   (let* ((*db-auto-sync* t)
 190          (now-time (clsql:utime->time *test-start-utime*)))
 191     (setf company1 (make-instance 'company
 192                                   :presidentid 1
 193                                   :companyid 1
 194                                   :groupid 1
 195                                   :name "Widgets Inc.")
 196           employee1 (make-instance 'employee
 197                                    :emplid 1
 198                                    :groupid 1
 199                                    :married t
 200                                    :height (1+ (random 1.00))
 201                                    :bd-utime *test-start-utime*
 202                                    :birthday now-time
 203                                    :first-name "Vladimir"
 204                                    :last-name "Lenin"
 205                                    :email "lenin@soviet.org"
 206                                    :companyid 1)
 207           employee2 (make-instance 'employee
 208                                    :emplid 2
 209                                    :groupid 1
 210                                    :height (1+ (random 1.00))
 211                                    :married t
 212                                    :bd-utime *test-start-utime*
 213                                    :birthday now-time
 214                                    :first-name "Josef"
 215                                    :last-name "Stalin"
 216                                    :email "stalin@soviet.org"
 217                                    :managerid 1
 218                                    :companyid 1)
 219           employee3 (make-instance 'employee
 220                                    :emplid 3
 221                                    :groupid 1
 222                                    :height (1+ (random 1.00))
 223                                    :married t
 224                                    :bd-utime *test-start-utime*
 225                                    :birthday now-time
 226                                    :first-name "Leon"
 227                                    :last-name "Trotsky"
 228                                    :email "trotsky@soviet.org"
 229                                    :managerid 1
 230                                    :companyid 1)
 231           employee4 (make-instance 'employee
 232                                    :emplid 4
 233                                    :groupid 1
 234                                    :height (1+ (random 1.00))
 235                                    :married nil
 236                                    :bd-utime *test-start-utime*
 237                                    :birthday now-time
 238                                    :first-name "Nikita"
 239                                    :last-name "Kruschev"
 240                                    :email "kruschev@soviet.org"
 241                                    :managerid 1
 242                                    :companyid 1)
 243           employee5 (make-instance 'employee
 244                                    :emplid 5
 245                                    :groupid 1
 246                                    :married nil
 247                                    :height (1+ (random 1.00))
 248                                    :bd-utime *test-start-utime*
 249                                    :birthday now-time
 250                                    :first-name "Leonid"
 251                                    :last-name "Brezhnev"
 252                                    :email "brezhnev@soviet.org"
 253                                    :managerid 1
 254                                    :companyid 1)
 255           employee6 (make-instance 'employee
 256                                    :emplid 6
 257                                    :groupid 1
 258                                    :married nil
 259                                    :height (1+ (random 1.00))
 260                                    :bd-utime *test-start-utime*
 261                                    :birthday now-time
 262                                    :first-name "Yuri"
 263                                    :last-name "Andropov"
 264                                    :email "andropov@soviet.org"
 265                                    :managerid 1
 266                                    :companyid 1)
 267           employee7 (make-instance 'employee
 268                                    :emplid 7
 269                                    :groupid 1
 270                                    :height (1+ (random 1.00))
 271                                    :married nil
 272                                    :bd-utime *test-start-utime*
 273                                    :birthday now-time
 274                                    :first-name "Konstantin"
 275                                    :last-name "Chernenko"
 276                                    :email "chernenko@soviet.org"
 277                                    :managerid 1
 278                                    :companyid 1)
 279           employee8 (make-instance 'employee
 280                                    :emplid 8
 281                                    :groupid 1
 282                                    :height (1+ (random 1.00))
 283                                    :married nil
 284                                    :bd-utime *test-start-utime*
 285                                    :birthday now-time
 286                                    :first-name "Mikhail"
 287                                    :last-name "Gorbachev"
 288                                    :email "gorbachev@soviet.org"
 289                                    :managerid 1
 290                                    :companyid 1)
 291           employee9 (make-instance 'employee
 292                                    :emplid 9
 293                                    :groupid 1
 294                                    :married nil
 295                                    :height (1+ (random 1.00))
 296                                    :bd-utime *test-start-utime*
 297                                    :birthday now-time
 298                                    :first-name "Boris"
 299                                    :last-name "Yeltsin"
 300                                    :email "yeltsin@soviet.org"
 301                                    :managerid 1
 302                                    :companyid 1)
 303           employee10 (make-instance 'employee
 304                                     :emplid 10
 305                                     :groupid 1
 306                                     :married nil
 307                                     :height (1+ (random 1.00))
 308                                     :bd-utime *test-start-utime*
 309                                     :birthday now-time
 310                                     :first-name "Vladimir"
 311                                     :last-name "Putin"
 312                                     :email "putin@soviet.org"
 313                                     :managerid 1
 314                                     :companyid 1)
 315           address1 (make-instance 'address
 316                                   :addressid 1
 317                                   :street-number 10
 318                                   :street-name "Park Place"
 319                                   :city "Leningrad"
 320                                   :postal-code 123)
 321           address2 (make-instance 'address
 322                                   :addressid 2)
 323           address3 (make-instance 'address
 324                                   :addressid 3)
 325           employee-address1 (make-instance 'employee-address
 326                                            :emplid 1
 327                                            :addressid 1
 328                                            :verified t)
 329           employee-address2 (make-instance 'employee-address
 330                                            :emplid 2
 331                                            :addressid 2
 332                                            :verified t)
 333           employee-address3 (make-instance 'employee-address
 334                                            :emplid 3
 335                                            :addressid 1
 336                                            :verified nil)
 337           employee-address4 (make-instance 'employee-address
 338                                            :emplid 1
 339                                            :addressid 2
 340                                            :verified nil)
 341           employee-address5 (make-instance 'employee-address
 342                                            :emplid 3
 343                                            :addressid 2)
 344           employee-address6 (make-instance 'employee-address
 345                                            :emplid 4
 346                                            :addressid 3)))
 347
 348   ;; sleep to ensure birthdays are no longer at current time
 349   ;(sleep 1) ;want to find the test that depends on it, put the sleep there.
 350
 351   #||
 352   ;; Lenin manages everyone             ;
 353   (clsql:add-to-relation employee2 'manager employee1)
 354   (clsql:add-to-relation employee3 'manager employee1)
 355   (clsql:add-to-relation employee4 'manager employee1)
 356   (clsql:add-to-relation employee5 'manager employee1)
 357   (clsql:add-to-relation employee6 'manager employee1)
 358   (clsql:add-to-relation employee7 'manager employee1)
 359   (clsql:add-to-relation employee8 'manager employee1)
 360   (clsql:add-to-relation employee9 'manager employee1)
 361   (clsql:add-to-relation employee10 'manager employee1)
 362   ;; Everyone works for Widgets Inc.    ;
 363   (clsql:add-to-relation company1 'employees employee1)
 364   (clsql:add-to-relation company1 'employees employee2)
 365   (clsql:add-to-relation company1 'employees employee3)
 366   (clsql:add-to-relation company1 'employees employee4)
 367   (clsql:add-to-relation company1 'employees employee5)
 368   (clsql:add-to-relation company1 'employees employee6)
 369   (clsql:add-to-relation company1 'employees employee7)
 370   (clsql:add-to-relation company1 'employees employee8)
 371   (clsql:add-to-relation company1 'employees employee9)
 372   (clsql:add-to-relation company1 'employees employee10)
 373   ;; Lenin is president of Widgets Inc. ;
 374   (clsql:add-to-relation company1 'president employee1)
 375   ||#
 376
 377   ;; store these instances
 378   #||
 379   (clsql:update-records-from-instance employee1)
 380   (clsql:update-records-from-instance employee2)
 381   (clsql:update-records-from-instance employee3)
 382   (clsql:update-records-from-instance employee4)
 383   (clsql:update-records-from-instance employee5)
 384   (clsql:update-records-from-instance employee6)
 385   (clsql:update-records-from-instance employee7)
 386   (clsql:update-records-from-instance employee8)
 387   (clsql:update-records-from-instance employee9)
 388   (clsql:update-records-from-instance employee10)
 389   (clsql:update-records-from-instance company1)
 390   (clsql:update-records-from-instance address1)
 391   (clsql:update-records-from-instance address2)
 392   ||#
 393   )
 394
 395
 396  (def-dataset *ds-employees*
 397    (:setup initialize-ds-employees)
 398    (:cleanup (lambda ()
 399                (mapc #'clsql-sys:drop-view-from-class
 400                      '(employee company address employee-address))
 401                (ignore-errors
 402                  (clsql-sys:execute-command "DROP TABLE ea_join")))))
 403