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