A few non-functional cleanups.
authorFrancois-Rene Rideau <tunes@google.com>
Thu, 10 Oct 2013 17:27:27 +0000 (13:27 -0400)
committerFrancois-Rene Rideau <tunes@google.com>
Thu, 10 Oct 2013 17:30:58 +0000 (13:30 -0400)
TODO
qmynd.asd
src/api.lisp
src/common/date-time.lisp
src/common/utilities.lisp
src/mysql-protocol/define-packet.lisp
src/mysql-protocol/handshake.lisp
src/pkgdcl.lisp
tests/qmynd-test.asd

diff --git a/TODO b/TODO
index f32c267..f17c4ff 100644 (file)
--- a/TODO
+++ b/TODO
@@ -9,9 +9,13 @@ Cleanup:
 • Replace ASSERT with conditions.
 • Drop “mysql-” prefix from everything: this is a MySQL driver, so
    it's redundant.
+• Replace qtest by 5am or stefil, etc.
 
-Convenience
+Convenience:
 • Convenience functions for toggling bits in status and capability.
 
-Query Results
+Query Results:
 • Row at a time result processing
+
+Good Citizenship:
+• export AF_LOCAL functionality to usocket
index b00f9b4..a457f11 100644 (file)
--- a/qmynd.asd
+++ b/qmynd.asd
@@ -8,9 +8,7 @@
 ;;;                                                                  ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(in-package "CL-USER")
-
-(asdf:defsystem :qmynd
+(defsystem :qmynd
   :name "MySQL Native Driver"
   :author "Alejandro Sedeño"
   :version "1.0"
@@ -23,7 +21,8 @@
                :ironclad
                :list-of
                :trivial-gray-streams
-               :usocket)
+               :usocket
+               #-asdf3 :uiop)
   :weakly-depends-on (:cl+ssl :chipz :salza2)
   :around-compile "asdf-finalizers:check-finalizers-around-compile"
   :serial nil
@@ -87,6 +86,6 @@
                                    (:file "prepared-statement"
                                     :depends-on ("binary-protocol-encoding"))))))
        (:file "api"
-        :depends-on ("mysql-protocol"))))))
-
-(pushnew :qmynd *features*)
+        :depends-on ("mysql-protocol")))))
+  :in-order-to ((test-op (load-op :qmynd-test)))
+  :perform (test-op :after (o c) (funcall (read-from-string "qmynd-test::run-all-tests"))))
index a8eda2c..9489655 100644 (file)
@@ -11,7 +11,7 @@
 (in-package :qmynd-impl)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Conncetion entry-point
+;;; Connection entry-point
 (defun mysql-connect (&key (host "localhost") (port 3306) (username "") (password "") database (ssl :unspecified) ssl-verify)
   "Connect to a MySQL over a network (AF_INET) socket and begin the MySQL Handshake.
    Returns a QMYND:MYSQL-CONNECTION object or signals a QMYND:MYSQL-ERROR.
index 5a45519..23a5718 100644 (file)
 (defun parse-time-interval-string (str)
   "Parses the MySQL Text Protocol represetation of a time interval.
    /(-)?(h+):(mm):(ss).(µµµµµµ)/"
-  (let ((negativep (starts-with str "-")))
+  (let ((negativep (string-prefix-p "-" str)))
     (multiple-value-bind (hours end)
         (parse-integer str :start (if negativep 1 0) :junk-allowed t)
       (multiple-value-bind (days hours)
index a787525..c65b42b 100644 (file)
   `(the fixnum (ldb ,bytespec (the fixnum ,value))))
 
 
-;;; String utilities
-
-(defun starts-with (string prefix &key (start 0))
-  "Returns true if 'string' starts with the prefix 'prefix' (case insensitive)."
-  (and (i>= (length string) (i+ start (length prefix)))
-       (string-equal string prefix :start1 start :end1 (i+ start (length prefix)))
-       prefix))
-
-(defun ends-with (string suffix &key (end (length string)))
-  "Returns true if 'string' ends with the prefix 'prefix' (case insensitive)."
-  (and (i>= end (length suffix))
-       (string-equal string suffix :start1 (i- end (length suffix)) :end1 end)
-       suffix))
-
-(defun strcat (&rest strings)
-  "Concatenate a bunch of strings."
-  (declare (dynamic-extent strings))
-  (apply #'concatenate 'string strings))
-
-
 ;;; Managing symbols
 
 (defmacro with-gensyms ((&rest bindings) &body body)
         (t nil)))
 
 
-;;; Collectors, etc
-
-(defmacro with-collectors ((&rest collection-descriptions) &body body)
-  "'collection-descriptions' is a list of clauses of the form (coll function).
-   The body can call each 'function' to add a value to 'coll'. 'function'
-   runs in constant time, regardless of the length of the list."
-  (let ((let-bindings  ())
-        (flet-bindings ())
-        (dynamic-extents ())
-        (vobj '#:OBJECT))
-    (dolist (description collection-descriptions)
-      (destructuring-bind (place name) description
-        (let ((vtail (make-symbol (format nil "~A-TAIL" place))))
-          (setq dynamic-extents
-                (nconc dynamic-extents `(#',name)))
-          (setq let-bindings
-                (nconc let-bindings
-                       `((,place ())
-                         (,vtail nil))))
-          (setq flet-bindings
-                (nconc flet-bindings
-                       `((,name (,vobj)
-                           (setq ,vtail (if ,vtail
-                                          (setf (cdr ,vtail)  (list ,vobj))
-                                          (setf ,place (list ,vobj)))))))))))
-    `(let (,@let-bindings)
-       (flet (,@flet-bindings)
-         ,@(and dynamic-extents
-                `((declare (dynamic-extent ,@dynamic-extents))))
-         ,@body))))
+;;; with-prefixed-accessors
 
 (defmacro with-prefixed-accessors (names (prefix object) &body body)
   `(with-accessors (,@(loop for name in names
   (let ((start 0)
         (sign 1)
         found-decimal)
-    (when (starts-with str "-")
+    (when (string-prefix-p "-" str)
       (setq start 1
             sign -1))
     (loop
index 67e62cd..10d9907 100644 (file)
@@ -250,9 +250,9 @@ Order of Operations:
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Entry point macro
 (defmacro define-packet (name slots)
-  (let ((parser-name (fintern "PARSE-~A" name))
-        (struct-name (fintern "~A-PACKET" name))
-        (struct-constructor (fintern "MAKE-~A-PACKET" name))
+  (let ((parser-name (fintern "~A-~A" 'parse name))
+        (struct-name (fintern "~A-~A" name 'packet))
+        (struct-constructor (fintern "~A-~A-~A" 'make name 'packet))
         (slot-descriptors (mapcar #'parse-slot slots)))
       `(progn
          ;; Define a struct to hold non-transient data
@@ -261,6 +261,6 @@ Order of Operations:
          ;; Define a parser to parse a payload of this form and populate the struct
          ,(emit-packet-parser parser-name struct-constructor slot-descriptors)
          ;; Define a writer to generate a packet payload of this type from the struct
-         #| Implement writer here |#
+         #| Implement writer here (only needed for servers, not for mere clients) |#
          ;;
          ',name)))
index eb69a18..84a3aa8 100644 (file)
        stream))
     (setf (mysql-connection-stream *mysql-connection*) stream)))
 
-;; We don't actually receive a Handshake Response packet as a client, but it looks like this.
+;; We won't receive a Handshake Response packet (being a client only, not a server), but it looks like this.
 
 ;; (define-packet handshake-response-v41
 ;;   ((capability-flags :mysql-type (integer 4))
index 0851e39..1d74e38 100644 (file)
@@ -87,6 +87,9 @@
 
 (defpackage qmynd-impl
   (:use :common-lisp :list-of :qmynd)
+  (:import-from :uiop
+   #:strcat
+   #:string-prefix-p)
 
   (:export
    ;; Dynamic Variables
 
    ;; Auth Stuff
    #:generate-auth-response
-   #+mysql-insecure-password-hash
-   #:mysql-weak-hash-password
+   #+mysql-insecure-password-hash #:mysql-weak-hash-password
    #:mysql-native-password-auth-response
    #:mysql-clear-password-auth-response
 
index f21d1e2..4637bc0 100644 (file)
@@ -8,9 +8,6 @@
 ;;;                                                                  ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(in-package "CL-USER")
-
-
 (asdf:defsystem :qmynd-test
   :name "MySQL Native Driver - Test Suite"
   :author "Alejandro Sedeño"
@@ -30,7 +27,7 @@
               :serial nil
               :pathname #p""
               :depends-on ("packages")
-              :components ((:file "qtest")))
+              :components (#-test-tools (:file "qtest")))
      (:module "parsing"
               :serial nil
               :pathname #p""
@@ -42,5 +39,3 @@
               :pathname #p""
               :depends-on ("common")
               :components ((:file "binary-encoding")))))
-
-(pushnew :cl-qmynd *features*)