From: Kevin M. Rosenberg Date: Wed, 3 May 2006 14:39:10 +0000 (+0000) Subject: r10922: 03 May 2006 Kevin Rosenberg X-Git-Tag: v3.8.6~83 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=78489032c6f66ce666ffe5e2e726503b61b94616;hp=16cede958e7f229e2502ab6309591e344bee54f5 r10922: 03 May 2006 Kevin Rosenberg * Version 3.5.7 * sql/time.lisp: Apply patch from Aleksandar Bakic to extended duration parsing and unparsing to include year and month. * clsql-uffi.asd, uffi/clsql-uffi-loader.lisp: Apply patch from Nathan Bird improving library search on Windows platform. * doc/ref-fdml.xml, /doc/TODO, tests/test-fdml.lisp, tests/test-init.lisp: Apply patch from Marcus Pearce documenting and testing :limit and :offset for SELECT --- diff --git a/ChangeLog b/ChangeLog index 87172f2..9b213c8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +03 May 2006 Kevin Rosenberg + * Version 3.5.7 + * sql/time.lisp: Apply patch from Aleksandar Bakic to extended + duration parsing and unparsing to include year and month. + * clsql-uffi.asd, uffi/clsql-uffi-loader.lisp: Apply patch from Nathan Bird + improving library search on Windows platform. + * doc/ref-fdml.xml, /doc/TODO, tests/test-fdml.lisp, tests/test-init.lisp: + Apply patch from Marcus Pearce documenting and testing :limit and :offset for SELECT + 20 Mar 2006 Kevin Rosenberg * Version 3.5.6 * clsql-postgresql-socket.asd, diff --git a/clsql-uffi.asd b/clsql-uffi.asd index 48372a1..19b9fb4 100644 --- a/clsql-uffi.asd +++ b/clsql-uffi.asd @@ -21,8 +21,9 @@ (defpackage clsql-uffi-system (:use #:asdf #:cl)) (in-package clsql-uffi-system) -(defvar *library-file-dir* (append (pathname-directory *load-truename*) - (list "uffi"))) +(defvar *clsql-uffi-library-dir* + (merge-pathnames "uffi/" + (make-pathname :name nil :type nil :defaults *load-truename*))) (defclass clsql-uffi-source-file (c-source-file) ()) @@ -43,7 +44,7 @@ found (make-pathname :name (component-name c) :type library-file-type - :directory *library-file-dir*))))) + :defaults *clsql-uffi-library-dir*))))) (defmethod perform ((o load-op) (c clsql-uffi-source-file)) nil) ;;; library will be loaded by a loader file @@ -59,9 +60,7 @@ (unless (zerop (run-shell-command #-freebsd "cd ~A; make" #+freebsd "cd ~A; gmake" - (namestring (make-pathname :name nil - :type nil - :directory *library-file-dir*)))) + (namestring *clsql-uffi-library-dir*))) (error 'operation-error :component c :operation o)))) (defmethod operation-done-p ((o compile-op) (c clsql-uffi-source-file)) diff --git a/debian/changelog b/debian/changelog index 9ac6c70..ce66a8c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (3.5.7-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Wed, 3 May 2006 07:50:05 -0600 + cl-sql (3.5.6-3) unstable; urgency=low * Rebuild to update library dependencies (closes: 361849) diff --git a/doc/TODO b/doc/TODO index 3a4dae9..36b1fd6 100644 --- a/doc/TODO +++ b/doc/TODO @@ -12,8 +12,7 @@ DOCUMENTATION TO DO LIST - SQL operators: group-by, limit, not-null, ==, is, having, the, uplike, view-class, coalesce, except, exists, substring, concat - - SELECT: additional keyword arguments accepted include :LIMIT, :OFFSET, - :INNER-JOIN and :ON. + - SELECT: additional keyword arguments accepted include :INNER-JOIN and :ON. 4. Documenting lower level, non-CommonSQL functions (some of this is already done). diff --git a/doc/ref-fdml.xml b/doc/ref-fdml.xml index c512cdb..a5162ff 100644 --- a/doc/ref-fdml.xml +++ b/doc/ref-fdml.xml @@ -1188,6 +1188,22 @@ ID FORENAME SURNAME EMAIL + + limit + + + A non-negative integer. + + + + + offset + + + A non-negative integer. + + + order-by @@ -1341,8 +1357,8 @@ ID FORENAME SURNAME EMAIL specified lisp type. The keyword arguments all, distinct, from, group-by, - having, - order-by, + having, limit, + offset, order-by, set-operation and where are used to specify, using the symbolic SQL syntax, the corresponding components of the SQL @@ -1423,7 +1439,7 @@ ID FORENAME SURNAME EMAIL :result-types :auto) => (10) -(clsql:select [avg [height]] :from [employee] :flatp t :field-names nil) +(select [avg [height]] :from [employee] :flatp t :field-names nil) => (1.58999584d0) (select [emplid] [last-name] :from [employee] :where [= [emplid] 1]) @@ -1442,13 +1458,21 @@ ID FORENAME SURNAME EMAIL :flatp t) => (1 2 3 4) -(clsql:select [emplid] :from [employee] - :where [in [emplid] '(1 2 3 4)] - :flatp t - :order-by [emplid] - :field-names nil) +(select [emplid] :from [employee] + :where [in [emplid] '(1 2 3 4)] + :flatp t + :order-by [emplid] + :field-names nil) => (1 2 3 4) +(select [emplid] :from [employee] + :order-by [emplid] + :limit 5 + :offset 3 + :field-names nil + :flatp t) +=> (4 5 6 7 8) + (select [first-name] [last-name] :from [employee] :field-names nil :order-by '(([first-name] :asc) ([last-name] :desc))) diff --git a/sql/db-interface.lisp b/sql/db-interface.lisp index 298214a..10b25d9 100644 --- a/sql/db-interface.lisp +++ b/sql/db-interface.lisp @@ -476,4 +476,4 @@ for foreign libraries \(in addition to the default places).") (defun push-library-path (path) "Adds the pathspec PATH \(which should denote a directory) to the list *FOREIGN-LIBRARY-SEARCH-PATHS*." - (push path *foreign-library-search-paths*)) \ No newline at end of file + (pushnew path *foreign-library-search-paths* :test #'equal)) diff --git a/sql/time.lisp b/sql/time.lisp index e045258..22fd87b 100644 --- a/sql/time.lisp +++ b/sql/time.lisp @@ -104,8 +104,10 @@ (let ((second (duration-second duration)) (minute (duration-minute duration)) (hour (duration-hour duration)) - (day (duration-day duration))) - (format nil "P~dD~dH~dM~dS" day hour minute second))) + (day (duration-day duration)) + (month (duration-month duration)) + (year (duration-year duration))) + (format nil "P~dY~dM~dD~dH~dM~dS" year month day hour minute second))) ;; ------------------------------------------------------------ @@ -878,10 +880,10 @@ with the given options" (third (mjd-to-gregorian (time-mjd (get-time))))) (defun current-month () - (second (mjd-to-gregorian (time-mjd (get-time))))) + (first (mjd-to-gregorian (time-mjd (get-time))))) (defun current-day () - (first (mjd-to-gregorian (time-mjd (get-time))))) + (second (mjd-to-gregorian (time-mjd (get-time))))) (defun parse-date-time (string) "parses date like 08/08/01, 8.8.2001, eg" @@ -1002,6 +1004,8 @@ with the given options" (minute (duration-minute duration)) (hour (duration-hour duration)) (day (duration-day duration)) + (month (duration-month duration)) + (year (duration-year duration)) (return (null stream)) (stream (or stream (make-string-output-stream)))) (ecase precision @@ -1013,10 +1017,20 @@ with the given options" (setf second 0)) (:second t)) - (if (= 0 day hour minute) + (if (= 0 year month day hour minute) (format stream "0 minutes") (let ((sent? nil)) + (when (< 0 year) + (format stream "~d year~p" year year) + (setf sent? t)) + (when (< 0 month) + (when sent? + (write-char #\Space stream)) + (format stream "~d month~p" month month) + (setf sent? t)) (when (< 0 day) + (when sent? + (write-char #\Space stream)) (format stream "~d day~p" day day) (setf sent? t)) (when (< 0 hour) @@ -1201,42 +1215,64 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi (defvar *iso-8601-duration-delimiters* - '((#\D . :days) + '((#\Y . :years) + (#\D . :days) (#\H . :hours) - (#\M . :minutes) + (#\M . :months/minutes) (#\S . :seconds))) (defun iso-8601-delimiter (elt) (cdr (assoc elt *iso-8601-duration-delimiters*))) -(defun iso-8601-duration-subseq (string start) - (let* ((pos (position-if #'iso-8601-delimiter string :start start)) - (number (when pos (parse-integer (subseq string start pos) - :junk-allowed t)))) +(defun iso-8601-duration-subseq (string end) + (let* ((pos (position-if #'iso-8601-delimiter string :end end :from-end t)) + (pos2 (when pos + (position-if-not #'digit-char-p string :end pos :from-end t))) + (number (when pos2 + (parse-integer + (subseq string (1+ pos2) pos) :junk-allowed t)))) (when number (values number (1+ pos) + (1+ pos2) (iso-8601-delimiter (aref string pos)))))) (defun parse-iso-8601-duration (string) "return a wall-time from a duration string" (block parse - (let ((days 0) (secs 0) (hours 0) (minutes 0) (index 1)) + (let ((years 0) + (months 0) + (days 0) + (secs 0) + (hours 0) + (minutes 0) + (index (length string)) + (months/minutes nil)) (loop (multiple-value-bind (duration next-index duration-type) (iso-8601-duration-subseq string index) (case duration-type + (:years + (incf years duration)) + (:months/minutes + (if months/minutes + (incf months duration) + (progn + (setq months/minutes t) + (incf minutes duration)))) + (:days + (setq months/minutes t) + (incf days duration)) (:hours + (setq months/minutes t) (incf hours duration)) - (:minutes - (incf minutes duration)) (:seconds (incf secs duration)) - (:days - (incf days duration)) (t - (return-from parse (make-duration :day days :hour hours - :minute minutes :second secs)))) + (return-from parse + (make-duration + :year years :month months :day days :hour hours + :minute minutes :second secs)))) (setf index next-index)))))) ;; e.g. 2000-11-11 00:00:00-06 diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp index d2606c1..0fbcb17 100644 --- a/tests/test-fdml.lisp +++ b/tests/test-fdml.lisp @@ -495,6 +495,23 @@ "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz" "foo\\bar\\baz")) +(deftest :fdml/select/37 + (clsql:select [emplid] :from [employee] + :order-by [emplid] + :limit 5 + :field-names nil + :flatp t) + (1 2 3 4 5)) + +(deftest :fdml/select/38 + (clsql:select [emplid] :from [employee] + :order-by [emplid] + :limit 5 + :offset 3 + :field-names nil + :flatp t) + (4 5 6 7 8)) + (deftest :fdml/do-query/1 (let ((result '())) (clsql:do-query ((name) [select [last-name] :from [employee] diff --git a/tests/test-init.lisp b/tests/test-init.lisp index d745ff0..5cdcb78 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -623,11 +623,14 @@ ((and (eq *test-database-underlying-type* :mssql) (clsql-sys:in test :fdml/select/9)) (push (cons test "mssql uses integer math for AVG") skip-tests)) + ((and (not (member *test-database-underlying-type* + '(:postgresql :mysql :sqlite3))) + (clsql-sys:in test :fdml/select/37 :fdml/select/38)) + (push (cons test "LIMIT keyword not supported in SELECT") skip-tests)) (t (push test-form test-forms))))) (values (nreverse test-forms) (nreverse skip-tests)))) - (defun rapid-load (type &optional (position 0)) "Rapid load for interactive testing." (when *default-database* diff --git a/uffi/clsql-uffi-loader.lisp b/uffi/clsql-uffi-loader.lisp index 1655ed2..084f66a 100644 --- a/uffi/clsql-uffi-loader.lisp +++ b/uffi/clsql-uffi-loader.lisp @@ -19,35 +19,33 @@ (in-package #:clsql-uffi) (defun find-and-load-foreign-library (filenames &key module supporting-libraries (errorp t)) - (setq filenames (if (listp filenames) filenames (list filenames)) - filenames - (append - (loop for search-path in clsql:*foreign-library-search-paths* - nconc (loop for filename in filenames - collect (merge-pathnames filename search-path))) - filenames)) - (or (loop for type in (uffi:foreign-library-types) - for suffix = (make-pathname :type type) - thereis (loop for filename in filenames - thereis (handler-case - (uffi:load-foreign-library (merge-pathnames filename suffix) - :module module - :supporting-libraries supporting-libraries) - (error (c) - (warn "~A" c) - nil)))) - (when errorp - (error "Couldn't load foreign librar~@P ~{~S~^, ~}. (searched ~S)" - (length filenames) filenames - 'clsql:*foreign-library-search-paths*)))) + "Attempt to load a foreign library. This will search for any of the filenames, as +well as any of the filenames in any of the clsql:*foreign-library-search-paths*" + (setq filenames (if (listp filenames) filenames (list filenames))) + + (flet ((try-load (testpath) + (handler-case + (uffi:load-foreign-library testpath + :module module + :supporting-libraries supporting-libraries) + (error (c) (warn "~A" c) nil)))) + (or + (loop for type in (uffi:foreign-library-types) + thereis + (loop for name in filenames + for pn = (make-pathname :name name :type type) + thereis (or + (loop for search-path in clsql:*foreign-library-search-paths* + thereis (try-load (merge-pathnames pn search-path))) + (try-load pn)))) + (when errorp + (error "Couldn't load foreign librar~@P ~{~S~^, ~}. (searched ~S)" + (length filenames) filenames + 'clsql:*foreign-library-search-paths*))))) (defvar *clsql-uffi-library-filenames* - (list #+(or 64bit x86-64) "clsql_uffi64" - #+(or 64bit x86-64) (make-pathname :name "clsql_uffi64" - :directory clsql-uffi-system::*library-file-dir*) - "clsql_uffi" - (make-pathname :name "clsql_uffi" - :directory clsql-uffi-system::*library-file-dir*))) + (list #+(or 64bit x86-64) "clsql_uffi64" + "clsql_uffi")) (defvar *clsql-uffi-supporting-libraries* '("c") "Used only by CMU. List of library flags needed to be passed to ld to @@ -58,6 +56,7 @@ set to the right path before compiling or loading the system.") "T if foreign library was able to be loaded successfully") (defun load-uffi-foreign-library () + (clsql:push-library-path clsql-uffi-system::*clsql-uffi-library-dir*) (find-and-load-foreign-library *clsql-uffi-library-filenames* :module "clsql-uffi" :supporting-libraries @@ -65,4 +64,3 @@ set to the right path before compiling or loading the system.") (setq *uffi-library-loaded* t)) (load-uffi-foreign-library) -