From 35311a150738fc972ad029fbd8e456ad85eacc1a Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 18:34:25 +0100 Subject: [PATCH 1/8] Import HISTORIC_CODES and VTM_INGREDIENTS supplementary files The TRUD supplementary (bonus) release includes a map of historic (deprecated) codes to their current identifiers for VTM, VMP, ingredient, supplier, form, route and unit of measure, and a file linking VTMs directly to ingredients. Neither was previously imported: f_history was recognised but skipped, and f_vtm_ing did not match the filename pattern. Files of unknown type now sort last rather than first. Co-Authored-By: Claude Fable 5 --- src/com/eldrix/dmd/import.clj | 44 ++++++++++++++++--- .../HISTORIC_CODES/f_history1_0260821.xml | 26 +++++++++++ .../VTM_INGREDIENTS/f_vtm_ing1_0260821.xml | 4 ++ test/src/com/eldrix/dmd/importer_test.clj | 23 +++++++++- 4 files changed, 89 insertions(+), 8 deletions(-) create mode 100644 test/resources/dmd-2021-08-26/HISTORIC_CODES/f_history1_0260821.xml create mode 100644 test/resources/dmd-2021-08-26/VTM_INGREDIENTS/f_vtm_ing1_0260821.xml diff --git a/src/com/eldrix/dmd/import.clj b/src/com/eldrix/dmd/import.clj index 27c845f..c7b9c9c 100644 --- a/src/com/eldrix/dmd/import.clj +++ b/src/com/eldrix/dmd/import.clj @@ -31,7 +31,7 @@ (def ^:private file-ordering "Order of file import for relational integrity, if needed." - [:LOOKUP :INGREDIENT :VTM :VMP :AMP :VMPP :AMPP :GTIN :BNF]) + [:LOOKUP :INGREDIENT :VTM :VMP :AMP :VMPP :AMPP :GTIN :BNF :HISTORY :VTM_ING]) (def ^DateTimeFormatter df (DateTimeFormatter/ofPattern "ddMMyy")) @@ -39,17 +39,18 @@ (def ^:private file-matcher "There is no formal specification for filename structure, but this is the de facto standard." - #"^f_([a-z]*)\d_\d(\d{6})\.xml$") + #"^f_([a-z_]*)\d_\d(\d{6})\.xml$") (defn ^:private parse-dmd-filename - "Parse a dm+d filename if possible." + "Parse a dm+d filename if possible. Files of unknown type sort last." [f] (let [f2 (clojure.java.io/as-file f)] (when-let [[_ nm date] (re-matches file-matcher (.getName f2))] - (let [kw (keyword (str/upper-case nm))] + (let [kw (keyword (str/upper-case nm)) + order (.indexOf ^List file-ordering kw)] {:type kw :date (LocalDate/parse date df) - :order (.indexOf ^List file-ordering kw) + :order (if (neg? order) Integer/MAX_VALUE order) :file f2})))) (defn should-include? @@ -185,6 +186,7 @@ :PX_CHRGS parse-flag :DISP_FEES parse-flag ;; unlike the documentation, this is actually a flag (1 or omitted). :BB parse-flag + :LTD_STAB parse-flag :CAL_PACK parse-flag :SPEC_CONTCD unsafe-parse-long :FP34D parse-flag @@ -204,7 +206,11 @@ :DDD_UOMCD unsafe-parse-long :DDD unsafe-parse-double :STARTDT parse-date - :ENDDT parse-date}) + :ENDDT parse-date + + ;; historic codes + :IDCURRENT unsafe-parse-long + :IDPREVIOUS unsafe-parse-long}) (defn- parse-property [k v] (if-let [parser (get property-parsers k)] @@ -284,6 +290,28 @@ (a/ + +341867110000011023543030072004-12-012017-03-09 +34186711000001102341867110000011022017-03-10 + + +318135008104064110000011012004-05-042009-03-31 +3181350083181350082009-04-01 + + +38751600835120110000011092004-12-012005-07-26 +3875160083875160082005-07-27 + + +207050100000110420705010000011042004-12-01 + + +
353668110000011063850980022004-12-012018-04-17
+ + +10547007105470072004-12-01 + + +28238000033143110000011032004-12-012007-09-30 + + diff --git a/test/resources/dmd-2021-08-26/VTM_INGREDIENTS/f_vtm_ing1_0260821.xml b/test/resources/dmd-2021-08-26/VTM_INGREDIENTS/f_vtm_ing1_0260821.xml new file mode 100644 index 0000000..a0e7bdc --- /dev/null +++ b/test/resources/dmd-2021-08-26/VTM_INGREDIENTS/f_vtm_ing1_0260821.xml @@ -0,0 +1,4 @@ + +34186711000001102387516008 +34186711000001102387475002 + diff --git a/test/src/com/eldrix/dmd/importer_test.clj b/test/src/com/eldrix/dmd/importer_test.clj index 8a0f366..6c0f7bf 100644 --- a/test/src/com/eldrix/dmd/importer_test.clj +++ b/test/src/com/eldrix/dmd/importer_test.clj @@ -7,7 +7,8 @@ (def dir "dmd-2021-08-26") (deftest file-ordering - (is (= '(:LOOKUP :INGREDIENT :VTM :VMP :AMP :VMPP :AMPP :GTIN :BNF) (map :type (dim/dmd-file-seq (io/resource dir)))))) + (is (= '(:LOOKUP :INGREDIENT :VTM :VMP :AMP :VMPP :AMPP :GTIN :BNF :HISTORY :VTM_ING) + (map :type (dim/dmd-file-seq (io/resource dir)))))) (deftest import-lookups (is (= {:TYPE [:LOOKUP :BASIS_OF_NAME] @@ -15,6 +16,26 @@ :DESC "rINN - Recommended International Non-proprietary"} (first (dim/get-component (io/resource dir) :LOOKUP :BASIS_OF_NAME))))) +(deftest import-history + (let [history (dim/get-component (io/resource dir) :HISTORY :HISTORY) + by-cls (group-by :CLS history)] + (is (= #{"VTM" "VMP" "ING" "SUPP" "FORM" "ROUTE" "UOM"} (set (keys by-cls)))) + (is (= {:TYPE [:HISTORY :HISTORY] + :CLS "VTM" + :IDCURRENT 34186711000001102 + :IDPREVIOUS 354303007 + :STARTDT (java.time.LocalDate/of 2004 12 1) + :ENDDT (java.time.LocalDate/of 2017 3 9)} + (first (get by-cls "VTM")))) + (let [self-row (second (get by-cls "VTM"))] ;; rows with IDCURRENT=IDPREVIOUS record current id validity + (is (= (:IDCURRENT self-row) (:IDPREVIOUS self-row))) + (is (nil? (:ENDDT self-row)))))) + +(deftest import-vtm-ingredients + (is (= [{:TYPE [:VTM_ING :VTM_ING] :VTMID 34186711000001102 :ISID 387516008} + {:TYPE [:VTM_ING :VTM_ING] :VTMID 34186711000001102 :ISID 387475002}] + (dim/get-component (io/resource dir) :VTM_ING :VTM_ING)))) + (deftest metadata (is (= (java.time.LocalDate/of 2021 8 26) (:release-date (dim/get-release-metadata (io/resource dir)))))) From 6bb77aff729ebdbf8bcc0622f62d2e95d5f585b9 Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 18:40:58 +0100 Subject: [PATCH 2/8] Remove unused pathom3 graph API and unused dependencies The pathom3-based graph namespace was written against an earlier store and is not part of the public API; core.match and data.csv were unused. Co-Authored-By: Claude Fable 5 --- deps.edn | 5 +- src/com/eldrix/dmd/graph.clj | 130 ----------------------------------- 2 files changed, 1 insertion(+), 134 deletions(-) delete mode 100644 src/com/eldrix/dmd/graph.clj diff --git a/deps.edn b/deps.edn index 97c1a1c..b2e7b73 100644 --- a/deps.edn +++ b/deps.edn @@ -2,8 +2,6 @@ :deps {org.clojure/clojure {:mvn/version "1.12.0"} org.clojure/core.async {:mvn/version "1.7.701"} - org.clojure/core.match {:mvn/version "1.1.0"} - org.clojure/data.csv {:mvn/version "1.1.0"} org.clojure/data.json {:mvn/version "2.5.1"} org.clojure/data.xml {:mvn/version "0.2.0-alpha9"} org.clojure/data.zip {:mvn/version "1.1.0"} @@ -14,8 +12,7 @@ com.github.seancorfield/honeysql {:mvn/version "2.6.1270"} com.github.seancorfield/next.jdbc {:mvn/version "1.3.981"} org.xerial/sqlite-jdbc {:mvn/version "3.48.0.0"} - com.zaxxer/HikariCP {:mvn/version "6.2.1"} - com.wsscode/pathom3 {:mvn/version "2025.01.16-alpha"}} + com.zaxxer/HikariCP {:mvn/version "6.2.1"}} :aliases {:build {:deps {io.github.clojure/tools.build {:git/tag "v0.10.6" :git/sha "52cf7d6"} diff --git a/src/com/eldrix/dmd/graph.clj b/src/com/eldrix/dmd/graph.clj deleted file mode 100644 index 3c5ca11..0000000 --- a/src/com/eldrix/dmd/graph.clj +++ /dev/null @@ -1,130 +0,0 @@ -(ns com.eldrix.dmd.graph - "Provides a graph API around UK dm+d structures." - (:require - [com.eldrix.dmd.core :as dmd] - [com.wsscode.pathom3.connect.operation :as pco] - [com.wsscode.pathom3.connect.indexes :as pci] - [com.wsscode.pathom3.connect.built-in.resolvers :as pbir] - [com.wsscode.pathom3.interface.eql :as p.eql])) - -(defn namespace-map - "Add the namespace to all keywords, recursing into the map." - [n x] - (if-not (map? x) - x - (reduce-kv - (fn [m k v] - (assoc m - (if-not (keyword? k) - k - (keyword n (name k))) - (cond - (map? v) (namespace-map n v) - (coll? v) (map #(namespace-map n %) v) - :else v))) {} x))) - -(pco/defresolver product-from-snomed-identifier - "Returns a UK product by identifier. - Fortunately, there is a 1:1 mapping between dm+d product codes and SNOMED CT - identifiers. This means that as long as we output SNOMED namespaced - identifiers, client applications can navigate seamlessly between dm+d and - SNOMED." - [{::keys [store]} {:info.snomed.Concept/keys [id]}] - {::pco/output [:uk.nhs.dmd/VTMID :uk.nhs.dmd/VPID :uk.nhs.dmd/VPPID - :uk.nhs.dmd/APID :uk.nhs.dmd/APPID :uk.nhs.dmd/ISID - :uk.nhs.dmd/NM :uk.nhs.dmd/TYPE]} - (namespace-map "uk.nhs.dmd" (dmd/fetch-product store id))) - -(pco/defresolver fetch-vtm - [{::keys [store]} {:uk.nhs.dmd/keys [VTMID]}] - {::pco/output [:uk.nhs.dmd/VTMID - :uk.nhs.dmd/TYPE - :uk.nhs.dmd/NM - :uk.nhs.dmd/INVALID - :uk.nhs.dmd/ABBREVNM - :uk.nhs.dmd/VTMIDPREV - :uk.nhs.dmd/VTMIDDT]} - (namespace-map "uk.nhs.dmd" (dmd/fetch-product store VTMID))) - -(def code-properties - [:uk.nhs.dmd/CD - :uk.nhs.dmd/CDDT - :uk.nhs.dmd/CDPREV - :uk.nhs.dmd/DESC]) - -(pco/defresolver fetch-extended-vmp - [{::keys [store]} {:uk.nhs.dmd/keys [VPID]}] - {::pco/output [:uk.nhs.dmd/VPID - :uk.nhs.dmd/VTMID - {:uk.nhs.dmd/VTM [:uk.nhs.dmd/VTMID :uk.nhs.dmd/NM]} - :uk.nhs.dmd/NM - {:uk.nhs.dmd/UNIT_DOSE_UOM code-properties} - {:uk.nhs.dmd/DRUG_ROUTE code-properties} - :uk.nhs.dmd/BNF :uk.nhs.dmd/ATC - {:uk.nhs.dmd/CONTROL_DRUG_INFO code-properties} - {:uk.nhs.dmd/ONT_DRUG_FORM code-properties} - :uk.nhs.dmd/VPIDPREV :uk.nhs.dmd/DDD - {:uk.nhs.dmd/PRES_STAT code-properties} - :uk.nhs.dmd/PRES_STATCD - {:uk.nhs.dmd/UDFS_UOM code-properties} - {:uk.nhs.dmd/DF_IND code-properties} - {:uk.nhs.dmd/BASIS code-properties} - {:uk.nhs.dmd/VIRTUAL_PRODUCT_INGREDIENT [:uk.nhs.dmd/ISID - :uk.nhs.dmd/ISIDPREV - :uk.nhs.dmd/STRNT_NMRTR_VAL - :uk.nhs.dmd/NM - :uk.nhs.dmd/ISIDDT - {:uk.nhs.dmd/STRNT_NMRTR_UOM code-properties} - {:uk.nhs.dmd/BASIS_STRNT code-properties} - :uk.nhs.dmd/STRNT_NMRTR_UOMCD - :uk.nhs.dmd/BASIS_STRNTCD]} - :uk.nhs.dmd/DDD_UOMCD - :uk.nhs.dmd/BASISCD - :uk.nhs.dmd/UNIT_DOSE_UOMCD - {:uk.nhs.dmd/DRUG_FORM code-properties}]} - (namespace-map "uk.nhs.dmd" (dmd/fetch-product store VPID))) - -(pco/defresolver fetch-extended-amp - [{::keys [store]} {:uk.nhs.dmd/keys [APID]}] - {::pco/output [:uk.nhs.dmd/VPID]} - (namespace-map "uk.nhs.dmd" (dmd/fetch-product store APID))) - -(pco/defresolver vmps-for-product - [{::keys [store]} {:uk.nhs.dmd/keys [ID]}] - {::pco/output [{:uk.nhs.dmd/VMPS [:uk.nhs.dmd/VPID]}]} - {:uk.nhs.dmd/VMPS (dmd/vmps-for-product store ID)}) - -(def all-resolvers - "dm+d resolvers; each expects an environment that contains - a key `:com.eldrix.dmd.graph/store` representing a dm+d store." - [product-from-snomed-identifier - fetch-vtm - fetch-extended-vmp - fetch-extended-amp - vmps-for-product - ;; these alias-resolvers make it possible to navigate seamlessly from a dm+d - ;; product to the SNOMED structures, including relationships and therefore - ;; inference - (pbir/alias-resolver :uk.nhs.dmd/VTMID :info.snomed.Concept/id) - (pbir/alias-resolver :uk.nhs.dmd/VPID :info.snomed.Concept/id) - (pbir/alias-resolver :uk.nhs.dmd/APID :info.snomed.Concept/id) - (pbir/alias-resolver :uk.nhs.dmd/VPPID :info.snomed.Concept/id) - (pbir/alias-resolver :uk.nhs.dmd/APPID :info.snomed.Concept/id) - (pbir/alias-resolver :uk.nhs.dmd/ISID :info.snomed.Concept/id)]) - -(comment - (def store (dmd/open-store "dmd-2021-09-06.db")) - (def registry (-> (pci/register all-resolvers) - (assoc ::store store))) - (p.eql/process registry - [{[:uk.nhs.dmd/VTMID 108537001] - '[* :uk.nhs.dmd/NM]}]) - (namespace-map "uk.nhs.dmd" (dmd/fetch-product store 108537001)) ;; VTM - (map #(namespace-map "uk.nhs.dmd" %) (dmd/vmps-for-product store 108537001)) - - (p.eql/process registry - [{[:uk.nhs.dmd/VPID 39731911000001109] - [:uk.nhs.dmd/VTMID - :uk.nhs.dmd/NM - :uk.nhs.dmd/VMPS - :info.snomed.Concept/id]}])) From 4fca6409028a605e2d2c4ce8eb26464759a9059f Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 18:41:21 +0100 Subject: [PATCH 3/8] Store schema v2: complete dm+d field coverage and provenance metadata Bump store-version to 2. Databases must be rebuilt; this is the normal model as each dm+d release is a new database file. - Add HISTORY table (historic code map: class, current and previous identifiers, validity dates) and VTM__INGREDIENT table, fed by the newly-imported supplementary files. - Store all fields defined by the dm+d v2.3 XSDs that were previously parsed but dropped: VMP previous identifiers, name changes and combination product; ingredient denominator strengths (BS_SUBID, STRNT_DNMTR_VAL/UOMCD); controlled drug category dates; AMP invalidity, licensing authority changes, flavour, EMA and parallel import; AMP product information size/weight and colour; AMPP discontinuation date; reimbursement LTD_STAB; GTIN end date; ingredient previous identifiers and invalidity; and CDDT/CDPREV (+ INVALID for suppliers) on the form, route, unit of measure and supplier lookups. - Fix VMPP insert which omitted its own INVALID and COMBPACKCD columns. - METADATA gains a JSON 'trud' provenance column; new FILES table records the source file inventory. - Entities may now declare indexes; add indexes on common join columns (VMP.VTMID, AMP.VPID, VMPP.VPID, AMPP.VPPID/APID, BNF_DETAILS VPID/ATC, ingredient and GTIN join keys). - fetch-lookup/fetch-all-lookup return all columns; fetch-amp resolves flavour and combination product. Includes in-flight work adding a pooled DataSource and database identification via application_id. Co-Authored-By: Claude Fable 5 --- src/com/eldrix/dmd/store4.clj | 270 ++++++++++++++++++------- test/src/com/eldrix/dmd/store_test.clj | 16 ++ 2 files changed, 212 insertions(+), 74 deletions(-) diff --git a/src/com/eldrix/dmd/store4.clj b/src/com/eldrix/dmd/store4.clj index 5d68e86..b52e609 100644 --- a/src/com/eldrix/dmd/store4.clj +++ b/src/com/eldrix/dmd/store4.clj @@ -1,6 +1,7 @@ (ns com.eldrix.dmd.store4 "dm+d storage using sqlite" (:require [clojure.core.async :as async] + [clojure.data.json :as json] [clojure.java.io :as io] [clojure.set :as set] [clojure.spec.alpha :as s] @@ -8,19 +9,27 @@ [clojure.tools.logging :as log] [com.eldrix.dmd.import :as dim] [honey.sql :as sql] - [next.jdbc :as jdbc]) - (:import (java.time LocalDate LocalDateTime))) + [next.jdbc :as jdbc] + [next.jdbc.connection :as connection]) + (:import (com.zaxxer.hikari HikariDataSource) + (java.time LocalDate LocalDateTime))) (set! *warn-on-reflection* true) -(def store-version 1) +(def store-version 2) + +;; SQLite application_id (file-header magic) identifying this as a dm+d store. +;; ASCII "dm+d" = 0x646D2B64. Treat as a fixed format-family identifier; do +;; not change. Schema evolution is signalled via store-version (user_version). +(def application-id 0x646D2B64) (s/def ::conn any?) (s/def ::id (s/or :kw keyword? :coll (s/coll-of keyword?))) (s/def ::create string?) (s/def ::insert string?) (s/def ::data fn?) -(s/def ::entity (s/keys :req-un [::id ::create] :opt-un [::insert ::data])) +(s/def ::index (s/or :str string? :coll (s/coll-of string?))) +(s/def ::entity (s/keys :req-un [::id ::create] :opt-un [::insert ::data ::index])) (s/def ::lookup (s/or ::str string? ::sym symbol? ::kw keyword?)) (s/def ::code (s/nilable int?)) @@ -35,7 +44,9 @@ (def entities [{:id :metadata - :create "create table METADATA (version integer, created text, release text)"} + :create "create table METADATA (version integer, created text, release text, trud text)"} + {:id :files + :create "create table FILES (type text, name text, date text)"} {:id [:LOOKUP :COMBINATION_PACK_IND] :create "create table COMBINATION_PACK_IND (CD integer primary key, DESC text)" :insert "insert into COMBINATION_PACK_IND(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" @@ -65,29 +76,29 @@ :insert "insert into LICENSING_AUTHORITY(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" :data (juxt :CD :DESC)} {:id [:LOOKUP :UNIT_OF_MEASURE] - :create "create table UNIT_OF_MEASURE (CD integer primary key, DESC text)" - :insert "insert into UNIT_OF_MEASURE(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" - :data (juxt :CD :DESC)} + :create "create table UNIT_OF_MEASURE (CD integer primary key, CDDT text, CDPREV integer, DESC text)" + :insert "insert into UNIT_OF_MEASURE(CD,CDDT,CDPREV,DESC) VALUES (?,?,?,?) ON CONFLICT(CD) DO UPDATE SET CDDT=excluded.CDDT, CDPREV=excluded.CDPREV, DESC=excluded.DESC" + :data (juxt :CD :CDDT :CDPREV :DESC)} {:id [:LOOKUP :FORM] - :create "create table FORM (CD integer primary key, DESC text)" - :insert "insert into FORM(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" - :data (juxt :CD :DESC)} + :create "create table FORM (CD integer primary key, CDDT text, CDPREV integer, DESC text)" + :insert "insert into FORM(CD,CDDT,CDPREV,DESC) VALUES (?,?,?,?) ON CONFLICT(CD) DO UPDATE SET CDDT=excluded.CDDT, CDPREV=excluded.CDPREV, DESC=excluded.DESC" + :data (juxt :CD :CDDT :CDPREV :DESC)} {:id [:LOOKUP :ONT_FORM_ROUTE] :create "create table ONT_FORM_ROUTE (CD integer primary key, DESC text)" :insert "insert into ONT_FORM_ROUTE(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" :data (juxt :CD :DESC)} {:id [:LOOKUP :ROUTE] - :create "create table ROUTE (CD integer primary key, DESC text)" - :insert "insert into ROUTE(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" - :data (juxt :CD :DESC)} + :create "create table ROUTE (CD integer primary key, CDDT text, CDPREV integer, DESC text)" + :insert "insert into ROUTE(CD,CDDT,CDPREV,DESC) VALUES (?,?,?,?) ON CONFLICT(CD) DO UPDATE SET CDDT=excluded.CDDT, CDPREV=excluded.CDPREV, DESC=excluded.DESC" + :data (juxt :CD :CDDT :CDPREV :DESC)} {:id [:LOOKUP :DT_PAYMENT_CATEGORY] :create "create table DT_PAYMENT_CATEGORY (CD integer primary key, DESC text)" :insert "insert into DT_PAYMENT_CATEGORY(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" :data (juxt :CD :DESC)} {:id [:LOOKUP :SUPPLIER] - :create "create table SUPPLIER (CD integer primary key, DESC text)" - :insert "insert into SUPPLIER(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" - :data (juxt :CD :DESC)} + :create "create table SUPPLIER (CD integer primary key, CDDT text, CDPREV integer, INVALID boolean, DESC text)" + :insert "insert into SUPPLIER(CD,CDDT,CDPREV,INVALID,DESC) VALUES (?,?,?,?,?) ON CONFLICT(CD) DO UPDATE SET CDDT=excluded.CDDT, CDPREV=excluded.CDPREV, INVALID=excluded.INVALID, DESC=excluded.DESC" + :data (juxt :CD :CDDT :CDPREV :INVALID :DESC)} {:id [:LOOKUP :FLAVOUR] :create "create table FLAVOUR (CD integer primary key, DESC text)" :insert "insert into FLAVOUR(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" @@ -141,27 +152,32 @@ :insert "insert into LICENSING_AUTHORITY_CHANGE_REASON(CD,DESC) VALUES (?, ?) ON CONFLICT(CD) DO UPDATE SET DESC=excluded.DESC" :data (juxt :CD :DESC)} {:id [:INGREDIENT :INGREDIENT] - :create "create table INGREDIENT (ISID integer primary key, NM text)" - :insert "insert into INGREDIENT(ISID,NM) VALUES (?, ?) ON CONFLICT(ISID) DO UPDATE SET NM=excluded.NM" - :data (juxt :ISID :NM)} + :create "create table INGREDIENT (ISID integer primary key, ISIDDT text, ISIDPREV integer, INVALID boolean, NM text)" + :insert "insert into INGREDIENT(ISID,ISIDDT,ISIDPREV,INVALID,NM) VALUES (?,?,?,?,?) ON CONFLICT(ISID) DO UPDATE SET ISIDDT=excluded.ISIDDT, ISIDPREV=excluded.ISIDPREV, INVALID=excluded.INVALID, NM=excluded.NM" + :data (juxt :ISID :ISIDDT :ISIDPREV :INVALID :NM)} {:id [:VTM :VTM] :create "create table VTM (VTMID integer primary key, INVALID boolean, NM text, ABBREVNM text, VTMIDPREV integer, VTMIDDT text)" :insert "insert into VTM(VTMID, INVALID, NM, ABBREVNM, VTMIDPREV, VTMIDDT) VALUES (?,?,?,?,?,?)" :data (juxt :VTMID :INVALID :NM :ABBREVNM :VTMIDPREV :VTMIDDT)} {:id [:VMP :VMP] - :create "create table VMP (VPID integer primary key, INVALID boolean, VTMID integer, NM text, BASISCD integer, PRES_STATCD integer, SUG_F boolean, GLU_F boolean, PRES_F boolean, CFC_F boolean, - NON_AVAILCD integer, DF_INDCD integer, UDFS text, UDFS_UOMCD integer, UNIT_DOSE_UOMCD, + :create "create table VMP (VPID integer primary key, VPIDDT text, VPIDPREV integer, INVALID boolean, VTMID integer, NM text, ABBREVNM text, + BASISCD integer, NMDT text, NMPREV text, BASIS_PREVCD integer, NMCHANGECD integer, COMBPRODCD integer, + PRES_STATCD integer, SUG_F boolean, GLU_F boolean, PRES_F boolean, CFC_F boolean, + NON_AVAILCD integer, NON_AVAILDT text, DF_INDCD integer, UDFS text, UDFS_UOMCD integer, UNIT_DOSE_UOMCD integer, foreign key (VTMID) references VTM(VTMID), foreign key(BASISCD) references BASIS_OF_NAME(CD), foreign key(PRES_STATCD) references VIRTUAL_PRODUCT_PRES_STATUS(CD), + foreign key (BASIS_PREVCD) references BASIS_OF_NAME(CD), foreign key(NMCHANGECD) references NAMECHANGE_REASON(CD), foreign key(COMBPRODCD) references COMBINATION_PROD_IND(CD), foreign key (NON_AVAILCD) references VIRTUAL_PRODUCT_NON_AVAIL(CD), foreign key (DF_INDCD) references DF_INDICATOR(CD), foreign key (UDFS_UOMCD) references UNIT_OF_MEASURE(CD), foreign key(UNIT_DOSE_UOMCD) references UNIT_OF_MEASURE(CD))" - :insert "insert into VMP(VPID, INVALID, VTMID, NM, BASISCD, PRES_STATCD, SUG_F, GLU_F, PRES_F, CFC_F, NON_AVAILCD, DF_INDCD, UDFS, UDFS_UOMCD, UNIT_DOSE_UOMCD) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - :data (juxt :VPID :INVALID :VTMID :NM :BASISCD :PRES_STATCD :SUG_F :GLU_F :PRES_F :CFC_F :NON_AVAILCD :DF_INDCD :UDFS :UDFS_UOMCD :UNIT_DOSE_UOMCD)} + :index "create index VMP_VTMID_IDX on VMP(VTMID)" + :insert "insert into VMP(VPID, VPIDDT, VPIDPREV, INVALID, VTMID, NM, ABBREVNM, BASISCD, NMDT, NMPREV, BASIS_PREVCD, NMCHANGECD, COMBPRODCD, PRES_STATCD, SUG_F, GLU_F, PRES_F, CFC_F, NON_AVAILCD, NON_AVAILDT, DF_INDCD, UDFS, UDFS_UOMCD, UNIT_DOSE_UOMCD) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" + :data (juxt :VPID :VPIDDT :VPIDPREV :INVALID :VTMID :NM :ABBREVNM :BASISCD :NMDT :NMPREV :BASIS_PREVCD :NMCHANGECD :COMBPRODCD :PRES_STATCD :SUG_F :GLU_F :PRES_F :CFC_F :NON_AVAILCD :NON_AVAILDT :DF_INDCD :UDFS :UDFS_UOMCD :UNIT_DOSE_UOMCD)} {:id [:VMP :VIRTUAL_PRODUCT_INGREDIENT] - :create "create table VMP__VIRTUAL_PRODUCT_INGREDIENT (VPID integer, ISID integer, BASIS_STRNTCD integer, STRNT_NMRTR_VAL real, STRNT_NMRTR_UOMCD integer, + :create "create table VMP__VIRTUAL_PRODUCT_INGREDIENT (VPID integer, ISID integer, BASIS_STRNTCD integer, BS_SUBID integer, STRNT_NMRTR_VAL real, STRNT_NMRTR_UOMCD integer, STRNT_DNMTR_VAL real, STRNT_DNMTR_UOMCD integer, foreign key(VPID) REFERENCES VMP(VPID),foreign key(ISID) REFERENCES INGREDIENT(ISID), - FOREIGN KEY(BASIS_STRNTCD) REFERENCES BASIS_OF_STRNTH(CD),FOREIGN KEY(STRNT_NMRTR_UOMCD) REFERENCES UNIT_OF_MEASURE(CD))" - :insert "insert into VMP__VIRTUAL_PRODUCT_INGREDIENT(VPID, ISID, BASIS_STRNTCD, STRNT_NMRTR_VAL, STRNT_NMRTR_UOMCD) VALUES (?, ?, ?, ?, ?)" - :data (juxt :VPID :ISID :BASIS_STRNTCD :STRNT_NMRTR_VAL :STRNT_NMRTR_UOMCD)} + FOREIGN KEY(BASIS_STRNTCD) REFERENCES BASIS_OF_STRNTH(CD),FOREIGN KEY(STRNT_NMRTR_UOMCD) REFERENCES UNIT_OF_MEASURE(CD),FOREIGN KEY(STRNT_DNMTR_UOMCD) REFERENCES UNIT_OF_MEASURE(CD))" + :index "create index VMP__VIRTUAL_PRODUCT_INGREDIENT_VPID_IDX on VMP__VIRTUAL_PRODUCT_INGREDIENT(VPID)" + :insert "insert into VMP__VIRTUAL_PRODUCT_INGREDIENT(VPID, ISID, BASIS_STRNTCD, BS_SUBID, STRNT_NMRTR_VAL, STRNT_NMRTR_UOMCD, STRNT_DNMTR_VAL, STRNT_DNMTR_UOMCD) VALUES (?,?,?,?,?,?,?,?)" + :data (juxt :VPID :ISID :BASIS_STRNTCD :BS_SUBID :STRNT_NMRTR_VAL :STRNT_NMRTR_UOMCD :STRNT_DNMTR_VAL :STRNT_DNMTR_UOMCD)} {:id [:VMP :ONT_DRUG_FORM] :create "create table VMP__ONT_DRUG_FORM (VPID integer, FORMCD integer, FOREIGN KEY(VPID) REFERENCES VMP(VPID), FOREIGN KEY(FORMCD) REFERENCES ONT_FORM_ROUTE(CD))" :insert "insert into VMP__ONT_DRUG_FORM(VPID, FORMCD) VALUES (?, ?)" @@ -175,15 +191,21 @@ :insert "insert into VMP__DRUG_ROUTE(VPID, ROUTECD) VALUES (?, ?)" :data (juxt :VPID :ROUTECD)} {:id [:VMP :CONTROL_DRUG_INFO] - :create "create table VMP__CONTROL_DRUG_INFO (VPID integer, CATCD integer, FOREIGN KEY(VPID) REFERENCES VMP(VPID), FOREIGN KEY(CATCD) REFERENCES CONTROL_DRUG_CATEGORY(CD))" - :insert "insert into VMP__CONTROL_DRUG_INFO(VPID, CATCD) VALUES (?, ?)" - :data (juxt :VPID :CATCD)} + :create "create table VMP__CONTROL_DRUG_INFO (VPID integer, CATCD integer, CATDT text, CAT_PREVCD integer, + FOREIGN KEY(VPID) REFERENCES VMP(VPID), FOREIGN KEY(CATCD) REFERENCES CONTROL_DRUG_CATEGORY(CD), FOREIGN KEY(CAT_PREVCD) REFERENCES CONTROL_DRUG_CATEGORY(CD))" + :insert "insert into VMP__CONTROL_DRUG_INFO(VPID, CATCD, CATDT, CAT_PREVCD) VALUES (?,?,?,?)" + :data (juxt :VPID :CATCD :CATDT :CAT_PREVCD)} {:id [:AMP :AMP] - :create "create table AMP (APID integer primary key, VPID integer, NM text, DESC text, SUPPCD integer, LIC_AUTHCD integer, AVAIL_RESTRICTCD integer, + :create "create table AMP (APID integer primary key, INVALID boolean, VPID integer, NM text, ABBREVNM text, DESC text, NMDT text, NM_PREV text, + SUPPCD integer, LIC_AUTHCD integer, LIC_AUTH_PREVCD integer, LIC_AUTHCHANGECD integer, LIC_AUTHCHANGEDT text, + COMBPRODCD integer, FLAVOURCD integer, EMA boolean, PARALLEL_IMPORT boolean, AVAIL_RESTRICTCD integer, FOREIGN KEY(VPID) REFERENCES VMP(VPID), FOREIGN KEY(SUPPCD) REFERENCES SUPPLIER(CD), - FOREIGN KEY(LIC_AUTHCD) REFERENCES LICENSING_AUTHORITY(CD), FOREIGN KEY(AVAIL_RESTRICTCD) REFERENCES AVAILABILITY_RESTRICTION(CD))" - :insert "insert into AMP(APID, VPID, NM, DESC, SUPPCD, LIC_AUTHCD, AVAIL_RESTRICTCD) VALUES (?, ?, ?, ?, ?, ?, ?)" - :data (juxt :APID :VPID :NM :DESC :SUPPCD :LIC_AUTHCD :AVAIL_RESTRICTCD)} + FOREIGN KEY(LIC_AUTHCD) REFERENCES LICENSING_AUTHORITY(CD), FOREIGN KEY(LIC_AUTH_PREVCD) REFERENCES LICENSING_AUTHORITY(CD), + FOREIGN KEY(LIC_AUTHCHANGECD) REFERENCES LICENSING_AUTHORITY_CHANGE_REASON(CD), FOREIGN KEY(COMBPRODCD) REFERENCES COMBINATION_PROD_IND(CD), + FOREIGN KEY(FLAVOURCD) REFERENCES FLAVOUR(CD), FOREIGN KEY(AVAIL_RESTRICTCD) REFERENCES AVAILABILITY_RESTRICTION(CD))" + :index "create index AMP_VPID_IDX on AMP(VPID)" + :insert "insert into AMP(APID, INVALID, VPID, NM, ABBREVNM, DESC, NMDT, NM_PREV, SUPPCD, LIC_AUTHCD, LIC_AUTH_PREVCD, LIC_AUTHCHANGECD, LIC_AUTHCHANGEDT, COMBPRODCD, FLAVOURCD, EMA, PARALLEL_IMPORT, AVAIL_RESTRICTCD) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" + :data (juxt :APID :INVALID :VPID :NM :ABBREVNM :DESC :NMDT :NM_PREV :SUPPCD :LIC_AUTHCD :LIC_AUTH_PREVCD :LIC_AUTHCHANGECD :LIC_AUTHCHANGEDT :COMBPRODCD :FLAVOURCD :EMA :PARALLEL_IMPORT :AVAIL_RESTRICTCD)} {:id [:AMP :AP_INGREDIENT] ;; excipients :create "create table AMP__AP_INGREDIENT (APID integer, ISID integer, STRNTH text, UOMCD integer, foreign key(APID) references AMP(APID), foreign key(ISID) references INGREDIENT(ISID), foreign key(UOMCD) references UNIT_OF_MEASURE(CD))" @@ -194,15 +216,17 @@ :insert "insert into AMP__LICENSED_ROUTE(APID, ROUTECD) VALUES (?, ?)" :data (juxt :APID :ROUTECD)} {:id [:AMP :AP_INFORMATION] - :create "create table AMP__AP_INFORMATION (APID integer, PROD_ORDER_NO text, foreign key(APID) REFERENCES AMP(APID))" - :insert "insert into AMP__AP_INFORMATION(APID, PROD_ORDER_NO) VALUES (?, ?)" - :data (juxt :APID :PROD_ORDER_NO)} + :create "create table AMP__AP_INFORMATION (APID integer, SZ_WEIGHT text, COLOURCD integer, PROD_ORDER_NO text, + foreign key(APID) REFERENCES AMP(APID), foreign key(COLOURCD) REFERENCES COLOUR(CD))" + :insert "insert into AMP__AP_INFORMATION(APID, SZ_WEIGHT, COLOURCD, PROD_ORDER_NO) VALUES (?,?,?,?)" + :data (juxt :APID :SZ_WEIGHT :COLOURCD :PROD_ORDER_NO)} {:id [:VMPP :VMPP] - :create "create table VMPP (VPPID integer primary key, INVALID integer, NM text, VPID integer, QTYVAL text, QTY_UOMCD integer, COMBPACKCD integer, + :create "create table VMPP (VPPID integer primary key, INVALID boolean, NM text, ABBREVNM text, VPID integer, QTYVAL text, QTY_UOMCD integer, COMBPACKCD integer, foreign key(VPID) REFERENCES VMP(VPID), foreign key(QTY_UOMCD) REFERENCES UNIT_OF_MEASURE(CD), FOREIGN KEY(COMBPACKCD) REFERENCES COMBINATION_PACK_IND(CD))" - :insert "insert into VMPP(VPPID, NM, VPID, QTYVAL, QTY_UOMCD) VALUES (?, ?, ?, ?, ?)" - :data (juxt :VPPID :NM :VPID :QTYVAL :QTY_UOMCD)} + :index "create index VMPP_VPID_IDX on VMPP(VPID)" + :insert "insert into VMPP(VPPID, INVALID, NM, ABBREVNM, VPID, QTYVAL, QTY_UOMCD, COMBPACKCD) VALUES (?,?,?,?,?,?,?,?)" + :data (juxt :VPPID :INVALID :NM :ABBREVNM :VPID :QTYVAL :QTY_UOMCD :COMBPACKCD)} {:id [:VMPP :DRUG_TARIFF_INFO] :create "create table VMPP__DRUG_TARIFF_INFO (VPPID integer, PAY_CATCD integer, PRICE text, DT text, PREVPRICE text, foreign key(VPPID) REFERENCES VMPP(VPPID), foreign key(PAY_CATCD) REFERENCES DT_PAYMENT_CATEGORY(CD))" @@ -214,14 +238,16 @@ :insert "insert into VMPP__COMB_CONTENT(PRNTVPPID, CHLDVPPID) VALUES (?, ?)" :data (juxt :PRNTVPPID :CHLDVPPID)} {:id [:AMPP :AMPP] - :create "create table AMPP (APPID integer primary key, INVALID integer, NM text, ABBREVNM text, + :create "create table AMPP (APPID integer primary key, INVALID boolean, NM text, ABBREVNM text, VPPID integer, APID integer, COMBPACKCD integer, LEGAL_CATCD integer, - SUBP text, DISCCD integer, + SUBP text, DISCCD integer, DISCDT text, foreign key(VPPID) REFERENCES VMPP(VPPID), foreign key(APID) REFERENCES AMP(APID), FOREIGN KEY(COMBPACKCD) REFERENCES COMBINATION_PACK_IND(CD), foreign key(LEGAL_CATCD) REFERENCES LEGAL_CATEGORY(CD), foreign key(DISCCD) REFERENCES DISCONTINUED_IND(CD))" - :insert "insert into AMPP(APPID, INVALID, NM, ABBREVNM, VPPID, APID, COMBPACKCD, LEGAL_CATCD, SUBP, DISCCD) VALUES (?, ?, ?, ?, ?, ?, ?,?,?,?)" - :data (juxt :APPID :INVALID :NM :ABBREVNM :VPPID :APID :COMBPACKCD :LEGAL_CATCD :SUBP :DISCCD)} + :index ["create index AMPP_VPPID_IDX on AMPP(VPPID)" + "create index AMPP_APID_IDX on AMPP(APID)"] + :insert "insert into AMPP(APPID, INVALID, NM, ABBREVNM, VPPID, APID, COMBPACKCD, LEGAL_CATCD, SUBP, DISCCD, DISCDT) VALUES (?,?,?,?,?,?,?,?,?,?,?)" + :data (juxt :APPID :INVALID :NM :ABBREVNM :VPPID :APID :COMBPACKCD :LEGAL_CATCD :SUBP :DISCCD :DISCDT)} {:id [:AMPP :APPLIANCE_PACK_INFO] :create "create table AMPP__APPLIANCE_PACK_INFO (APPID integer, REIMB_STATCD integer, REIMB_STATDT text, REIMB_STATPREVCD integer, PACK_ORDER_NO integer, foreign key(APPID) REFERENCES AMPP(APPID), foreign key(REIMB_STATCD) REFERENCES REIMBURSEMENT_STATUS(CD) @@ -240,25 +266,42 @@ :insert "insert into AMPP__MEDICINAL_PRODUCT_PRICE (APPID, PRICE, PRICEDT, PRICE_PREV, PRICE_BASISCD) VALUES (?,?,?,?,?)" :data (juxt :APPID :PRICE :PRICEDT :PRICE_PREV :PRICE_BASISCD)} {:id [:AMPP :REIMBURSEMENT_INFO] - :create "create table AMPP__REIMBURSEMENT_INFO (APPID integer, PX_CHRGS integer, DISP_FEES integer, BB integer, CAL_PACK integer, + :create "create table AMPP__REIMBURSEMENT_INFO (APPID integer, PX_CHRGS integer, DISP_FEES integer, BB integer, LTD_STAB integer, CAL_PACK integer, SPEC_CONTCD integer, DND integer, FP34D integer, foreign key(APPID) REFERENCES AMPP(APPID), foreign key(SPEC_CONTCD) REFERENCES SPEC_CONT(CD))" - :insert "insert into AMPP__REIMBURSEMENT_INFO (APPID, PX_CHRGS, DISP_FEES, BB, CAL_PACK, SPEC_CONTCD, DND, FP34D) VALUES (?,?,?,?,?,?,?,?)" - :data (juxt :APPID :PX_CHRGS :DISP_FEES :BB :CAL_PACK :SPEC_CONTCD :DND :FP34D)} + :insert "insert into AMPP__REIMBURSEMENT_INFO (APPID, PX_CHRGS, DISP_FEES, BB, LTD_STAB, CAL_PACK, SPEC_CONTCD, DND, FP34D) VALUES (?,?,?,?,?,?,?,?,?)" + :data (juxt :APPID :PX_CHRGS :DISP_FEES :BB :LTD_STAB :CAL_PACK :SPEC_CONTCD :DND :FP34D)} {:id [:AMPP :COMB_CONTENT] :create "create table AMPP__COMB_CONTENT (PRNTAPPID integer, CHLDAPPID integer, foreign key(PRNTAPPID) REFERENCES AMPP(APPID), foreign key(CHLDAPPID) REFERENCES AMPP(APPID))" :insert "insert into AMPP__COMB_CONTENT (PRNTAPPID, CHLDAPPID) VALUES (?,?)" :data (juxt :PRNTAPPID :CHLDAPPID)} {:id [:GTIN :AMPP] - :create "create table GTIN__AMPP (AMPPID integer, GTIN string, STARTDT string)" - :insert "insert into GTIN__AMPP (AMPPID, GTIN, STARTDT) VALUES (?,?,?)" - :data (juxt :AMPPID :GTIN :STARTDT)} + :create "create table GTIN__AMPP (AMPPID integer, GTIN text, STARTDT text, ENDDT text)" + :index "create index GTIN__AMPP_AMPPID_IDX on GTIN__AMPP(AMPPID)" + :insert "insert into GTIN__AMPP (AMPPID, GTIN, STARTDT, ENDDT) VALUES (?,?,?,?)" + :data (juxt :AMPPID :GTIN :STARTDT :ENDDT)} {:id [:BNF :VMPS] - :create "create table BNF_DETAILS (VPID integer, BNF string, ATC string, DDD string, DDD_UOMCD integer, + :create "create table BNF_DETAILS (VPID integer, BNF text, ATC text, DDD text, DDD_UOMCD integer, foreign key(DDD_UOMCD) references UNIT_OF_MEASURE(CD))" + :index ["create index BNF_DETAILS_VPID_IDX on BNF_DETAILS(VPID)" + "create index BNF_DETAILS_ATC_IDX on BNF_DETAILS(ATC)"] :insert "insert into BNF_DETAILS (VPID, BNF, ATC, DDD, DDD_UOMCD) VALUES (?,?,?,?,?)" - :data (juxt :VPID :BNF :ATC :DDD :DDD_UOMCD)}]) + :data (juxt :VPID :BNF :ATC :DDD :DDD_UOMCD)} + {:id [:HISTORY :HISTORY] + ;; no foreign keys: most previous identifiers deliberately do not exist in current tables + :create "create table HISTORY (CLS text, IDCURRENT integer, IDPREVIOUS integer, STARTDT text, ENDDT text)" + :index ["create index HISTORY_IDCURRENT_IDX on HISTORY(IDCURRENT)" + "create index HISTORY_IDPREVIOUS_IDX on HISTORY(IDPREVIOUS)"] + :insert "insert into HISTORY (CLS, IDCURRENT, IDPREVIOUS, STARTDT, ENDDT) VALUES (?,?,?,?,?)" + :data (juxt :CLS :IDCURRENT :IDPREVIOUS :STARTDT :ENDDT)} + {:id [:VTM_ING :VTM_ING] + :create "create table VTM__INGREDIENT (VTMID integer, ISID integer, + foreign key(VTMID) references VTM(VTMID), foreign key(ISID) references INGREDIENT(ISID))" + :index ["create index VTM__INGREDIENT_VTMID_IDX on VTM__INGREDIENT(VTMID)" + "create index VTM__INGREDIENT_ISID_IDX on VTM__INGREDIENT(ISID)"] + :insert "insert into VTM__INGREDIENT (VTMID, ISID) VALUES (?,?)" + :data (juxt :VTMID :ISID)}]) (when-not (s/valid? (s/coll-of ::entity) entities) @@ -278,8 +321,11 @@ (s/fdef create-indexes :args (s/cat :conn ::conn)) (defn create-indexes + "Creates all database indexes; each entity may define none, one, or many." [conn] - (->> entities (map :index) (remove nil?) (run! #(jdbc/execute! conn [%])))) + (->> entities + (mapcat (fn [{:keys [index]}] (if (string? index) [index] index))) + (run! #(jdbc/execute! conn [%])))) (defn batch->sql "For the given batch of dm+d entities, return a map of :stmts and :errors @@ -299,13 +345,74 @@ {} (group-by :TYPE batch))) +;; First 16 bytes of every SQLite 3 file: the literal "SQLite format 3\000". +(def ^:private ^"[B" sqlite-magic + (byte-array (map byte (concat "SQLite format 3" [0])))) + +(defn- read-sqlite-header + "Read the 100-byte SQLite header. Returns the byte array, or nil if the + file does not exist, is not a regular file, or is shorter than 100 bytes." + ^"[B" [f] + (let [file (io/file f)] + (when (and (.isFile file) (>= (.length file) 100)) + (with-open [in (io/input-stream file)] + (let [buf (byte-array 100)] + (when (= 100 (.readNBytes in buf 0 100)) buf)))))) + +(defn- header-int32 + "Read a big-endian unsigned 32-bit int at offset `off`." + ^long [^bytes header ^long off] + (bit-or (bit-shift-left (bit-and 0xFF (aget header off)) 24) + (bit-shift-left (bit-and 0xFF (aget header (+ off 1))) 16) + (bit-shift-left (bit-and 0xFF (aget header (+ off 2))) 8) + (bit-and 0xFF (aget header (+ off 3))))) + +(defn- sqlite-magic? [^bytes header] + (java.util.Arrays/equals (java.util.Arrays/copyOfRange header 0 16) sqlite-magic)) + +(defn sqlite-database? + "Returns true if `f` is a SQLite 3 database file (checked by header magic)." + [f] + (boolean (some-> (read-sqlite-header f) sqlite-magic?))) + +(defn dmd-database? + "Returns true if `f` is a dm+d SQLite database created by this library + (SQLite magic + application_id == 0x646D2B64). Strict by default: legacy + dm+d databases predating application_id support return false." + [f] + (boolean (when-let [header (read-sqlite-header f)] + (and (sqlite-magic? header) + (= application-id (header-int32 header 68)))))) + +(defn- pool + ^HikariDataSource [filename {:keys [maximum-pool-size init-sql]}] + (connection/->pool HikariDataSource + (cond-> {:jdbcUrl (str "jdbc:sqlite:" filename) + :maximumPoolSize (or maximum-pool-size 4)} + init-sql (assoc :connectionInitSql init-sql)))) + +(defn- read-pragma [conn pragma] + (some-> (jdbc/execute-one! conn [(str "PRAGMA " pragma)]) vals first)) + (defn open-store [filename] - (if (.exists (io/file filename)) - (jdbc/get-datasource (str "jdbc:sqlite:" filename)) - (throw (ex-info (str "file not found:" filename) {})))) - -(defn close "Close the store." [_]) ;; NOP in current implementation + (when-not (.exists (io/file filename)) + (throw (ex-info (str "file not found: " filename) {:filename filename}))) + (let [ds (pool filename {:init-sql "PRAGMA query_only = 1"}) + app-id (read-pragma ds "application_id")] + ;; legacy databases created before application_id was set will have 0 + (when-not (or (zero? app-id) (= app-id application-id)) + (.close ds) + (throw (ex-info (str "not a dm+d database: " filename) + {:filename filename + :application-id (format "0x%08x" app-id) + :expected (format "0x%08x" application-id)}))) + ds)) + +(defn close + "Close the store, releasing pooled connections." + [^HikariDataSource ds] + (when ds (.close ds))) (s/fdef fetch-release-date :args (s/cat :conn ::conn)) @@ -314,24 +421,35 @@ (some-> (:METADATA/release (jdbc/execute-one! conn ["select release from metadata"])) LocalDate/parse)) (defn create-store - [filename dirs & {:keys [batch-size release-date] :or {batch-size 50000}}] + "Create a dm+d store at `filename` from the directories `dirs`. + Options: + - :batch-size - number of components per write batch (default 50000) + - :release-date - date of the dm+d release + - :trud - source TRUD release information, stored for provenance" + [filename dirs & {:keys [batch-size release-date trud] :or {batch-size 50000}}] (when (.exists (io/file filename)) (throw (ex-info (str "dm+d database already exists: " filename) {}))) - (let [ds (jdbc/get-datasource (str "jdbc:sqlite:" filename)) + (let [ds (pool filename {:maximum-pool-size 1}) ;; SQLite serialises writers; one connection is enough ch (async/chan 5 (comp (partition-all batch-size) (map batch->sql)))] - (async/thread - (doseq [dir dirs] - (dim/stream-dmd dir ch :close? false)) - (async/close! ch)) - (create-tables ds) - (jdbc/execute! ds ["insert into metadata (version, created, release) values (?,?,?)" - store-version (LocalDateTime/now) release-date]) (try + (async/thread + (doseq [dir dirs] + (dim/stream-dmd dir ch :close? false)) + (async/close! ch)) + (jdbc/execute! ds [(str "PRAGMA application_id = " application-id)]) + (jdbc/execute! ds [(str "PRAGMA user_version = " store-version)]) + (create-tables ds) + (jdbc/execute! ds ["insert into metadata (version, created, release, trud) values (?,?,?,?)" + store-version (LocalDateTime/now) release-date (some-> trud json/write-str)]) + (jdbc/execute-batch! ds "insert into FILES (type, name, date) values (?,?,?)" + (mapv (fn [{:keys [type date ^java.io.File file]}] + [(name type) (.getName file) (str date)]) + (mapcat dim/dmd-file-seq dirs)) + {}) (loop [{:keys [stmts errors] :as batch} (async/ Date: Thu, 11 Jun 2026 18:44:11 +0100 Subject: [PATCH 4/8] Strict open-store and structured status API open-store now rejects, with descriptive errors: missing files, files that are not SQLite databases, SQLite databases that are not dm+d databases (including legacy dm+d files predating application_id support), and dm+d databases with an incompatible store version. A database is identifiable from its first 100 bytes without opening a connection. New 'status' returns store version, creation time, dm+d release date, TRUD provenance and source file inventory when available, and entity counts, so a consumer can display e.g. "dm+d 2025-01-16, schema v2". Co-Authored-By: Claude Fable 5 --- src/com/eldrix/dmd/core.clj | 24 ++++++++++-- src/com/eldrix/dmd/store4.clj | 54 ++++++++++++++++++++++---- test/src/com/eldrix/dmd/store_test.clj | 40 ++++++++++++++++++- 3 files changed, 106 insertions(+), 12 deletions(-) diff --git a/src/com/eldrix/dmd/core.clj b/src/com/eldrix/dmd/core.clj index 1f4c89e..578a21d 100644 --- a/src/com/eldrix/dmd/core.clj +++ b/src/com/eldrix/dmd/core.clj @@ -53,19 +53,37 @@ (install-release api-key-file cache-dir)) (defn open-store - "Open a dm+d store. Returns what should be regarded as an opaque handle, - that should be closed using `close`. Currently this is a DataSource but - this is subject to change. `f` can be anything coercible to a file using + "Open a dm+d store. Returns what should be regarded as an opaque handle, + that should be closed using `close`. Currently this is a DataSource but + this is subject to change. `f` can be anything coercible to a file using [[clojure.java.io/as-file]]. Throws an exception if the file does not exist." [f] (st4/open-store f)) +(defn sqlite-database? + "Returns true if `f` is a SQLite 3 database file." + [f] + (st4/sqlite-database? f)) + +(defn dmd-database? + "Returns true if `f` is a dm+d SQLite database created by this library. + Strict: legacy dm+d files predating the application_id marker return false." + [f] + (st4/dmd-database? f)) + (defn close [st] (st4/close st)) (defn fetch-release-date [store] (st4/fetch-release-date store)) +(defn status + "Returns a structured description of an open dm+d store, including store + schema version, creation date, dm+d release date, source TRUD release + information and file inventory when available, and entity counts." + [store] + (st4/status store)) + (defn fetch-product [store product-id] (st4/fetch-product store product-id)) diff --git a/src/com/eldrix/dmd/store4.clj b/src/com/eldrix/dmd/store4.clj index b52e609..4399583 100644 --- a/src/com/eldrix/dmd/store4.clj +++ b/src/com/eldrix/dmd/store4.clj @@ -395,18 +395,27 @@ (some-> (jdbc/execute-one! conn [(str "PRAGMA " pragma)]) vals first)) (defn open-store + "Open a read-only dm+d store, returning a pooled DataSource that supports + concurrent use. Throws an exception if the file does not exist, is not a + dm+d database (checked via SQLite application_id), or was created with an + incompatible store version (checked via SQLite user_version). Legacy + databases, including those predating application_id support, are rejected + and must be rebuilt using this version of the library." [filename] (when-not (.exists (io/file filename)) (throw (ex-info (str "file not found: " filename) {:filename filename}))) - (let [ds (pool filename {:init-sql "PRAGMA query_only = 1"}) - app-id (read-pragma ds "application_id")] - ;; legacy databases created before application_id was set will have 0 - (when-not (or (zero? app-id) (= app-id application-id)) + (when-not (dmd-database? filename) + (throw (ex-info (str (if (sqlite-database? filename) + "not a dm+d database (or a legacy dm+d database that must be rebuilt): " + "not a SQLite database: ") filename) + {:filename filename}))) + (let [ds (pool filename {:init-sql "PRAGMA query_only = 1"}) + version (read-pragma ds "user_version")] + (when-not (= store-version version) (.close ds) - (throw (ex-info (str "not a dm+d database: " filename) - {:filename filename - :application-id (format "0x%08x" app-id) - :expected (format "0x%08x" application-id)}))) + (throw (ex-info (str "incompatible dm+d database version: found " version + ", expected " store-version "; rebuild the database using this version of dmd") + {:filename filename :version version :expected store-version}))) ds)) (defn close @@ -420,6 +429,35 @@ [conn] (some-> (:METADATA/release (jdbc/execute-one! conn ["select release from metadata"])) LocalDate/parse)) +(def ^:private count-tables + "Tables counted by [[status]], as a vector of key and table name." + [[:VTM "VTM"] [:VMP "VMP"] [:AMP "AMP"] [:VMPP "VMPP"] [:AMPP "AMPP"] + [:INGREDIENT "INGREDIENT"] [:HISTORY "HISTORY"] [:VTM_INGREDIENT "VTM__INGREDIENT"] + [:GTIN "GTIN__AMPP"] [:BNF "BNF_DETAILS"]]) + +(s/fdef status + :args (s/cat :conn ::conn)) +(defn status + "Returns a structured description of an open dm+d store: + - :version - store (schema) version + - :created - java.time.LocalDateTime the database was created + - :release - java.time.LocalDate of the dm+d release + - :trud - source TRUD release information, when installed via TRUD + - :files - inventory of imported source files + - :counts - a map of entity type to row count" + [conn] + (let [{:METADATA/keys [version created release trud]} (jdbc/execute-one! conn ["select * from metadata"])] + {:version version + :created (some-> created LocalDateTime/parse) + :release (some-> release LocalDate/parse) + :trud (some-> trud (json/read-str :key-fn keyword)) + :files (mapv (fn [{:FILES/keys [type name date]}] + {:type (keyword type) :name name :date (some-> date LocalDate/parse)}) + (jdbc/execute! conn ["select * from files"])) + :counts (reduce (fn [acc [k table]] + (assoc acc k (:n (jdbc/execute-one! conn [(str "select count(*) as n from " table)])))) + {} count-tables)})) + (defn create-store "Create a dm+d store at `filename` from the directories `dirs`. Options: diff --git a/test/src/com/eldrix/dmd/store_test.clj b/test/src/com/eldrix/dmd/store_test.clj index f6342cc..f9cc9e2 100644 --- a/test/src/com/eldrix/dmd/store_test.clj +++ b/test/src/com/eldrix/dmd/store_test.clj @@ -2,7 +2,9 @@ (:require [clojure.spec.test.alpha :as stest] [clojure.test :refer [deftest is run-tests]] [com.eldrix.dmd.core :as dmd] - [clojure.java.io :as io]) + [com.eldrix.dmd.store4 :as st4] + [clojure.java.io :as io] + [next.jdbc :as jdbc]) (:import (java.io File) (java.time LocalDate))) @@ -16,6 +18,42 @@ (dmd/install-from-dirs filename [(io/resource dir)] :batch-size 1) (dmd/open-store filename))) +(deftest open-invalid-files + (let [not-sqlite (doto (File/createTempFile "dmd-test" ".db") (spit "this is not a database")) + not-dmd (File/createTempFile "dmd-test" ".db") + wrong-version (File/createTempFile "dmd-test" ".db")] + (.delete not-dmd) + (.delete wrong-version) + (with-open [conn (jdbc/get-connection (str "jdbc:sqlite:" not-dmd))] + (jdbc/execute-one! conn ["create table TEST (id integer)"])) + (with-open [conn (jdbc/get-connection (str "jdbc:sqlite:" wrong-version))] + (jdbc/execute-one! conn [(str "PRAGMA application_id = " st4/application-id)]) + (jdbc/execute-one! conn ["PRAGMA user_version = 1"]) + (jdbc/execute-one! conn ["create table TEST (id integer)"])) + (is (thrown-with-msg? Exception #"file not found" (dmd/open-store "no-such-file.db"))) + (is (thrown-with-msg? Exception #"not a SQLite database" (dmd/open-store not-sqlite))) + (is (not (dmd/sqlite-database? not-sqlite))) + (is (thrown-with-msg? Exception #"not a dm\+d database" (dmd/open-store not-dmd))) + (is (dmd/sqlite-database? not-dmd)) + (is (not (dmd/dmd-database? not-dmd))) + (is (thrown-with-msg? Exception #"incompatible dm\+d database version" (dmd/open-store wrong-version))) + (is (dmd/dmd-database? wrong-version)) + (run! #(.delete ^File %) [not-sqlite not-dmd wrong-version]))) + +(deftest store-status + (let [st (create-and-open-store) + {:keys [version created release trud files counts]} (dmd/status st)] + (is (= 2 version)) + (is created) + (is (= (LocalDate/of 2021 8 26) release)) + (is (nil? trud) "no TRUD provenance when installed from local directories") + (is (= 11 (count files))) + (is (= #{:LOOKUP :INGREDIENT :VTM :VMP :AMP :VMPP :AMPP :GTIN :BNF :HISTORY :VTM_ING} + (set (map :type files)))) + (is (= {:VTM 1 :VMP 2 :AMP 3 :VMPP 1 :AMPP 1 :INGREDIENT 4 :HISTORY 10 :VTM_INGREDIENT 2 :GTIN 1 :BNF 1} + counts)) + (dmd/close st))) + ;; test basic import, store and fetch across products. (deftest import-store-and-fetch (let [st (create-and-open-store) From 85c7854495ab0ba82a6152feeca4ac816f2a51e7 Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 18:45:36 +0100 Subject: [PATCH 5/8] Add history, VTM ingredient, enumeration and streaming query APIs For consumers building terminology services over a dm+d store: - fetch-history / previous-ids / current-ids resolve deprecated codes to their live equivalents (and vice versa) using the historic code data; 'self' entries are excluded from id mapping. - vtm-ingredients / vtms-for-ingredient expose the VTM-ingredient relationships from the supplementary data. - plan-products returns a reducible over all products of a type for streaming iteration; lookup-types enumerates all lookup tables. Co-Authored-By: Claude Fable 5 --- src/com/eldrix/dmd/core.clj | 39 +++++++++++++++ src/com/eldrix/dmd/store4.clj | 67 ++++++++++++++++++++++++++ test/src/com/eldrix/dmd/store_test.clj | 20 ++++++++ 3 files changed, 126 insertions(+) diff --git a/src/com/eldrix/dmd/core.clj b/src/com/eldrix/dmd/core.clj index 578a21d..2d078c8 100644 --- a/src/com/eldrix/dmd/core.clj +++ b/src/com/eldrix/dmd/core.clj @@ -93,6 +93,45 @@ (defn fetch-lookup [conn lookup-kind] (st4/fetch-all-lookup conn lookup-kind)) +(def lookup-types + "Set of lookup types, as keywords, usable with [[fetch-lookup]]." + st4/lookup-types) + +(defn fetch-history + "Returns all history entries in which `id` is the current identifier, + ordered by start date, including 'self' entries recording the period of + validity of the current identifier itself." + [conn id] + (st4/fetch-history conn id)) + +(defn previous-ids + "Returns the set of prior identifiers for the given current identifier." + [conn id] + (st4/previous-ids conn id)) + +(defn current-ids + "Returns the set of identifiers in current use for the given (usually + historic) identifier." + [conn id] + (st4/current-ids conn id)) + +(defn vtm-ingredients + "Returns ingredient (ISID) identifiers for the given VTM." + [conn vtmid] + (st4/vtm-ingredients conn vtmid)) + +(defn vtms-for-ingredient + "Returns VTM identifiers for the given ingredient." + [conn isid] + (st4/vtms-for-ingredient conn isid)) + +(defn plan-products + "Returns a reducible over all rows of the given product type (:VTM :VMP + :AMP :VMPP or :AMPP), for streaming iteration; each row is a `next.jdbc` + row abstraction with columns accessible by keyword." + [conn product-type] + (st4/plan-products conn product-type)) + (defn ^:deprecated vmps-from-atc "DEPRECATED: use [[vpids-from-atc]] instead." [conn atc] diff --git a/src/com/eldrix/dmd/store4.clj b/src/com/eldrix/dmd/store4.clj index 4399583..0deffe9 100644 --- a/src/com/eldrix/dmd/store4.clj +++ b/src/com/eldrix/dmd/store4.clj @@ -310,6 +310,20 @@ (def entity-by-type (reduce (fn [acc {:keys [id] :as entity}] (assoc acc id entity)) {} entities)) +(def lookup-types + "Set of lookup types, as keywords, each of which is the name of a lookup + table, e.g. #{:BASIS_OF_NAME :SUPPLIER ...}." + (into #{} (comp (filter #(and (vector? %) (= :LOOKUP (first %)))) (map second)) + (map :id entities))) + +(def product-tables + "Map of product type to its table and primary key column." + {:VTM {:table "VTM" :pk "VTMID"} + :VMP {:table "VMP" :pk "VPID"} + :AMP {:table "AMP" :pk "APID"} + :VMPP {:table "VMPP" :pk "VPPID"} + :AMPP {:table "AMPP" :pk "APPID"}}) + (s/fdef create-tables :args (s/cat :conn ::conn)) @@ -722,6 +736,59 @@ (let [nspace (-> (keys x) first namespace)] (assoc x :TYPE nspace)))) +(s/fdef fetch-history + :args (s/cat :conn ::conn :id ::product-id)) +(defn fetch-history + "Returns all history entries in which `id` is the current identifier, + ordered by start date. Includes 'self' entries (IDCURRENT=IDPREVIOUS) which + record the period of validity of the current identifier itself." + [conn id] + (jdbc/execute! conn ["select * from HISTORY where IDCURRENT=? order by STARTDT" id])) + +(s/fdef previous-ids + :args (s/cat :conn ::conn :id ::product-id)) +(defn previous-ids + "Returns the set of prior identifiers for the given current identifier, + excluding the identifier itself." + [conn id] + (into #{} (map :IDPREVIOUS) + (jdbc/plan conn ["select distinct IDPREVIOUS from HISTORY where IDCURRENT=? and IDPREVIOUS<>IDCURRENT" id]))) + +(s/fdef current-ids + :args (s/cat :conn ::conn :id ::product-id)) +(defn current-ids + "Returns the set of identifiers in current use for the given (usually + historic) identifier, excluding the identifier itself. Usually a single + identifier, but the data model permits more than one." + [conn id] + (into #{} (map :IDCURRENT) + (jdbc/plan conn ["select distinct IDCURRENT from HISTORY where IDPREVIOUS=? and IDPREVIOUS<>IDCURRENT" id]))) + +(s/fdef vtm-ingredients + :args (s/cat :conn ::conn :vtmid ::vtmid)) +(defn vtm-ingredients + "Returns ingredient (ISID) identifiers for the given VTM." + [conn vtmid] + (into [] (map :ISID) (jdbc/plan conn ["select ISID from VTM__INGREDIENT where VTMID=?" vtmid]))) + +(s/fdef vtms-for-ingredient + :args (s/cat :conn ::conn :isid ::isid)) +(defn vtms-for-ingredient + "Returns VTM identifiers for the given ingredient." + [conn isid] + (into [] (map :VTMID) (jdbc/plan conn ["select VTMID from VTM__INGREDIENT where ISID=?" isid]))) + +(s/fdef plan-products + :args (s/cat :conn ::conn :product-type (set (keys product-tables)))) +(defn plan-products + "Returns a reducible (clojure.lang.IReduceInit) over all rows of the given + product type (:VTM :VMP :AMP :VMPP or :AMPP), for streaming iteration + without realising all rows in memory. Each row is a `next.jdbc` row + abstraction; access columns by keyword, e.g. (map :NM)." + [conn product-type] + (let [{:keys [table]} (product-tables product-type)] + (jdbc/plan conn [(str "select * from " table)]))) + (defn ^:private atc->like [s] (-> s (str/replace "*" "%") (str/replace "?" "_"))) diff --git a/test/src/com/eldrix/dmd/store_test.clj b/test/src/com/eldrix/dmd/store_test.clj index f9cc9e2..14f55f8 100644 --- a/test/src/com/eldrix/dmd/store_test.clj +++ b/test/src/com/eldrix/dmd/store_test.clj @@ -40,6 +40,26 @@ (is (dmd/dmd-database? wrong-version)) (run! #(.delete ^File %) [not-sqlite not-dmd wrong-version]))) +(deftest history-and-queries + (let [st (create-and-open-store)] + (is (= #{354303007} (dmd/previous-ids st 34186711000001102))) + (is (= #{34186711000001102} (dmd/current-ids st 354303007))) + (is (= #{} (dmd/current-ids st 34186711000001102)) "self entries must be excluded") + (is (= #{} (dmd/previous-ids st 2070501000001104)) "supplier has only a self entry") + (let [history (dmd/fetch-history st 318135008)] + (is (= 2 (count history))) + (is (= ["10406411000001101" "318135008"] (map (comp str :HISTORY/IDPREVIOUS) history)) "ordered by start date") + (is (= "VMP" (:HISTORY/CLS (first history))))) + (is (= #{387516008 387475002} (set (dmd/vtm-ingredients st 34186711000001102)))) + (is (= [34186711000001102] (dmd/vtms-for-ingredient st 387475002))) + (is (= #{"Co-amilofruse 2.5mg/20mg tablets" "Co-amilofruse 5mg/40mg tablets"} + (into #{} (map :NM) (dmd/plan-products st :VMP)))) + (is (= 3 (count (into [] (map :APID) (dmd/plan-products st :AMP))))) + (is (contains? dmd/lookup-types :BASIS_OF_NAME)) + (is (= 26 (count dmd/lookup-types))) + (is (every? #(seq (dmd/fetch-lookup st %)) dmd/lookup-types) "every lookup type enumerable and populated") + (dmd/close st))) + (deftest store-status (let [st (create-and-open-store) {:keys [version created release trud files counts]} (dmd/status st)] From c27b7ad1a28ec73a635b73910ae2aacc89c98878 Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 19:04:01 +0100 Subject: [PATCH 6/8] Add full-text product name search (FTS5) An FTS5 index of VTM/VMP/AMP/VMPP/AMPP names is built after import. 'search' tokenizes the query, quoting each token (so FTS5 query syntax cannot be injected) and matching it as a prefix; multiple tokens combine as AND. Results are best-match first and can be filtered by product type. fetch-product-by-exact-name remains for exact matching. Co-Authored-By: Claude Fable 5 --- src/com/eldrix/dmd/core.clj | 10 ++++++ src/com/eldrix/dmd/store4.clj | 42 ++++++++++++++++++++++++++ test/src/com/eldrix/dmd/store_test.clj | 15 +++++++++ 3 files changed, 67 insertions(+) diff --git a/src/com/eldrix/dmd/core.clj b/src/com/eldrix/dmd/core.clj index 2d078c8..823c3e9 100644 --- a/src/com/eldrix/dmd/core.clj +++ b/src/com/eldrix/dmd/core.clj @@ -90,6 +90,16 @@ (defn fetch-product-by-exact-name [conn nm] (st4/fetch-product-by-exact-name conn nm)) +(defn search + "Search product names, returning a sequence of maps of :SEARCH/ID, + :SEARCH/TYPE and :SEARCH/NM, best matches first. Each token is matched as + a prefix; multiple tokens must all match. + Options: + - :types - product types to include e.g. #{:VMP :AMP}; default, all + - :limit - maximum number of results; default 100" + [conn s & {:keys [_types _limit] :as opts}] + (st4/search conn s opts)) + (defn fetch-lookup [conn lookup-kind] (st4/fetch-all-lookup conn lookup-kind)) diff --git a/src/com/eldrix/dmd/store4.clj b/src/com/eldrix/dmd/store4.clj index 0deffe9..82b5120 100644 --- a/src/com/eldrix/dmd/store4.clj +++ b/src/com/eldrix/dmd/store4.clj @@ -332,6 +332,14 @@ [conn] (run! #(jdbc/execute-one! conn [%]) (map :create entities))) +(defn create-search-index + "Creates and populates a full-text (FTS5) index of product names. This is + derived data, built after import rather than being an import target." + [conn] + (jdbc/execute-one! conn ["create virtual table SEARCH using fts5(ID unindexed, TYPE unindexed, NM)"]) + (doseq [[product-type {:keys [table pk]}] product-tables] + (jdbc/execute-one! conn [(str "insert into SEARCH (ID, TYPE, NM) select " pk ", '" (name product-type) "', NM from " table)]))) + (s/fdef create-indexes :args (s/cat :conn ::conn)) (defn create-indexes @@ -501,6 +509,7 @@ (loop [{:keys [stmts errors] :as batch} (async/ (keys x) first namespace)] (assoc x :TYPE nspace)))) +(defn ^:private fts5-query + "Turn a user-entered string into a safe FTS5 MATCH expression: each + whitespace-delimited token is quoted (preventing FTS5 query syntax + injection) and matched as a prefix; multiple tokens combine as AND." + [s] + (->> (str/split (or s "") #"\s+") + (remove str/blank?) + (map #(str "\"" (str/replace % "\"" "\"\"") "\"*")) + (str/join " "))) + +(s/def ::types (s/coll-of (set (keys product-tables)))) +(s/def ::limit pos-int?) +(s/fdef search + :args (s/cat :conn ::conn :s (s/nilable string?) + :opts (s/keys* :opt-un [::types ::limit]))) +(defn search + "Search product names, returning a sequence of maps of :SEARCH/ID, + :SEARCH/TYPE and :SEARCH/NM, best matches first. Each token of `s` is + matched as a prefix; multiple tokens must all match. + Options: + - :types - product types to include e.g. #{:VMP :AMP}; default, all + - :limit - maximum number of results; default 100" + [conn s & {:keys [types limit] :or {limit 100}}] + (let [q (fts5-query s)] + (if (str/blank? q) + [] + (if (seq types) + (jdbc/execute! conn (into [(str "select ID, TYPE, NM from SEARCH where NM match ? and TYPE in (" + (str/join "," (repeat (count types) "?")) + ") order by rank limit ?") q] + (concat (map name types) [limit]))) + (jdbc/execute! conn ["select ID, TYPE, NM from SEARCH where NM match ? order by rank limit ?" q limit]))))) + (s/fdef fetch-history :args (s/cat :conn ::conn :id ::product-id)) (defn fetch-history diff --git a/test/src/com/eldrix/dmd/store_test.clj b/test/src/com/eldrix/dmd/store_test.clj index 14f55f8..905c323 100644 --- a/test/src/com/eldrix/dmd/store_test.clj +++ b/test/src/com/eldrix/dmd/store_test.clj @@ -60,6 +60,21 @@ (is (every? #(seq (dmd/fetch-lookup st %)) dmd/lookup-types) "every lookup type enumerable and populated") (dmd/close st))) +(deftest search-products + (let [st (create-and-open-store)] + (is (= #{"VTM" "VMP" "AMP" "VMPP" "AMPP"} + (into #{} (map :SEARCH/TYPE) (dmd/search st "co-amilofruse")))) + (is (= #{318135008 318136009} + (into #{} (map :SEARCH/ID) (dmd/search st "co-amilof" :types #{:VMP}))) "prefix search") + (is (= #{318136009} + (into #{} (map :SEARCH/ID) (dmd/search st "amilofruse 40mg" :types #{:VMP}))) "multiple tokens combine as AND") + (is (= 1 (count (dmd/search st "co-amilofruse" :limit 1)))) + (is (= [] (dmd/search st ""))) + (is (= [] (dmd/search st " "))) + (is (= [] (dmd/search st nil))) + (is (= [] (dmd/search st "\" OR 1=1")) "FTS5 query syntax must not be interpreted") + (dmd/close st))) + (deftest store-status (let [st (create-and-open-store) {:keys [version created release trud files counts]} (dmd/status st)] From b8fbcd2b5160f599fa4f8577db296353c44c7bb0 Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 19:06:44 +0100 Subject: [PATCH 7/8] Record TRUD provenance on install; log status at startup; document v2 install-release now passes source TRUD release information through to the store so a database records where it came from. The server logs the full status at startup. Live tests assert that the historic code and VTM ingredient data are present (turning a silent change in the supplementary release layout into a test failure), that a real historic mapping resolves, and that search works. Co-Authored-By: Claude Fable 5 --- CHANGELOG.md | 22 ++++++++++++++++++++++ README.md | 18 ++++++++++++++++++ cmd/com/eldrix/dmd/cli.clj | 5 +++-- src/com/eldrix/dmd/core.clj | 8 ++++++-- test/src/com/eldrix/dmd/live_test.clj | 26 ++++++++++++++++++++++++++ 5 files changed, 75 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ee5ce74..c82c6cd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,27 @@ # CHANGELOG +# Unreleased (store schema v2) + +Databases must be rebuilt: v1 databases (and older legacy formats) are +rejected at open with a clear error. + +* Import the HISTORIC_CODES (deprecated code → live code map) and + VTM_INGREDIENTS files from the supplementary (bonus) distribution +* Store all fields defined by the dm+d schema that were previously dropped, + including invalidity flags on every product type, previous identifiers, + ingredient denominator strengths, licensing authority changes, flavour, + colour, and lookup code history (CDDT/CDPREV) +* New history APIs: `fetch-history`, `previous-ids`, `current-ids` map + deprecated identifiers to their current equivalents and vice versa +* New `status` API returning store version, creation time, release date, + TRUD provenance, source file inventory and entity counts +* Strict `open-store`: validates SQLite application_id (0x646D2B64 'dm+d') + and store version, with descriptive errors; read-only pooled DataSource +* New full-text product name search via `search` (FTS5; tokenized prefix + matching); new `plan-products` for streaming iteration over all products; + `lookup-types` enumerates all lookup tables +* Remove unused pathom3 graph API and unused dependencies + # v1.0.208 - 2025-01-23 * Use a SQLite DataSource rather than a Connection in case used by multiple threads concurrently diff --git a/README.md b/README.md index 44bd7ab..e72c629 100644 --- a/README.md +++ b/README.md @@ -545,6 +545,24 @@ com.eldrix/dmd {:git/url "https://github.com/wardle/dmd.git" :sha "XXX"} ``` +A dm+d database file is self-describing. `dmd-database?` identifies a file as +a dm+d database from its SQLite header (application_id 0x646D2B64, "dm+d") +without opening it; `open-store` validates both that marker and the store +schema version, returning a read-only pooled DataSource; and `status` returns +the store version, dm+d release date, source TRUD provenance and entity +counts. Each release should be built into a fresh database file; databases +created by older versions of this library are rejected at open and should be +rebuilt. + +```clojure +(require '[com.eldrix.dmd.core :as dmd]) +(def st (dmd/open-store "dmd-2025-01-16.db")) +(dmd/status st) ;; => {:version 2 :release #object[java.time.LocalDate "2025-01-16"] ...} +(dmd/search st "amlodip" :types #{:VMP}) ;; full-text product name search +(dmd/previous-ids st 86389004) ;; => #{9906511000001107} - deprecated ids for a live code +(dmd/current-ids st 9906511000001107) ;; => #{86389004} - live ids for a deprecated code +``` + # Frequently asked questions ### What is the use of `dmd`? diff --git a/cmd/com/eldrix/dmd/cli.clj b/cmd/com/eldrix/dmd/cli.clj index 695d145..85e40a1 100644 --- a/cmd/com/eldrix/dmd/cli.clj +++ b/cmd/com/eldrix/dmd/cli.clj @@ -63,9 +63,10 @@ (defn run-server [{:keys [db port] :or {port "8080"}}] (if db - (let [st (dmd/open-store db)] + (let [st (dmd/open-store db) + {:keys [version release counts]} (dmd/status st)] (log/info "starting server using " db " on port" port) - (log/info "UK dm+d release:" (.format java.time.format.DateTimeFormatter/ISO_DATE (dmd/fetch-release-date st))) + (log/info "UK dm+d release:" (str release) "(store version" (str version ")") counts) (try (serve/start-server st (Integer/parseInt port)) (catch NumberFormatException e (log/error "invalid port:" port)))) diff --git a/src/com/eldrix/dmd/core.clj b/src/com/eldrix/dmd/core.clj index 823c3e9..5891e6d 100644 --- a/src/com/eldrix/dmd/core.clj +++ b/src/com/eldrix/dmd/core.clj @@ -40,9 +40,13 @@ releases (dl/download-release api-key cache-dir release-date) _ (log/info "Downloaded dm+d releases " releases) unzipped (doall (map #(trud/unzip-nested (:archiveFilePath %)) releases)) - filename' (if filename filename (str "dmd-" (.format DateTimeFormatter/ISO_LOCAL_DATE (:releaseDate (first releases))) ".db"))] + filename' (if filename filename (str "dmd-" (.format DateTimeFormatter/ISO_LOCAL_DATE (:releaseDate (first releases))) ".db")) + trud-info (mapv (fn [release] + (-> (select-keys release [:itemIdentifier :id :name :releaseDate :archiveFileName]) + (update :releaseDate str))) + releases)] (log/info "Creating dm+d file-based database :" filename') - (install-from-dirs filename' (map #(.toFile ^java.nio.file.Path %) unzipped)) + (install-from-dirs filename' (map #(.toFile ^java.nio.file.Path %) unzipped) :trud trud-info) ;(zipfile/delete-paths unzipped) (log/info "Created dm+d file-based database :" filename')))) diff --git a/test/src/com/eldrix/dmd/live_test.clj b/test/src/com/eldrix/dmd/live_test.clj index f8b6ee2..64305af 100644 --- a/test/src/com/eldrix/dmd/live_test.clj +++ b/test/src/com/eldrix/dmd/live_test.clj @@ -31,6 +31,32 @@ (is (seq amlodipine-vmps)) (is (= amlodipine-vtm (:VMP/VTM (first amlodipine-vmps)))))) +(deftest ^:live status-and-history + (let [{:keys [version release counts]} (dmd/status *db*)] + (is (= 2 version)) + (is release) + ;; if either count is zero, the supplementary release layout has likely + ;; changed and the bonus files are being silently dropped + (is (pos? (:HISTORY counts))) + (is (pos? (:VTM_INGREDIENT counts))) + ;; a real, stable historic mapping: VTM 86389004 was previously + ;; identified as 9906511000001107 (per the NHSBSA HISTORIC_CODES data) + (is (contains? (dmd/previous-ids *db* 86389004) 9906511000001107)) + (is (contains? (dmd/current-ids *db* 9906511000001107) 86389004)))) + +(deftest ^:live trud-provenance + (let [{:keys [trud files]} (dmd/status *db*)] + (when trud ;; present only when latest-dmd.db was built by this test run via TRUD + (is (= 2 (count trud)) "expected provenance for main and supplementary releases") + (is (every? :releaseDate trud))) + (is (seq files)) + (is (contains? (set (map :type files)) :HISTORY)))) + +(deftest ^:live search + (let [results (dmd/search *db* "amlodipine" :types #{:VMP})] + (is (seq results)) + (is (every? #(= "VMP" (:SEARCH/TYPE %)) results)))) + (comment (dmd/install-release "../trud/api-key.txt" "cache" "latest-dmd.db") (System/getenv "TRUD_API_KEY_FILE") From ffce48fd5a57c41dc42cbb14cd9240ad3be036b8 Mon Sep 17 00:00:00 2001 From: Mark Wardle Date: Thu, 11 Jun 2026 19:30:45 +0100 Subject: [PATCH 8/8] Ignore TRUD api key, download cache and local archives Co-Authored-By: Claude Fable 5 --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index b0d6104..e47c171 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,7 @@ pom.xml.asc .cpcache/ /*.db .lsp/.cache/db.transit.json +api-key.txt +cache/ +*.zip +.eastwood