From 5ddcb8796c32ccd85315f1153f04ac16cb49cbe0 Mon Sep 17 00:00:00 2001 From: Bert Burgemeister Date: Thu, 10 May 2012 15:31:56 +0200 Subject: [PATCH] Change definition of auxiliary data and their labels - Allow for definition of dummy elements of auxiliary data. - On HTTP client, suppress lines with NULL values. --- cli.lisp | 25 ++++++++++++++++--------- db-tables.lisp | 32 ++++++++++++++++++-------------- phoros-js.lisp | 32 ++++++++++++++++++-------------- phoros.asd | 2 +- phoros.lisp | 20 ++++++++++++++------ 5 files changed, 67 insertions(+), 44 deletions(-) diff --git a/cli.lisp b/cli.lisp index 2bbb3fd..2c20d78 100644 --- a/cli.lisp +++ b/cli.lisp @@ -273,10 +273,10 @@ :documentation "Number of photos shown to the HTTP client.") ("aux-numeric-label" :type string :list t :optional t :action *aux-numeric-labels* - :documentation "Label for an element of auxiliary numeric data. Repeat if necessary.") + :documentation "HTML label for an element of auxiliary numeric data. Repeat if necessary. The succession of labels should match the auxiliary data (defined by --numeric-column) of all presentation projects served by this server instance.") ("aux-text-label" :type string :list t :optional t :action *aux-text-labels* - :documentation "Label for an element of auxiliary text data. Repeat if necessary.") + :documentation "HTML label for an element of auxiliary text data. Repeat if necessary. The succession of labels should match the auxiliary data (defined by --text-column) of all presentation projects served by this server instance.") ("login-intro" :type string :list t :optional t :action *login-intro* :documentation "Text to be shown below the login form. Use repeatedly to divide text into paragraphs. You can use HTML markup as long as it is legal inside

...

"))) @@ -337,10 +337,10 @@ :documentation "Name of the geometry column (which should have an index) in the auxiliary data table.") ("numeric-column" :type string :list t :optional t - :documentation "Name of a numeric column in the auxiliary data table. Repeat if necessary.") + :documentation "Name of a numeric column in the auxiliary data table. An empty string defines an empty placeholder column. Repeat if necessary.") ("text-column" :type string :list t :optional t - :documentation "Name of a text column in the auxiliary data table. Repeat if necessary."))) + :documentation "Name of a text column in the auxiliary data table. An empty string defines an empty placeholder column. Repeat if necessary."))) (defparameter cli:*user-points-options* '(("get-user-points" @@ -607,6 +607,9 @@ given." "The array elements of both aux-numeric and aux-text of auxiliary points can then be incorporated into neighbouring user points during user point creation." + "To match the array elements to the labels shown on HTTP client + \(defined by --aux-numeric-label, --aux-text-label), NULL array + elements can be used act as placeholders where appropriate." (format nil "Also, a walk mode along auxiliary points becomes available to the HTTP client. PL/pgSQL function ~(~A~) is @@ -1200,7 +1203,11 @@ a view." (with-connection (list aux-database aux-user aux-password aux-host :port aux-port :use-ssl (s-sql:from-sql-name aux-use-ssl)) - (let ((aux-view-in-phoros-db-p + (let ((numeric-columns + (nsubstitute nil "" numeric-column :test #'string=)) + (text-columns + (nsubstitute nil "" text-column :test #'string=)) + (aux-view-in-phoros-db-p (every #'equal (list host port database user password use-ssl) (list aux-host aux-port aux-database @@ -1220,9 +1227,9 @@ a view." (delete-aux-view presentation-project-name)) (apply #'create-aux-view presentation-project-name - :coordinates-column (s-sql:to-sql-name coordinates-column) - :numeric-columns numeric-column - :text-columns text-column + :coordinates-column coordinates-column + :numeric-columns numeric-columns + :text-columns text-columns :allow-other-keys t (cli:remaining-options)) (add-spherical-mercator-ref) @@ -1238,7 +1245,7 @@ a view." aux-database aux-host aux-port (aux-point-view-name presentation-project-name) aux-table coordinates-column - numeric-column text-column + numeric-columns text-columns (thread-aux-points-function-name presentation-project-name))))))) (defun cli:store-user-points-action (presentation-project) diff --git a/db-tables.lisp b/db-tables.lisp index 7b9567f..e6ee09f 100644 --- a/db-tables.lisp +++ b/db-tables.lisp @@ -1079,22 +1079,26 @@ CREATE INDEX idx__the_geom VACUUM FULL ANALYZE (the_geom);" (create-plpgsql-helpers) - (let ((aux-point-view-name - (aux-point-view-name presentation-project-name)) - (thread-aux-points-function-name - (thread-aux-points-function-name presentation-project-name))) - (execute (format nil " + (flet ((to-sql-name-or-null (name) + (if name + (s-sql:to-sql-name name) + :null))) + (let ((aux-point-view-name + (aux-point-view-name presentation-project-name)) + (thread-aux-points-function-name + (thread-aux-points-function-name presentation-project-name))) + (execute (format nil " CREATE VIEW ~A AS (SELECT ~A AS coordinates, ~:[NULL~;ARRAY[~:*~{~A~#^, ~}]~] AS aux_numeric, ~:[NULL~;ARRAY[~:*~{~A~#^, ~}]~] AS aux_text FROM ~A)" - (s-sql:to-sql-name aux-point-view-name) - coordinates-column - (mapcar #'s-sql:to-sql-name numeric-columns) - (mapcar #'s-sql:to-sql-name text-columns) - (s-sql:to-sql-name aux-table))) - (execute (format nil "~ + (s-sql:to-sql-name aux-point-view-name) + (s-sql:to-sql-name coordinates-column) + (mapcar #'to-sql-name-or-null numeric-columns) + (mapcar #'to-sql-name-or-null text-columns) + (s-sql:to-sql-name aux-table))) + (execute (format nil "~ CREATE OR REPLACE FUNCTION ~0@*~A (point GEOMETRY, sample_radius DOUBLE PRECISION, sample_size INT, step_size DOUBLE PRECISION, old_azimuth DOUBLE PRECISION, @@ -1277,9 +1281,9 @@ BEGIN RETURN; END; $$ LANGUAGE plpgsql;" - (s-sql:to-sql-name thread-aux-points-function-name) - (s-sql:to-sql-name aux-point-view-name) - (phoros-version))))) + (s-sql:to-sql-name thread-aux-points-function-name) + (s-sql:to-sql-name aux-point-view-name) + (phoros-version)))))) (defun create-acquisition-project (common-table-name) "Create in current database a fresh set of canonically named tables. diff --git a/phoros-js.lisp b/phoros-js.lisp index 6d49d62..5824e4e 100644 --- a/phoros-js.lisp +++ b/phoros-js.lisp @@ -2159,20 +2159,24 @@ labels and a data column from aux-data." (if aux-data (who-ps-html - (:table :class "aux-data-table" - (chain aux-data - (reduce (lambda (x y i) - (+ x (who-ps-html - (:tr - (:td :class "aux-data-label" - (+ - (if labels - (elt labels i) - i) - ":")) - (:td :class "aux-data-value" - y))))) - "")))) + (:table + :class "aux-data-table" + (chain aux-data + (reduce (lambda (x y i) + (if y + (+ x (who-ps-html + (:tr + (:td :class "aux-data-label" + (+ + (if (and labels + (elt labels i)) + (elt labels i) + (+ "#" i)) + ":")) + (:td :class "aux-data-value" + y)))) + x)) + "")))) "")) (defun nearest-aux-point-selected (event) diff --git a/phoros.asd b/phoros.asd index 2a0fe0f..9a1f9ce 100644 --- a/phoros.asd +++ b/phoros.asd @@ -21,7 +21,7 @@ interface. http://phoros.boundp.org" ;; There should be a corresponding git tag which marks the point this ;; version number becomes official. - "13.1.1" + "13.2.0" :licence ;goes with --licence output "Copyright (C) 2010, 2011, 2012 Bert Burgemeister diff --git a/phoros.lisp b/phoros.lisp index 9266584..fb45e20 100644 --- a/phoros.lisp +++ b/phoros.lisp @@ -1187,8 +1187,7 @@ coordinates received, wrapped in an array." (encode-geojson-to-string (ignore-errors (with-connection *postgresql-aux-credentials* - (nsubst - nil :null + (nillify-null (query (s-sql:sql-compile `(:limit @@ -1217,6 +1216,15 @@ coordinates received, wrapped in an array." ,count)) :plists))))))) +(defun nillify-null (x) + "Replace occurences of :null in nested sequence x by nil." + (cond ((eq :null x) nil) + ((stringp x) x) + ((numberp x) x) + ((symbolp x) x) + (t (map (type-of x) #'nillify-null x)))) + + (hunchentoot:define-easy-handler (aux-local-linestring :uri "/phoros/lib/aux-local-linestring.json" :default-request-type :post) @@ -1246,8 +1254,7 @@ respectively)." (sql-response (ignore-errors (with-connection *postgresql-aux-credentials* - (nsubst - nil :null + (nillify-null (query (sql-compile `(:select '* :from @@ -1308,9 +1315,10 @@ and the number of points returned." (values (if indent (indent-json - (encode-geojson-to-string (nsubst nil :null user-point-plist))) - (encode-geojson-to-string (nsubst nil :null user-point-plist))) + (encode-geojson-to-string (nillify-null user-point-plist))) + (encode-geojson-to-string (nillify-null user-point-plist))) (length user-point-plist)))) + (hunchentoot:define-easy-handler (user-points :uri "/phoros/lib/user-points.json") (bbox) -- 2.11.4.GIT