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