stuff-db.lisp

   1 ;;; PHOROS -- Photogrammetric Road Survey
   2 ;;; Copyright (C) 2010, 2011, 2012 Bert Burgemeister
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 2 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License along
  15 ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  16 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18
  19 (in-package :phoros)
  20
  21 (defun collect-pictures-file-data (path)
  22   "Return vector of image-data objects containing data from the
  23 picture-headers of the .pictures file in path."
  24   (let ((estimated-header-length
  25          (ignore-errors
  26            (- (find-keyword path "PICTUREHEADER_END")
  27               (find-keyword path "PICTUREHEADER_BEGIN")
  28               *picture-header-length-tolerance*)))) ; allow for variation in dataSize and a few other parameters
  29     (if estimated-header-length ;otherwise we don't have a decent header
  30         (with-open-file (stream path :element-type 'unsigned-byte)
  31           (cl-log:log-message :db-dat "Digesting ~A." path)
  32           (loop
  33              with pictures-data = (make-array '(600) :fill-pointer 0)
  34              for picture-start =
  35              (find-keyword-in-stream stream "PICTUREHEADER_BEGIN" 0) then
  36              (find-keyword-in-stream stream "PICTUREHEADER_BEGIN"
  37                                      (+ picture-start picture-length
  38                                         estimated-header-length))
  39              for picture-length = (find-keyword-value
  40                                    path "dataSize=" picture-start
  41                                    estimated-header-length)
  42              and time-trigger = (utc-from-unix
  43                                  (or
  44                                   (find-keyword-value
  45                                    path "timeTrigger=" picture-start
  46                                    estimated-header-length)
  47                                   -1))
  48              and timestamp = (find-keyword-value
  49                               path "cameraTimestamp=" picture-start
  50                               estimated-header-length)
  51              and recorded-device-id = (format
  52                                        nil "~S"
  53                                        (find-keyword-value
  54                                         path "cam=" picture-start
  55                                         estimated-header-length))
  56              and gain = (find-keyword-value
  57                          path "gain=" picture-start estimated-header-length)
  58              and shutter = (find-keyword-value
  59                             path "shutter=" picture-start
  60                             estimated-header-length)
  61              while picture-start
  62              do (vector-push-extend
  63                  (make-instance
  64                   'image-data
  65                   :trigger-time time-trigger
  66                   :camera-timestamp timestamp
  67                   :recorded-device-id recorded-device-id
  68                   :filename (file-namestring path)
  69                   :footprint :null
  70                   :footprint-device-stage-of-life-id :null
  71                   :gain gain
  72                   :shutter shutter
  73                   :byte-position picture-start)
  74                  pictures-data)
  75              finally
  76              (repair-missing-trigger-times pictures-data)
  77              (return  pictures-data)))
  78         (cl-log:log-message
  79          :db-dat "Skipping ~A because it looks disgusting." path))))
  80
  81 (defun repair-missing-trigger-times (images)
  82   "Use slot camera-timestamp to fake missing trigger-times."
  83   (labels ((slope (offending-index good-index)
  84              (/ (- (trigger-time (aref images (+ offending-index
  85                                                  (- good-index 2))))
  86                    (trigger-time (aref images (+ offending-index
  87                                                  (+ good-index 2)))))
  88                 (- (camera-timestamp (aref images (+ offending-index
  89                                                      (- good-index 2))))
  90                    (camera-timestamp (aref images (+ offending-index
  91                                                      (+ good-index 2)))))))
  92            (intercept (offending-index good-index slope)
  93              (- (trigger-time (aref images (+ offending-index good-index)))
  94                 (* slope (camera-timestamp (aref images (+ offending-index
  95                                                            good-index))))))
  96            (fake-trigger-time (offending-index good-index)
  97              (let* ((m (slope offending-index good-index))
  98                     (t-0 (intercept offending-index good-index m)))
  99                (+ (* m (camera-timestamp (aref images offending-index)))
 100                   t-0))))
 101     (dolist (offending-index
 102               (loop
 103                  with previous-trigger-time = 0
 104                  for h across images
 105                  for i from 0
 106                  for trigger-time = (trigger-time h)
 107                  if (> (+ trigger-time 1d-4) previous-trigger-time)
 108                  do (setf previous-trigger-time trigger-time)
 109                  else collect i))
 110       (ignore-errors
 111         (let ((good-index-offset -3))
 112           (handler-bind ((error #'(lambda (x) (declare (ignore x))
 113                                           (invoke-restart 'next-try))))
 114             (setf (trigger-time (aref images offending-index))
 115                   (restart-case
 116                       (fake-trigger-time offending-index good-index-offset)
 117                     (next-try ()
 118                       (incf good-index-offset 6)
 119                       (fake-trigger-time offending-index good-index-offset)))
 120                   (fake-trigger-time-p (aref images offending-index)) t)))))))
 121
 122 (defun collect-pictures-directory-data (dir-path)
 123   "Return vector of instances of class image-data with data from the
 124 .pictures files in dir-path."
 125   (let ((pictures-files
 126          (directory (make-pathname
 127                      :directory (append (pathname-directory dir-path)
 128                                         '(:wild-inferiors))
 129                      :name :wild :type "pictures"))))
 130     (assert pictures-files ()
 131             "Sorry, but I couldn't find a single .pictures file below ~A."
 132             dir-path)
 133     (reduce #'(lambda (x1 x2) (merge 'vector x1 x2 #'< :key #'trigger-time))
 134             (mapcar #'collect-pictures-file-data
 135                     pictures-files))))
 136
 137 (defun collect-gps-data (dir-path estimated-utc)
 138   "Put content of files in dir-path/**/applanix/*eventN.txt into
 139 vectors.  Return a list of elements (N vector) where N is the event
 140 number."
 141   (let* ((event-dir
 142           (make-pathname
 143            :directory (append (pathname-directory dir-path)
 144                               '(:wild-inferiors) '("applanix" "points"))
 145            :name :wild
 146            :type :wild))
 147          (gps-files (directory event-dir))
 148          (gps-event-files
 149           (loop
 150              for gps-file in gps-files
 151              for gps-basename = (pathname-name gps-file)
 152              for event-number = (ignore-errors
 153                                   (subseq gps-basename
 154                                           (mismatch
 155                                            gps-basename "event"
 156                                            :start1
 157                                            (search "event" gps-basename
 158                                                    :from-end t))))
 159              when event-number collect (list event-number gps-file))))
 160     (assert gps-event-files ()
 161             "Sorry, but I couldn't find a single GPS event file in ~A."
 162             (directory-namestring event-dir))
 163     (cl-log:log-message
 164      :db-dat "Digesting GPS data from ~{~A~#^, ~}."
 165      (mapcar #'cadr gps-event-files))
 166     (loop
 167        for gps-event-file-entry in gps-event-files
 168        for gps-event-number = (first gps-event-file-entry)
 169        for gps-event-file = (second gps-event-file-entry)
 170        collect
 171        (cons
 172         gps-event-number
 173         (with-open-file (stream gps-event-file)
 174           (loop
 175              for line = (read-line stream)
 176              for i from 0 to 35
 177              until (string-equal
 178                     (string-trim " 
" line)
 179                     "(time in Sec, distance in Meters, position in Meters, lat, long in Degrees, orientation angles and SD in Degrees, velocity in Meter/Sec, position SD in Meters)")
 180              finally
 181                (read-line stream)
 182              (assert (< i 35) ()
 183                      "Unfamiliar header.  Check Applanix file format." nil))
 184           (loop
 185              with gps-points = (make-array '(1000) :fill-pointer 0)
 186              for line = (read-line stream nil)
 187              while line
 188              do (vector-push-extend
 189                  (let ((point (make-instance 'point-data)))
 190                    (with-slots
 191                          (gps-time
 192                           event-number
 193                           longitude latitude ellipsoid-height
 194                           roll pitch heading
 195                           east-velocity north-velocity up-velocity
 196                           east-sd north-sd height-sd
 197                           roll-sd pitch-sd heading-sd
 198                           easting northing cartesian-height)
 199                        point
 200                      (with-input-from-string (line-content line)
 201                        (setf event-number gps-event-number
 202                              gps-time
 203                              (utc-from-gps estimated-utc ; From GPS week time.
 204                                            (read line-content nil)))
 205                        (read line-content nil) ; Discard distance.
 206                        (setf easting (read line-content nil)
 207                              northing (read line-content nil)
 208                              cartesian-height (read line-content nil)
 209                              latitude (read line-content nil)
 210                              longitude (read line-content nil)
 211                              ellipsoid-height (read line-content nil)
 212                              roll (read line-content nil)
 213                              pitch (read line-content nil)
 214                              heading (read line-content nil)
 215                              east-velocity (read line-content nil)
 216                              north-velocity (read line-content nil)
 217                              up-velocity (read line-content nil)
 218                              east-sd (read line-content nil)
 219                              north-sd (read line-content nil)
 220                              height-sd (read line-content nil)
 221                              roll-sd (read line-content nil)
 222                              pitch-sd (read line-content nil)
 223                              heading-sd (read line-content nil))))
 224                    point)
 225                  gps-points)
 226              finally (return gps-points)))))))
 227
 228 (defun aggregate-gps-events (gps-points)
 229   "Turn an alist of ((event1 . points1) (event2 . points2)...) into
 230 ((t . all-points))."
 231   (cl-log:log-message
 232  :db-sys
 233  "I was asked to aggregate-events so I won't distinguish any event numbers.")
 234   (list
 235    (cons t (reduce #'(lambda (x y) (merge 'vector x y #'< :key #'gps-time))
 236                    (mapcar #'cdr gps-points)))))
 237
 238 (defparameter *leap-seconds* nil
 239   "An alist of (time . leap-seconds) elements.  leap-seconds are to be
 240   added to GPS time to get UTC.")
 241
 242 (defparameter *time-steps-history-url*
 243   "http://hpiers.obspm.fr/eoppc/bul/bulc/TimeSteps.history"
 244   "URL of the leap second table which should contain lines like this:
 245  1980  Jan.   1              - 1s
 246  1981  Jul.   1              - 1s
 247  ...")
 248
 249 (defparameter *time-steps-history-file*
 250   (make-pathname :directory '(:relative) :name "TimeSteps" :type "history")
 251   "Fallback in case *time-steps-history-url* is unavailable.")
 252
 253 (let ((leap-second-months
 254        (pairlis '("Jan" "Feb" "March" "Apr" "May" "Jun"
 255                   "Jul" "Aug" "Sept" "Oct" "Nov" "Dec")
 256                 '(1 2 3 4 5 6 7 8 9 10 11 12))))
 257   ;; Month names (sans any `.') as used in
 258   ;; http://hpiers.obspm.fr/eoppc/bul/bulc/TimeSteps.history."
 259   (defun initialize-leap-seconds ()
 260     (handler-case
 261         (multiple-value-bind
 262               (body status-code headers uri stream must-close reason-phrase)
 263             (drakma:http-request *time-steps-history-url*)
 264           (declare (ignore headers stream must-close reason-phrase))
 265           (assert (= status-code 200))
 266           (with-open-file (stream *time-steps-history-file*
 267                                   :direction :output
 268                                   :if-exists :supersede
 269                                   :if-does-not-exist :create)
 270             (write-string body stream)
 271             (cl-log:log-message
 272              :debug "Downloaded leap second information from ~A." uri)))
 273       (error (e)
 274         (cl-log:log-message
 275          :warning
 276          "Couldn't get the latest leap seconds information from ~A. (~A)  ~
 277           Falling back to cached data in ~A."
 278          *time-steps-history-url* e *time-steps-history-file*)))
 279     (with-open-file (stream *time-steps-history-file*
 280                             :direction :input :if-does-not-exist :error)
 281       (let ((leap-second-records
 282              (sort                      ;just in case
 283               (loop
 284                  for raw-time-record = (read-line stream nil nil)
 285                  while raw-time-record
 286                  for (raw-year raw-month raw-date raw-sign raw-seconds)
 287                    = (cl-utilities:split-sequence
 288                       #\Space
 289                       (nsubstitute #\Space #\Tab raw-time-record)
 290                       :remove-empty-subseqs t)
 291                  for year = (when raw-year
 292                               (parse-integer raw-year :junk-allowed t))
 293                  for month = (when raw-month
 294                                (cdr (assoc (string-trim "." raw-month)
 295                                            leap-second-months
 296                                            :test #'string-equal)))
 297                  for date = (when raw-date
 298                               (parse-integer raw-date :junk-allowed t))
 299                  for sign = (when raw-sign
 300                               (if (string-equal raw-sign "-") -1 1))
 301                  for seconds = (when raw-seconds
 302                                  (parse-integer raw-seconds :junk-allowed t))
 303                  when (and year (< 1980 year))
 304                  collect (list (encode-universal-time 0 0 0 date month year 0)
 305                                (* sign seconds)))
 306               #'<
 307               :key #'car)))
 308         (setf *leap-seconds*
 309               (loop
 310                  for (leap-date leap) in leap-second-records
 311                  sum leap into leap-sum
 312                  collect leap-date into leap-dates
 313                  collect leap-sum into leap-sums
 314                  finally
 315                    (return (reverse (pairlis leap-dates leap-sums)))))))))
 316
 317 (defparameter *gps-epoch* (encode-universal-time 0 0 0 6 1 1980 0))
 318 (defparameter *unix-epoch* (encode-universal-time 0 0 0 1 1 1970 0))
 319
 320 (defun gps-start-of-week (time)
 321   "Begin of a GPS week (approximately Sunday 00:00)"
 322   (let ((week-length (* 7 24 3600))
 323         (leap-seconds (cdr (find time *leap-seconds*
 324                                  :key #'car :test #'> :from-end t))))
 325     (assert leap-seconds ()
 326             "Couldn't determine leap seconds for ~A" (timestring (round time)))
 327     (+ (* (floor (- time *gps-epoch*) week-length)
 328           week-length)
 329        *gps-epoch*
 330        leap-seconds)))
 331
 332 (defun utc-from-gps (utc-approximately gps-week-time)
 333   "Convert GPS week time into UTC.  gps-week-time may be of type
 334 float; in this case a non-integer is returned which can't be fed into
 335 decode-universal-time."
 336   (+ (gps-start-of-week utc-approximately) gps-week-time))
 337
 338 (defun utc-from-unix (unix-time)
 339   "Convert UNIX UTC to Lisp time."
 340   (when unix-time (+ unix-time *unix-epoch*)))
 341
 342 ;;(defun event-number (recorded-device-id)
 343 ;;  "Return the GPS event number corresponding to recorded-device-id of camera (etc.)"
 344 ;;  (let ((event-table (pairlis '(21 22 11 12 1 2)
 345 ;;                              '("1" "1" "2" "2" "1" "1"))))
 346 ;;    (cdr (assoc recorded-device-id event-table)))) ; TODO: make a saner version
 347
 348
 349 (let (event-number-storage)
 350   (defun device-event-number (recorded-device-id utc)
 351     "Return the GPS event number (a string) corresponding to
 352 recorded-device-id (a string) of camera (etc.)"
 353     (let ((device-event-number
 354            (cdr (assoc recorded-device-id event-number-storage
 355                        :test #'string-equal))))
 356       (if device-event-number
 357           device-event-number
 358           (let* ((date (simple-date:universal-time-to-timestamp (round utc)))
 359                  (device-stage-of-life
 360                   (car
 361                    (select-dao
 362                     'sys-device-stage-of-life
 363                     (:and (:overlaps
 364                            (:set 'mounting-date
 365                                  (:least :current-date 'unmounting-date))
 366                            (:set (:date date) (:date date)))
 367                           (:= 'recorded-device-id recorded-device-id))))))
 368             (assert device-stage-of-life
 369                     ()
 370                     "Can't figure out what event-number belongs to recorded-device-id ~S of (approx.) ~A.  There should be some entry in table sys-device-stage-of-life to this end."
 371                     recorded-device-id (timestring (round utc)))
 372             (push (cons recorded-device-id (event-number device-stage-of-life))
 373                   event-number-storage)
 374             (event-number device-stage-of-life))))))
 375
 376 (defun almost= (x y epsilon)
 377   (< (abs (- x y)) epsilon))
 378
 379 (defun geographic-to-utm (utm-zone longitude latitude &optional (height 0d0))
 380   "Return UTM utm-zone representation of geographic coordinates."
 381   (let ((utm-coordinate-system
 382          (format nil "+proj=utm +ellps=WGS84 +zone=~D" utm-zone)))
 383     (proj:cs2cs (list (proj:degrees-to-radians longitude) (proj:degrees-to-radians latitude) height)
 384                 :destination-cs utm-coordinate-system)))
 385
 386 (defun utm-zone (longitude)
 387   "Return UTM zone number belonging to longitude."
 388   (1+ (floor (+ longitude 180) 6)))
 389
 390 (defun assert-utm-zone (longitude-median longitude-leeway longitude latitude
 391                         geographic-height easting northing cartesian-height)
 392   "Check if, given longitude and latitude, easting and northing are
 393 calculated in the UTM zone belonging to longitude-median."
 394   (let ((epsilon 1d-1))
 395     (unless
 396         (or (every #'(lambda (x y) (almost= x y epsilon))
 397                    (geographic-to-utm (utm-zone (- longitude-median
 398                                                    longitude-leeway))
 399                                       longitude latitude geographic-height)
 400                    (list easting northing cartesian-height))
 401             (every #'(lambda (x y) (almost= x y epsilon))
 402                    (geographic-to-utm (utm-zone (+ longitude-median
 403                                                    longitude-leeway))
 404                                       longitude latitude geographic-height)
 405                    (list easting northing cartesian-height)))
 406       (error "The longitude median ~A should be in or near UTM zone ~D.  ~
 407               This is inconsistent with the easting values I was given.  ~
 408               Offending coordinates: (~A ~A ~A) (~A ~A ~A)."
 409              longitude-median (utm-zone longitude-median) longitude latitude
 410              geographic-height easting northing cartesian-height))))
 411
 412 (defun assert-gps-points-sanity (gps-points)
 413   "Check if gps-points (as returned by collect-gps-data) are ok.
 414 Return the Proj.4 string describing the cartesian coordinate system
 415 used."
 416   (loop
 417      for gps-event in gps-points
 418      for gps-event-vector = (cdr gps-event)
 419      for first-longitude = (longitude (aref gps-event-vector 0))
 420      for first-latitude = (latitude (aref gps-event-vector 0))
 421      for first-geographic-height = (ellipsoid-height (aref gps-event-vector 0))
 422      for first-easting = (easting (aref gps-event-vector 0))
 423      for first-northing = (northing (aref gps-event-vector 0))
 424      for first-cartesian-height = (cartesian-height (aref gps-event-vector 0))
 425      for longitude-median =
 426        (loop
 427           for point across gps-event-vector
 428           for i from 1
 429           sum (longitude point) into longitude-sum
 430           finally (return (/ longitude-sum i)))
 431      do (assert-utm-zone longitude-median 1
 432                          first-longitude first-latitude
 433                          first-geographic-height
 434                          first-easting first-northing
 435                          first-cartesian-height)
 436      finally (return (format nil "+proj=utm +ellps=WGS84 +zone=~D"
 437                              (utm-zone longitude-median)))))
 438
 439 (defun get-measurement-id (common-table-name dir-path cartesian-system)
 440   "Get measurement-id associated with dir-path and
 441 acquisition-project-id.  Create a fresh matching record if necessary."
 442   (let ((acquisition-project
 443          (car (select-dao 'sys-acquisition-project
 444                           (:= 'common-table-name common-table-name)))))
 445     (assert acquisition-project)
 446     (let* ((acquisition-project-id (acquisition-project-id acquisition-project))
 447            (measurement
 448             (or (car (select-dao
 449                       'sys-measurement
 450                       (:and (:= 'acquisition-project-id acquisition-project-id)
 451                             (:= 'directory dir-path))))
 452                 (insert-dao
 453                  (make-instance 'sys-measurement
 454                                 :acquisition-project-id acquisition-project-id
 455                                 :directory dir-path
 456                                 :cartesian-system cartesian-system
 457                                 :fetch-defaults t)))))
 458       (measurement-id measurement))))
 459
 460 (defun store-images-and-points (common-table-name dir-path
 461                                 &key (epsilon 1d-3)
 462                                 (root-dir (user-homedir-pathname))
 463                                 aggregate-events)
 464   "Link images to GPS points; store both into their respective DB
 465 tables.  Images become linked to GPS points when their respective
 466 times differ by less than epsilon seconds, and when the respective
 467 events match.  dir-path is a (probably absolute) path to a directory
 468 that contains one set of measuring data.  root-dir must be equal for
 469 all pojects."
 470   ;; TODO: epsilon could be a range.  We would do a raw mapping by (a bigger) time epsilon and then take speed into account.
 471   (assert
 472    (every #'string= (namestring root-dir) (namestring dir-path))
 473    () "~A is not a leading part of ~A." root-dir dir-path)
 474   (assert-phoros-db-major-version)
 475   (assert     ;not strictly necessary, but may save the user some time
 476    (select-dao 'sys-acquisition-project
 477                (:= 'common-table-name common-table-name))
 478    () "There is no acquisition project named ~A." common-table-name)
 479   (setf *random-state* (make-random-state t))
 480   (create-data-table-definitions common-table-name)
 481   (initialize-leap-seconds)
 482   (let* ((images
 483           (collect-pictures-directory-data dir-path))
 484          (estimated-time
 485           (loop
 486              for i across images
 487              unless (or (fake-trigger-time-p i)
 488                         (< (trigger-time i) *gps-epoch*))
 489              do (return (trigger-time i))))
 490          (gps-points
 491           (if aggregate-events
 492               (aggregate-gps-events (collect-gps-data dir-path estimated-time))
 493               (collect-gps-data dir-path estimated-time)))
 494          (gps-start-pointers (loop
 495                                 for i in gps-points
 496                                 collect (cons (car i) 0)))
 497          (mapped-image-counter (length images))
 498          (cartesian-system (assert-gps-points-sanity gps-points))
 499          (dir-below-root-dir (enough-namestring dir-path root-dir)))
 500     (cl-log:log-message
 501      :db-dat "I assume this measure was taken approximately ~A."
 502      (timestring (round estimated-time)))
 503     (loop
 504        for i across images
 505        for image-event-number = (or aggregate-events
 506                                     (device-event-number (recorded-device-id i)
 507                                                          estimated-time))
 508        for image-time = (trigger-time i)
 509        for matching-point =
 510          (when image-time               ; otherwise this image is junk
 511            (let ((gps-start-pointer
 512                   (cdr (assoc image-event-number gps-start-pointers
 513                               :test #'equal))))
 514              (assert gps-start-pointer ()
 515                      "Can't find an event number of ~S ~
 516                       (as suggested by the sys tables relevant to the ~
 517                       current image) among ~{~S~#^, ~} ~
 518                       (as derived from the names of the GPS event files).  ~
 519                       Consider using --aggregate-events if you can't ~
 520                       recitfy your data."
 521                      image-event-number (mapcar #'car gps-start-pointers))
 522              (loop
 523                 for gps-pointer from gps-start-pointer
 524                 for gps-point across (subseq (cdr (assoc image-event-number
 525                                                          gps-points
 526                                                          :test #'equal))
 527                                              gps-start-pointer)
 528                 when (almost= (gps-time gps-point) image-time epsilon)
 529                 do (setf (cdr (assoc image-event-number
 530                                      gps-start-pointers :test #'equal))
 531                          gps-pointer) ; remember index of last matching point
 532                 and return gps-point)))
 533        if matching-point
 534        do (let ((point-id               ; TODO: consider using transaction
 535                  (or (point-id matching-point) ; We've hit a point twice.
 536                      (sequence-next (point-id-sequence-name matching-point))))
 537                 (measurement-id (get-measurement-id common-table-name
 538                                                     dir-below-root-dir
 539                                                     cartesian-system)))
 540             (setf (point-id i) point-id
 541                   (point-id matching-point) point-id
 542                   (measurement-id matching-point) measurement-id
 543                   (measurement-id i) measurement-id
 544                   (trigger-time matching-point) image-time)
 545             (save-dao matching-point)
 546             (execute (:update (dao-table-name (class-of matching-point))
 547                               :set 'coordinates
 548                               (:st_geomfromewkt
 549                                (format nil "SRID=4326; POINT(~S ~S ~S)"
 550                                        (longitude matching-point)
 551                                        (latitude matching-point)
 552                                        (ellipsoid-height matching-point)))
 553                               :where (:= 'point-id (point-id matching-point))))
 554             (save-dao i))
 555        else do
 556          (decf mapped-image-counter)
 557          (cl-log:log-message
 558           :orphan
 559           "Couldn't map to any point: ~A~A, byte ~S. ~
 560            ~:[~; It didn't have a decent trigger time anyway.~]"
 561           dir-path (filename i) (image-byte-position i)
 562           (fake-trigger-time-p i)))
 563     (cl-log:log-message
 564      :db-dat
 565      "Tried to map ~D images to GPS points.  ~
 566       The attempt has been successful in ~:[~D~;all~] cases.~
 567       ~1@*~:[  See file ~3@*~A for details on the failures.~;~]"
 568      (length images)
 569      (= (length images) mapped-image-counter)
 570      mapped-image-counter
 571      (truename
 572       (cl-log:text-file-messenger-file (cl-log:find-messenger :orphan))))))
 573
 574 (defun assert-user-points-version (user-points-version)
 575   "Check if user-points-version is compatible with the current
 576 user-point table definition."
 577   (multiple-value-bind (major minor revision) (version-number-parts user-points-version)
 578     (declare (ignore minor revision))
 579     (cond              ;insert more interesting clauses when necessary
 580       ((null user-points-version)
 581        (warn "Storing user-points which don't have a version number."))
 582       ((> major (phoros-version :major t))
 583        (warn  "User-point file was created by Phoros ~A ~
 584               which is newer than the current version ~A."
 585               user-points-version (phoros-version)))
 586       ((< major 13)
 587        (error "User-point file was created by Phoros ~A ~
 588               which is incompatible with the current version ~A.  ~
 589               Please edit the file like so: ~
 590               (1) Change any occurence of the name \"attribute\" to \"kind\". ~
 591               (2) Change the value of name \"phorosVersion\" ~
 592               from ~0@*~S to \"13.0.0\".  Then retry."
 593               user-points-version (phoros-version)))
 594        (t))))
 595
 596 (defun* store-user-points (presentation-project-name &mandatory-key json-file)
 597   "Store in DB user points given in file at json-file, which
 598 supposedly was created by Phoros.  Return number of points stored,
 599 number of points that were already in DB, number of points found in
 600 JSON file, and a list containing user-names from the json file that
 601 don't exist in DB."
 602   (assert-phoros-db-major-version)
 603   (let* ((user-point-table-name
 604           (user-point-table-name presentation-project-name))
 605          (raw-input (with-open-file (stream json-file)
 606                       (json:decode-json stream)))
 607          (raw-input-version (cdr (assoc :phoros-version raw-input)))
 608          (raw-features (cdr (assoc :features raw-input))))
 609     (assert-user-points-version raw-input-version)
 610     (loop
 611        for i in raw-features
 612        for coordinates = (cdr (assoc :coordinates (cdr (assoc :geometry i))))
 613        for point-form = (format nil "SRID=4326; POINT(~{~S ~})" coordinates)
 614        for properties = (cdr (assoc :properties i))
 615        for user-name = (cdr (assoc :user-name properties))
 616        for kind = (cdr (assoc :kind properties))
 617        for description = (cdr (assoc :description properties))
 618        for numeric-description = (cdr (assoc :numeric-description properties))
 619        for creation-date = (cdr (assoc :creation-date properties))
 620        ;; for stdx-global = (cdr (assoc :stdx-global properties))
 621        ;; for stdy-global = (cdr (assoc :stdy-global properties))
 622        ;; for stdz-global = (cdr (assoc :stdz-global properties))
 623        for input-size = (cdr (assoc :input-size properties))
 624        for aux-numeric = (cdr (assoc :aux-numeric properties))
 625        for aux-text = (cdr (assoc :aux-text properties))
 626        for aux-numeric-comparison =
 627          (if aux-numeric
 628              (format nil "(~A = (CAST (ARRAY[~{~S~#^,~}] AS NUMERIC[])))"
 629                      (s-sql:to-sql-name 'aux-numeric) aux-numeric)
 630              (sql (:is-null 'aux-numeric)))
 631        for aux-text-comparison =
 632          (if aux-text
 633              (sql (:= 'aux-text (apply #'vector aux-text)))
 634              (sql (:is-null 'aux-text)))
 635        with points-stored = 0
 636        with points-already-in-db = 0
 637        with unknown-users = nil
 638        sum 1 into points-tried
 639        do
 640          (if
 641           (query
 642            (:select
 643             t
 644             :from user-point-table-name
 645             :where (:and (:st_equals 'coordinates
 646                                      (:st_geomfromewkt point-form))
 647                          (:= 'kind kind)
 648                          (:= 'description description)
 649                          (:= 'numeric-description numeric-description)
 650                          (:= (:to-char 'creation-date
 651                                        *user-point-creation-date-format*)
 652                              creation-date)
 653                          ;; (:= 'stdx-global stdx-global)
 654                          ;; (:= 'stdy-global stdy-global)
 655                          ;; (:= 'stdz-global stdz-global)
 656                          (:= 'input-size input-size)
 657                          (:raw aux-numeric-comparison)
 658                          (:raw aux-text-comparison))))
 659           (incf points-already-in-db)
 660           (progn
 661             (unless (and user-name
 662                          (query
 663                           (:select t
 664                                    :from 'sys-user
 665                                    :where (:= 'user-name user-name))))
 666               (pushnew user-name unknown-users :test #'equal))
 667             (assert
 668              (= 1
 669                 (execute
 670                  (sql-compile
 671                   `(:insert-into
 672                     ,user-point-table-name :set
 673                     'coordinates (:st_geomfromewkt ,point-form)
 674                     'user-id ,(if user-name
 675                                   `(:select 'user-id
 676                                             :from 'sys-user
 677                                             :where (:= 'user-name
 678                                                        ,user-name))
 679                                   :null)
 680                     'kind ,kind
 681                     'description ,description
 682                     'numeric-description ,numeric-description
 683                     'creation-date ,creation-date
 684                     ;; 'stdx-global ,stdx-global
 685                     ;; 'stdy-global ,stdy-global
 686                     ;; 'stdz-global ,stdz-global
 687                     'input-size ,input-size
 688                     'aux-numeric ,(if aux-numeric
 689                                       (apply #'vector aux-numeric)
 690                                       :null)
 691                     'aux-text ,(if aux-text
 692                                    (apply #'vector aux-text)
 693                                    :null)))))
 694              () "Point not stored.  This should not happen.")
 695             (incf points-stored)))
 696        finally (return (values points-stored
 697                                points-already-in-db
 698                                points-tried
 699                                unknown-users)))))
 700
 701 (defun update-footprint (common-table-name
 702                          measurement-id filename byte-position)
 703   "Update footprint of an image."
 704   (let* ((aggregate-view-name
 705           (aggregate-view-name common-table-name))
 706          (raw-footprint
 707           (photogrammetry
 708            :footprint
 709            ;; KLUDGE: translate keys, e.g. a1 -> a_1
 710            (json:decode-json-from-string
 711             (json:encode-json-to-string
 712              (query (:select '*
 713                              :from aggregate-view-name
 714                              :where (:and (:= 'measurement-id measurement-id)
 715                                           (:= 'filename filename)
 716                                           (:= 'byte-position byte-position)))
 717                     :alist)))))
 718          (ewkt-footprint
 719           (format nil "SRID=4326; POLYGON((~{~{~A~#^ ~}~#^, ~}))"
 720                   (cdr (assoc :footprint raw-footprint)))))
 721     (execute
 722      (:update aggregate-view-name :set
 723               'footprint (:st_geomfromewkt ewkt-footprint)
 724               :where (:and (:= 'measurement-id measurement-id)
 725                            (:= 'filename filename)
 726                            (:= 'byte-position byte-position))))))
 727
 728
 729 (defun insert-footprints (common-table-name)
 730   "Give images of acquisition project common-table-name that don't
 731 have up-to-date footprints fresh footprints."
 732   (let* ((log-frequency 200)
 733          (aggregate-view-name
 734           (aggregate-view-name common-table-name))
 735          (number-of-image-records
 736           (query (:select (:count '*)
 737                           :from aggregate-view-name
 738                           :where (:and
 739                                   (:or
 740                                    (:is-null 'footprint)
 741                                    (:!= 'footprint-device-stage-of-life-id
 742                                         'device-stage-of-life-id))
 743                                   'usable))
 744                  :single!)))
 745     (loop
 746        for image-records
 747        = (query (:limit
 748                  (:order-by
 749                   (:select 'measurement-id 'filename 'byte-position
 750                            :from aggregate-view-name
 751                            :where (:and
 752                                    (:or
 753                                     (:is-null 'footprint)
 754                                     (:!= 'footprint-device-stage-of-life-id
 755                                          'device-stage-of-life-id))
 756                                    'usable))
 757                   'measurement-id 'filename 'byte-position)
 758                  log-frequency))
 759        while image-records
 760        sum (loop
 761               for (measurement-id filename byte-position) in image-records
 762               sum (update-footprint
 763                    common-table-name measurement-id filename byte-position))
 764        into number-of-updated-footprints
 765        do (cl-log:log-message
 766            :db-dat
 767            "Updating image footprints of acquisition project ~A: ~
 768            ~D out of ~D done."
 769            common-table-name
 770            number-of-updated-footprints number-of-image-records)
 771        finally (return number-of-updated-footprints))))
 772
 773 (defun insert-all-footprints (postgresql-credentials)
 774   "Asynchronously update image footprints of all acquisition projects
 775 where necessarcy."
 776   (let ((common-table-names
 777          (with-connection postgresql-credentials
 778            (query (:select 'common-table-name
 779                            :from 'sys-acquisition-project)
 780                   :list))))
 781     (setf bt:*default-special-bindings*
 782           (acons '*insert-footprints-postgresql-credentials*
 783                  `(list ,@postgresql-credentials)
 784                  nil))
 785     (dolist (common-table-name common-table-names)
 786       (bt:make-thread
 787        #'(lambda ()
 788            (declare (special *insert-footprints-postgresql-credentials*))
 789            (with-connection *insert-footprints-postgresql-credentials*
 790              (insert-footprints common-table-name)))
 791        :name "insert-all-footprints"))))
 792
 793 (defun delete-imageless-points (common-table-name)
 794   "Delete from acquisition project common-table-name points that have
 795 no images."
 796   (let* ((point-data-table-name (point-data-table-name common-table-name))
 797          (image-data-table-name (image-data-table-name common-table-name)))
 798     (execute
 799      (:delete-from point-data-table-name
 800                    :where (:not
 801                            (:exists
 802                             (:select (:dot image-data-table-name 'point-id)
 803                                      :from image-data-table-name
 804                                      :where (:= (:dot image-data-table-name
 805                                                       'point-id)
 806                                                 (:dot point-data-table-name
 807                                                       'point-id)))))))))
 808
 809 (defun delete-all-imageless-points (postgresql-credentials)
 810   "Asynchronously delete imageless footprints of all acquisition
 811 projects."
 812   (let ((common-table-names
 813          (with-connection postgresql-credentials
 814            (query (:select 'common-table-name
 815                            :from 'sys-acquisition-project)
 816                   :list))))
 817     (setf bt:*default-special-bindings*
 818           (acons '*delete-imageless-points-postgresql-credentials*
 819                  `(list ,@postgresql-credentials)
 820                  nil))
 821     (dolist (common-table-name common-table-names)
 822       (bt:make-thread
 823        #'(lambda ()
 824            (declare (special *delete-imageless-points-postgresql-credentials*))
 825            (with-connection *delete-imageless-points-postgresql-credentials*
 826              (delete-imageless-points common-table-name)))
 827        :name "delete-all-imageless-points"))))
 828
 829 (defun* store-camera-hardware (&key
 830                                (try-overwrite t)
 831                                &mandatory-key
 832                                sensor-width-pix
 833                                sensor-height-pix
 834                                pix-size
 835                                channels
 836                                pix-depth
 837                                color-raiser
 838                                bayer-pattern
 839                                serial-number
 840                                description)
 841   "Store a new record in table sys-camera-hardware, or try updating an
 842 existing one.  Return camera-hardware-id of the altered record."
 843   (assert-phoros-db-major-version)
 844   (let ((record
 845          (or (when try-overwrite
 846                (car (select-dao 'sys-camera-hardware
 847                                 (:and (:= 'sensor-width-pix sensor-width-pix)
 848                                       (:= 'sensor-height-pix sensor-height-pix)
 849                                       (:= 'pix-size pix-size)
 850                                       (:= 'channels channels)
 851                                       (:= 'serial-number serial-number)
 852                                       (:= 'pix-depth pix-depth)))))
 853              (make-instance 'sys-camera-hardware :fetch-defaults t))))
 854     (with-slots ((sensor-width-pix-slot sensor-width-pix)
 855                  (sensor-height-pix-slot sensor-height-pix)
 856                  (pix-size-slot pix-size)
 857                  (channels-slot channels)
 858                  (pix-depth-slot pix-depth)
 859                  (color-raiser-slot color-raiser)
 860                  (bayer-pattern-slot bayer-pattern)
 861                  (serial-number-slot serial-number)
 862                  (description-slot description))
 863         record
 864       (setf sensor-width-pix-slot sensor-width-pix
 865             sensor-height-pix-slot sensor-height-pix
 866             pix-size-slot pix-size
 867             channels-slot channels
 868             pix-depth-slot pix-depth
 869             color-raiser-slot color-raiser
 870             bayer-pattern-slot bayer-pattern
 871             serial-number-slot serial-number
 872             description-slot description))
 873     (let ((new-row-p (save-dao record)))
 874       (cl-log:log-message
 875        :db-sys
 876        "sys-camera-hardware: ~:[Updated~;Stored new~] camera-hardware-id ~A"
 877        new-row-p (camera-hardware-id record)))
 878     (camera-hardware-id record)))
 879
 880 (defun* store-lens (&key (try-overwrite t)
 881                          &mandatory-key
 882                          c
 883                          serial-number
 884                          description)
 885   "Store a new record in table sys-lens, or try updating an existing
 886 one.  Return lens-id of the altered record."
 887   (assert-phoros-db-major-version)
 888   (let ((record
 889          (or (when try-overwrite
 890                (car (select-dao 'sys-lens
 891                                 (:and (:= 'c c)
 892                                       (:= 'serial-number serial-number)))))
 893              (make-instance 'sys-lens :fetch-defaults t))))
 894     (with-slots ((c-slot c)
 895                  (serial-number-slot serial-number)
 896                  (description-slot description))
 897         record
 898       (setf c-slot c
 899             serial-number-slot serial-number
 900             description-slot description))
 901     (let ((new-row-p (save-dao record)))
 902       (cl-log:log-message
 903        :db-sys "sys-lens: ~:[Updated~;Stored new~] lens-id ~A"
 904        new-row-p (lens-id record)))
 905     (lens-id record)))
 906
 907 (defun store-generic-device
 908     (&key (camera-hardware-id :null) (lens-id :null) (scanner-id :null))
 909   "Store a new record in table sys-generic-device.  Return
 910 generic-device-id of the new record."
 911   (assert-phoros-db-major-version)
 912   (assert (notevery
 913            #'(lambda (x) (eq :null x))
 914            (list camera-hardware-id lens-id scanner-id))
 915           () "Generic device: not enough components.")
 916   (let ((record (make-instance 'sys-generic-device
 917                                :camera-hardware-id camera-hardware-id
 918                                :lens-id lens-id
 919                                :scanner-id scanner-id
 920                                :fetch-defaults t)))
 921     (let ((new-row-p (save-dao record)))
 922       (cl-log:log-message
 923        :db-sys
 924        "sys-generic-device: ~:[Updated~;Stored new~] generic-device-id ~A"
 925        new-row-p (generic-device-id record)))
 926     (generic-device-id record)))
 927
 928 (defun* store-device-stage-of-life (&key (unmounting-date :null)
 929                                    (try-overwrite t)
 930                                    &mandatory-key
 931                                    recorded-device-id
 932                                    event-number
 933                                    generic-device-id
 934                                    vehicle-name
 935                                    casing-name
 936                                    computer-name
 937                                    computer-interface-name
 938                                    mounting-date)
 939   "Store a new record in table sys-device-stage-of-life, or try
 940 updating an existing one.  Return device-stage-of-life-id of the
 941 altered record."
 942   (assert-phoros-db-major-version)
 943   (let ((record
 944          (or (when try-overwrite
 945                (car (select-dao
 946                      'sys-device-stage-of-life
 947                      (:and (:= 'recorded-device-id recorded-device-id)
 948                            (:= 'event-number event-number)
 949                            (:= 'generic-device-id generic-device-id)
 950                            (:= 'vehicle-name vehicle-name)
 951                            (:= 'mounting-date mounting-date)))))
 952              (make-instance 'sys-device-stage-of-life :fetch-defaults t))))
 953     (with-slots ((recorded-device-id-slot recorded-device-id)
 954                  (event-number-slot event-number)
 955                  (generic-device-id-slot generic-device-id)
 956                  (vehicle-name-slot vehicle-name)
 957                  (casing-name-slot casing-name)
 958                  (computer-name-slot computer-name)
 959                  (computer-interface-name-slot computer-interface-name)
 960                  (mounting-date-slot mounting-date)
 961                  (unmounting-date-slot unmounting-date))
 962         record
 963       (setf recorded-device-id-slot recorded-device-id
 964             event-number-slot event-number
 965             generic-device-id-slot generic-device-id
 966             vehicle-name-slot vehicle-name
 967             casing-name-slot casing-name
 968             computer-name-slot computer-name
 969             computer-interface-name-slot computer-interface-name
 970             mounting-date-slot mounting-date
 971             unmounting-date-slot unmounting-date))
 972     (let ((new-row-p (save-dao record)))
 973       (cl-log:log-message
 974        :db-sys
 975        "sys-device-stage-of-life: ~:[Updated~;Stored new~] device-stage-of-life-id ~A"
 976        new-row-p (device-stage-of-life-id record)))
 977     (device-stage-of-life-id record)))
 978
 979 (defun* store-device-stage-of-life-end (&mandatory-key device-stage-of-life-id
 980                                                        unmounting-date)
 981   "Update record in table sys-device-stage-of-life with an unmounting
 982 date.  Return device-stage-of-life-id of the altered record."
 983   (assert-phoros-db-major-version)
 984   (let ((record
 985          (get-dao 'sys-device-stage-of-life device-stage-of-life-id)))
 986     (with-slots ((unmounting-date-slot unmounting-date))
 987         record
 988       (setf unmounting-date-slot unmounting-date))
 989     (update-dao record)
 990     (device-stage-of-life-id record)))
 991
 992 (defun* store-camera-calibration (&key
 993                                   (usable t)
 994                                   &mandatory-key
 995                                   device-stage-of-life-id
 996                                   date
 997                                   person
 998                                   main-description
 999                                   debug
1000                                   photogrammetry-version
1001                                   mounting-angle
1002                                   inner-orientation-description
1003                                   c
1004                                   xh
1005                                   yh
1006                                   a1
1007                                   a2
1008                                   a3
1009                                   b1
1010                                   b2
1011                                   c1
1012                                   c2
1013                                   r0
1014                                   outer-orientation-description
1015                                   dx
1016                                   dy
1017                                   dz
1018                                   omega
1019                                   phi
1020                                   kappa
1021                                   boresight-description
1022                                   b-dx
1023                                   b-dy
1024                                   b-dz
1025                                   b-ddx
1026                                   b-ddy
1027                                   b-ddz
1028                                   b-rotx
1029                                   b-roty
1030                                   b-rotz
1031                                   b-drotx
1032                                   b-droty
1033                                   b-drotz
1034                                   nx
1035                                   ny
1036                                   nz
1037                                   d)
1038   "Store a new record of camera-calibration in table
1039 sys-device-stage-of-life, or update an existing one.  Return
1040 device-stage-of-life-id and date of the altered record."
1041   (assert-phoros-db-major-version)
1042   (let ((record
1043          (or (car (select-dao
1044                    'sys-camera-calibration
1045                    (:and (:= 'device-stage-of-life-id device-stage-of-life-id)
1046                          (:= 'date date))))
1047              (make-instance 'sys-camera-calibration :fetch-defaults t))))
1048     (with-slots
1049           ((device-stage-of-life-id-slot device-stage-of-life-id)
1050            (date-slot date)
1051            (person-slot person)
1052            (main-description-slot main-description)
1053            (usable-slot usable)
1054            (debug-slot debug)
1055            (photogrammetry-version-slot photogrammetry-version)
1056            (mounting-angle-slot mounting-angle)
1057            (inner-orientation-description-slot inner-orientation-description)
1058            (c-slot c)
1059            (xh-slot xh)
1060            (yh-slot yh)
1061            (a1-slot a1)
1062            (a2-slot a2)
1063            (a3-slot a3)
1064            (b1-slot b1)
1065            (b2-slot b2)
1066            (c1-slot c1)
1067            (c2-slot c2)
1068            (r0-slot r0)
1069            (outer-orientation-description-slot outer-orientation-description)
1070            (dx-slot dx)
1071            (dy-slot dy)
1072            (dz-slot dz)
1073            (omega-slot omega)
1074            (phi-slot phi)
1075            (kappa-slot kappa)
1076            (boresight-description-slot boresight-description)
1077            (b-dx-slot b-dx)
1078            (b-dy-slot b-dy)
1079            (b-dz-slot b-dz)
1080            (b-ddx-slot b-ddx)
1081            (b-ddy-slot b-ddy)
1082            (b-ddz-slot b-ddz)
1083            (b-rotx-slot b-rotx)
1084            (b-roty-slot b-roty)
1085            (b-rotz-slot b-rotz)
1086            (b-drotx-slot b-drotx)
1087            (b-droty-slot b-droty)
1088            (b-drotz-slot b-drotz)
1089            (nx-slot nx)
1090            (ny-slot ny)
1091            (nz-slot nz)
1092            (d-slot d))
1093         record
1094       (setf device-stage-of-life-id-slot device-stage-of-life-id
1095             date-slot date
1096             person-slot person
1097             main-description-slot main-description
1098             usable-slot usable
1099             debug-slot debug
1100             photogrammetry-version-slot photogrammetry-version
1101             mounting-angle-slot mounting-angle
1102             inner-orientation-description-slot inner-orientation-description
1103             c-slot c
1104             xh-slot xh
1105             yh-slot yh
1106             a1-slot a1
1107             a2-slot a2
1108             a3-slot a3
1109             b1-slot b1
1110             b2-slot b2
1111             c1-slot c1
1112             c2-slot c2
1113             r0-slot r0
1114             outer-orientation-description-slot outer-orientation-description
1115             dx-slot dx
1116             dy-slot dy
1117             dz-slot dz
1118             omega-slot omega
1119             phi-slot phi
1120             kappa-slot kappa
1121             boresight-description-slot boresight-description
1122             b-dx-slot b-dx
1123             b-dy-slot b-dy
1124             b-dz-slot b-dz
1125             b-ddx-slot b-ddx
1126             b-ddy-slot b-ddy
1127             b-ddz-slot b-ddz
1128             b-rotx-slot b-rotx
1129             b-roty-slot b-roty
1130             b-rotz-slot b-rotz
1131             b-drotx-slot b-drotx
1132             b-droty-slot b-droty
1133             b-drotz-slot b-drotz
1134             nx-slot nx
1135             ny-slot ny
1136             nz-slot nz
1137             d-slot d))
1138     (let ((new-row-p (save-dao record)))
1139       (cl-log:log-message
1140        :db-sys
1141        "sys-camera-calibration: ~:[Updated~;Stored new~] record ~
1142         for ~A, device-stage-of-life-id ~A"
1143        new-row-p (date record) (device-stage-of-life-id record)))
1144     (values (device-stage-of-life-id record)
1145             (date record))))
1146
1147 #|
1148 (with-connection '("phoros-dev" "postgres" "passwd" "host")
1149   (nuke-all-tables)
1150   (create-acquisition-project "yyyy")
1151   (store-camera-hardware :sensor-width-pix 7000 :sensor-height-pix 800 :pix-size .003 :channels 3 :pix-depth 17 :color-raiser #(1 2 3) :bayer-pattern #(4 5 6) :serial-number "18" :description "yyy" :try-overwrite t)
1152   (store-lens :c 10.5 :serial-number "17.8.8" :description "blahBlah3" :try-overwrite nil)
1153   (store-generic-device :camera-hardware-id 1 :lens-id 1)
1154   (store-device-stage-of-life :recorded-device-id "1" :event-number "777" :generic-device-id 1 :vehicle-name "Auto" :casing-name "Vorn links" :computer-name "ccdheck" :computer-interface-name "eth0" :mounting-date "2010-01-30T07:00-1")
1155   (store-images-and-points "yyyy" "/home/bertb/phoros-testdata/mitsa-small/"))
1156 |#