(:metaclass standard-db-class)
(:documentation "Superclass for all CLSQL View Classes."))
-(defvar *update-records-on-make-instance* nil
- "When T, UPDATE-RECORDS-FROM-INSTANCE will be automatically called
-when a new instance of a view-class is created.")
+(defvar *db-auto-sync* nil
+ "A non-nil value means that creating View Class instances or
+ setting their slots automatically creates/updates the
+ corresponding records in the underlying database.")
(defvar *db-deserializing* nil)
(defvar *db-initializing* nil)
(setf (slot-value instance slot-name) nil))))))
(call-next-method))
-#+ignore ;; not currently used
(defmethod (setf slot-value-using-class) (new-value (class standard-db-class)
- instance slot)
- (declare (ignore new-value instance slot))
- (call-next-method))
+ instance slot-def)
+ (declare (ignore new-value))
+ (let ((slot-name (%svuc-slot-name slot-def))
+ (slot-kind (view-class-slot-db-kind slot-def)))
+ (call-next-method)
+ (when (and *db-auto-sync*
+ (not *db-initializing*)
+ (not *db-deserializing*)
+ (not (eql slot-kind :virtual)))
+ (update-record-from-slot instance slot-name))))
(defmethod initialize-instance ((object standard-db-object)
&rest all-keys &key &allow-other-keys)
(declare (ignore all-keys))
(let ((*db-initializing* t))
(call-next-method)
- (when (and *update-records-on-make-instance*
+ (when (and *db-auto-sync*
(not *db-deserializing*))
- #+nil (created-object object)
(update-records-from-instance object))))
;;
(let* ((class-name (class-name vclass))
(db-vals (butlast vals (- (list-length vals)
(list-length selects))))
- (*db-initializing* t)
(obj (make-instance class-name :view-database database)))
;; use refresh keyword here
(setf obj (get-slot-values-from-view obj (mapcar #'car selects)
(car objects)
objects))))
(let* ((*db-deserializing* t)
- (*default-database* (or database
- (error 'clsql-base::clsql-no-database-error :database nil)))
(sclasses (mapcar #'find-class view-classes))
(sels (mapcar #'generate-selection-list sclasses))
(fullsels (apply #'append sels))
:initarg :height)
(married :db-kind :base :accessor married :type boolean
:initarg :married)
- (birthday :type clsql-base:wall-time :initarg :birthday)
+ (birthday :type clsql:wall-time :initarg :birthday)
(hobby :db-kind :virtual :initarg :hobby :initform nil)))
(def-view-class employee (person)
(clsql:create-view-from-class 'address)
(clsql:create-view-from-class 'employee-address))
- (let ((*update-records-on-make-instance* t))
+ (let ((*db-auto-sync* t))
(setf company1 (make-instance 'company
:presidentid 1
:companyid 1
:groupid 1
:married t
:height (1+ (random 1.00))
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Vladamir"
:last-name "Lenin"
:email "lenin@soviet.org"
:groupid 1
:height (1+ (random 1.00))
:married t
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Josef"
:last-name "Stalin"
:email "stalin@soviet.org"
:groupid 1
:height (1+ (random 1.00))
:married t
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Leon"
:last-name "Trotsky"
:email "trotsky@soviet.org"
:groupid 1
:height (1+ (random 1.00))
:married nil
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Nikita"
:last-name "Kruschev"
:email "kruschev@soviet.org"
:groupid 1
:married nil
:height (1+ (random 1.00))
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Leonid"
:last-name "Brezhnev"
:email "brezhnev@soviet.org"
:groupid 1
:married nil
:height (1+ (random 1.00))
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Yuri"
:last-name "Andropov"
:email "andropov@soviet.org"
:groupid 1
:height (1+ (random 1.00))
:married nil
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Konstantin"
:last-name "Chernenko"
:email "chernenko@soviet.org"
:groupid 1
:height (1+ (random 1.00))
:married nil
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Mikhail"
:last-name "Gorbachev"
:email "gorbachev@soviet.org"
:groupid 1
:married nil
:height (1+ (random 1.00))
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Boris"
:last-name "Yeltsin"
:email "yeltsin@soviet.org"
:groupid 1
:married nil
:height (1+ (random 1.00))
- :birthday (clsql-base:get-time)
+ :birthday (clsql:get-time)
:first-name "Vladamir"
:last-name "Putin"
:email "putin@soviet.org"
******************************************************************************
"
report-type
- (clsql-base:format-time
+ (clsql:format-time
nil
- (clsql-base:utime->time (get-universal-time)))
+ (clsql:utime->time (get-universal-time)))
(lisp-implementation-type)
(lisp-implementation-version)
(machine-type)
;; relations of intervals
(deftest :time/1
- (let* ((time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))
- (interval-1 (clsql-base:make-interval :start time-1 :end time-2))
- (interval-2 (clsql-base:make-interval :start time-2 :end time-3))
- (interval-3 (clsql-base:make-interval :start time-3 :end time-4))
- (interval-4 (clsql-base:make-interval :start time-1 :end time-3))
- (interval-5 (clsql-base:make-interval :start time-2 :end time-4))
- (interval-6 (clsql-base:make-interval :start time-1 :end time-4)))
+ (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
+ (interval-1 (clsql:make-interval :start time-1 :end time-2))
+ (interval-2 (clsql:make-interval :start time-2 :end time-3))
+ (interval-3 (clsql:make-interval :start time-3 :end time-4))
+ (interval-4 (clsql:make-interval :start time-1 :end time-3))
+ (interval-5 (clsql:make-interval :start time-2 :end time-4))
+ (interval-6 (clsql:make-interval :start time-1 :end time-4)))
(flet ((my-assert (number relation i1 i2)
(declare (ignore number))
- (let ((found-relation (clsql-base:interval-relation i1 i2)))
+ (let ((found-relation (clsql:interval-relation i1 i2)))
(equal relation found-relation))))
(and
(my-assert 1 :contains interval-1 interval-1)
;; adjacent intervals in list
(deftest :time/2
(let* ((interval-list nil)
- (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")))
+ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
(setf interval-list
- (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-3
+ (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
:type :open)))
(setf interval-list
- (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-3 :end time-4
+ (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
:type :open)))
- (clsql-base:interval-relation (car interval-list) (cadr interval-list)))
+ (clsql:interval-relation (car interval-list) (cadr interval-list)))
:precedes)
;; nested intervals in list
(deftest :time/3
(let* ((interval-list nil)
- (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")))
+ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
(setf interval-list
- (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1
+ (clsql:interval-push interval-list (clsql:make-interval :start time-1
:end time-4
:type :open)))
(setf interval-list
- (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2
+ (clsql:interval-push interval-list (clsql:make-interval :start time-2
:end time-3
:type :closed)))
(let* ((interval (car interval-list))
(interval-contained
- (when interval (car (clsql-base:interval-contained interval)))))
+ (when interval (car (clsql:interval-contained interval)))))
(when (and interval interval-contained)
- (and (clsql-base:time= (clsql-base:interval-start interval) time-1)
- (clsql-base:time= (clsql-base:interval-end interval) time-4)
- (eq (clsql-base:interval-type interval) :open)
- (clsql-base:time= (clsql-base:interval-start interval-contained) time-2)
- (clsql-base:time= (clsql-base:interval-end interval-contained) time-3)
- (eq (clsql-base:interval-type interval-contained) :closed)))))
+ (and (clsql:time= (clsql:interval-start interval) time-1)
+ (clsql:time= (clsql:interval-end interval) time-4)
+ (eq (clsql:interval-type interval) :open)
+ (clsql:time= (clsql:interval-start interval-contained) time-2)
+ (clsql:time= (clsql:interval-end interval-contained) time-3)
+ (eq (clsql:interval-type interval-contained) :closed)))))
t)
;; interval-edit - nonoverlapping
(deftest :time/4
(let* ((interval-list nil)
- (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-2 :type :open)))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-3 :end time-4 :type :closed)))
- (setf interval-list (clsql-base:interval-edit interval-list time-1 time-1 time-3))
+ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
+ (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
;; should be time-3 not time-2
- (clsql-base:time= (clsql-base:interval-end (car interval-list)) time-3))
+ (clsql:time= (clsql:interval-end (car interval-list)) time-3))
t)
;; interval-edit - overlapping
(deftest :time/5
(let* ((interval-list nil)
- (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00")))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-2 :type :open)))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2 :end time-4 :type :closed)))
+ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
(let ((pass t))
(handler-case
(progn
(setf interval-list
- (clsql-base:interval-edit interval-list time-1 time-1 time-3))
+ (clsql:interval-edit interval-list time-1 time-1 time-3))
(setf pass nil))
(error nil))
pass))
;; interval-edit - nested intervals in list
(deftest :time/6
(let* ((interval-list nil)
- (time-1 (clsql-base:parse-timestring "2002-01-01 10:00:00"))
- (time-2 (clsql-base:parse-timestring "2002-01-01 11:00:00"))
- (time-3 (clsql-base:parse-timestring "2002-01-01 12:00:00"))
- (time-4 (clsql-base:parse-timestring "2002-01-01 13:00:00"))
- (time-5 (clsql-base:parse-timestring "2002-01-01 14:00:00"))
- (time-6 (clsql-base:parse-timestring "2002-01-01 15:00:00")))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-1 :end time-6 :type :open)))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-2 :end time-3 :type :closed)))
- (setf interval-list (clsql-base:interval-push interval-list (clsql-base:make-interval :start time-4 :end time-5 :type :closed)))
- (setf interval-list (clsql-base:interval-edit interval-list time-1 time-1 time-4))
+ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
+ (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
+ (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
+ (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
+ (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
+ (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
+ (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
+ (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
;; should be time-4 not time-6
- (clsql-base:time= (clsql-base:interval-end (car interval-list)) time-4))
+ (clsql:time= (clsql:interval-end (car interval-list)) time-4))
t)
;; Test the boundaries of Local Time with granularity of 1 year
(deftest :time/7
(let ((sec-in-year (* 60 60 24 365))
- (year (clsql-base:time-element (clsql-base:make-time) :year)))
+ (year (clsql:time-element (clsql:make-time) :year)))
(dotimes (n 50 n)
- (let ((date (clsql-base:make-time :second (* n sec-in-year))))
+ (let ((date (clsql:make-time :second (* n sec-in-year))))
(unless (= (+ year n)
- (clsql-base:time-element date :year))
+ (clsql:time-element date :year))
(return n)))))
50)
(let ((second-in-year (* 60 60 24 365)))
(dotimes (n 2000 n)
(let* ((second (* -1 n second-in-year))
- (date (clsql-base:make-time :year 2525 :second second)))
+ (date (clsql:make-time :year 2525 :second second)))
(unless
- (= (grab-year (clsql-base:db-timestring date))
- (clsql-base:time-element date :year))
+ (= (grab-year (clsql:db-timestring date))
+ (clsql:time-element date :year))
(return n))))))
2000)
;; Conversion between MJD and Gregorian
(deftest :time/10
(dotimes (base 10000 base)
- (unless (= (apply #'clsql-base:gregorian-to-mjd (clsql-base:mjd-to-gregorian base))
+ (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
base)
(return base)))
10000)
-;; Clsql-Base:Roll by minutes: +90
+;; Clsql:Roll by minutes: +90
(deftest :time/11
- (let ((now (clsql-base:get-time)))
- (clsql-base:time= (clsql-base:time+ now (clsql-base:make-duration :minute 90))
- (clsql-base:roll now :minute 90)))
+ (let ((now (clsql:get-time)))
+ (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
+ (clsql:roll now :minute 90)))
t)
-;;Clsql-Base:Roll by minutes: +900
+;;Clsql:Roll by minutes: +900
(deftest :time/12
- (let ((now (clsql-base:get-time)))
- (clsql-base:time= (clsql-base:time+ now (clsql-base:make-duration :minute 900))
- (clsql-base:roll now :minute 900)))
+ (let ((now (clsql:get-time)))
+ (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
+ (clsql:roll now :minute 900)))
t)
-;; Clsql-Base:Roll by minutes: +900
+;; Clsql:Roll by minutes: +900
(deftest :time/13
- (let* ((now (clsql-base:get-time))
- (add-time (clsql-base:time+ now (clsql-base:make-duration :minute 9000)))
- (roll-time (clsql-base:roll now :minute 9000)))
- (clsql-base:time= add-time roll-time))
+ (let* ((now (clsql:get-time))
+ (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
+ (roll-time (clsql:roll now :minute 9000)))
+ (clsql:time= add-time roll-time))
t)
))