12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
* Version 2.6.8
- * test/test-fddl.lisp: Cleanup fix from Marcus Pearce
-
+ * test/test-fddl.lisp: Cleanup fix [Marcus Pearce]
+ * utils/time.lisp: Multiple fixes [Marcus Pearce]
+ * sql/sql.lisp: Fix for truncate-database [Marcus Pearce]
+
12 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net)
* Version 2.6.7
* sql/*.lisp: Remove schema versioning cruft
;; duration specific
(defun duration-reduce (duration precision &optional round)
- (:second
- (+ (duration-second duration)
- (* (duration-reduce duration :minute) 60)))
- (:minute
- (+ (if round
- (floor (duration-second duration) 30)
- 0)
- (duration-minute duration)
- (* (duration-reduce duration :hour) 60)))
- (:hour
- (+ (if round
- (floor (duration-minute duration) 30)
- 0)
- (duration-hour duration)
- (* (duration-reduce duration :day) 24)))
- (:day
- (+ (if round
- (floor (duration-hour duration) 12)
- 0)
- (duration-day duration))))
+ (ecase precision
+ (:second
+ (+ (duration-second duration)
+ (* (duration-reduce duration :minute) 60)))
+ (:minute
+ (+ (if round
+ (floor (duration-second duration) 30)
+ 0)
+ (duration-minute duration)
+ (* (duration-reduce duration :hour) 60)))
+ (:hour
+ (+ (if round
+ (floor (duration-minute duration) 30)
+ 0)
+ (duration-hour duration)
+ (* (duration-reduce duration :day) 24)))
+ (:day
+ (+ (if round
+ (floor (duration-hour duration) 12)
+ 0)
+ (duration-day duration)))))
;; ------------------------------------------------------------
(when (and year (< 1500 year 2500))
(make-time :year year))))
+(defun parse-integer-insensitively (string)
+ (let ((start (position-if #'digit-char-p string))
+ (end (position-if #'digit-char-p string :from-end t)))
+ (when (and start end)
+ (parse-integer (subseq string start (1+ end)) :junk-allowed t))))
+
(defvar *roman-digits*
'((#\M . 1000)
(#\D . 500)
(defun extract-roman (string &aux parse)
(dotimes (x (length string))
- (when-bind (val (get-alist (aref string x) *roman-digits*))
- (when (and parse (< (car parse) val))
+ (let ((val (cdr (assoc (aref string x) *roman-digits*))))
+ (when (and val parse (< (car parse) val))
(push (- (pop parse)) parse))
(push val parse)))
(apply #'+ parse))
(clsql-base-sys::signal-no-database-error database))
(unless (is-database-open database)
(database-reconnect database))
- (dolist (table (list-tables database))
+ (dolist (table (list-tables :database database))
(drop-table table :database database))
- (dolist (index (list-indexes database))
+ (dolist (index (list-indexes :database database))
(drop-index index :database database))
- (dolist (seq (list-sequences database))
+ (dolist (seq (list-sequences :database database))
(drop-sequence seq :database database)))
(defun print-query (query-exp &key titles (formats t) (sizes t) (stream t)