From cdbc736cd414e9aaf37a093ca4e446412b20a124 Mon Sep 17 00:00:00 2001
From: Bert Burgemeister <trebbu@googlemail.com>
Date: Fri, 14 Jul 2017 13:24:43 +0200
Subject: [PATCH] Revert last commit; preserve case of generic-device-id

---
 image-reader.lisp | 12 ++++++++----
 phoros.asd        |  2 +-
 stuff-db.lisp     |  6 +++---
 3 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/image-reader.lisp b/image-reader.lisp
index 1528cb5..a02d5ad 100644
--- a/image-reader.lisp
+++ b/image-reader.lisp
@@ -41,8 +41,10 @@ start-position is explicitly nil."
                                        most-positive-fixnum)))
       (loop
          for chunk-start-in-stream from start-position to end-position-in-stream by chunk-max-size
-         for chunk-size = (progn (file-position stream chunk-start-in-stream)
-                                 (read-sequence chunk stream))
+         for chunk-size = (let ((*readtable* (copy-readtable)))
+                            (setf (readtable-case *readtable*) :preserve)
+                            (file-position stream chunk-start-in-stream)
+                            (read-sequence chunk stream))
          for end-in-chunk = (min chunk-size (- end-position-in-stream
                                                chunk-start-in-stream))
          while (plusp chunk-size)
@@ -62,8 +64,10 @@ start-position is explicitly nil."
          (find-keyword path keyword start-position search-range)))
     (when start-of-value
       (with-open-file (stream path)
-        (file-position stream start-of-value)
-        (car (read-delimited-list #\; stream))))))
+        (let ((*readtable* (copy-readtable)))
+          (setf (readtable-case *readtable*) :preserve)
+          (file-position stream start-of-value)
+          (car (read-delimited-list #\; stream)))))))
 
 (defun find-keyword (path keyword &optional (start-position 0) search-range)
   "Return file-position after keyword."
diff --git a/phoros.asd b/phoros.asd
index aa3bfec..470b11b 100644
--- a/phoros.asd
+++ b/phoros.asd
@@ -21,7 +21,7 @@ it available over a web interface."
   ;; There should be a corresponding git tag which marks the point this
   ;; version number becomes official.
 
-  "14.2.5"
+  "14.2.6"
 
   :licence                              ;goes with --licence output
   "Copyright (C) 2010, 2011, 2012, 2015, 2016, 2017 Bert Burgemeister
diff --git a/stuff-db.lisp b/stuff-db.lisp
index 3940f52..2dca0a1 100644
--- a/stuff-db.lisp
+++ b/stuff-db.lisp
@@ -53,7 +53,7 @@ picture-headers of the .pictures file in path."
                               path "cameraTimestamp=" picture-start
                               estimated-header-length)
              and recorded-device-id = (format
-                                       nil "~S"
+                                       nil "~A"
                                        (img:find-keyword-value
                                         path "cam=" picture-start
                                         estimated-header-length))
@@ -363,7 +363,7 @@ recorded-device-id (a string) of camera (etc.)"
                            (:set 'mounting-date
                                  (:least :current-date 'unmounting-date))
                            (:set (:date date) (:date date)))
-                          (:ilike 'recorded-device-id recorded-device-id))))))
+                          (:= 'recorded-device-id recorded-device-id))))))
             (assert device-stage-of-life
                     ()
                     "Can't figure out what event-number belongs to ~
@@ -823,7 +823,7 @@ no images."
                                                       'point-id)))))))))
 
 (defun delete-all-imageless-points (postgresql-credentials)
-  "Asynchronously delete imageless footprints of all acquisition
+  "Asynchronously delete imageless points of all acquisition
 projects."
   (let ((common-table-names
          (with-restarting-connection postgresql-credentials
-- 
2.11.4.GIT