diff --git a/ocaml/database/database_test.ml b/ocaml/database/database_test.ml index 51e28dbf387..eaffc870b56 100644 --- a/ocaml/database/database_test.ml +++ b/ocaml/database/database_test.ml @@ -285,9 +285,8 @@ functor let row = Db_cache_types.Table.find r table in let s = Db_cache_types.Row.fold_over_recent g - (fun k _ v acc -> - Printf.sprintf "%s %s=%s" acc k - (Schema.Value.marshal v) + (fun k _ (_, cached) acc -> + Printf.sprintf "%s %s=%s" acc k cached ) row "" in diff --git a/ocaml/database/db_backend.ml b/ocaml/database/db_backend.ml index c5270f68169..697af70652e 100644 --- a/ocaml/database/db_backend.ml +++ b/ocaml/database/db_backend.ml @@ -38,7 +38,7 @@ let blow_away_non_persistent_fields (schema : Schema.t) db = (* Generate a new row given a table schema *) let row schema row : Row.t * int64 = Row.fold - (fun name {Stat.created; modified; _} v (acc, max_upd) -> + (fun name {Stat.created; modified; _} (v, _) (acc, max_upd) -> try let col = Schema.Table.find name schema in let empty = col.Schema.Column.empty in diff --git a/ocaml/database/db_cache_impl.ml b/ocaml/database/db_cache_impl.ml index b4f23b0af00..7fd12b75547 100644 --- a/ocaml/database/db_cache_impl.ml +++ b/ocaml/database/db_cache_impl.ml @@ -116,11 +116,10 @@ let read_record_internal db tblname objref = else None in - let map_fvlist v = Schema.Value.marshal v in (* Unfortunately the interface distinguishes between Set(Ref _) types and ordinary fields *) Row.fold - (fun k _ d (accum_fvlist, accum_setref) -> + (fun k _ (d, cached) (accum_fvlist, accum_setref) -> let accum_setref = match map_setref_opt k d with | Some v -> @@ -128,7 +127,7 @@ let read_record_internal db tblname objref = | None -> accum_setref in - let accum_fvlist = (k, map_fvlist d) :: accum_fvlist in + let accum_fvlist = (k, cached) :: accum_fvlist in (accum_fvlist, accum_setref) ) row ([], []) @@ -146,7 +145,7 @@ let delete_row_locked t tblname objref = Database.notify (PreDelete (tblname, objref)) db ; update_database t (remove_row tblname objref) ; Database.notify - (Delete (tblname, objref, Row.fold (fun k _ v acc -> (k, v) :: acc) row []) + (Delete (tblname, objref, Row.fold (fun k _ (v, _) acc -> (k, v) :: acc) row []) ) (get_database t) with Not_found -> raise (DBCache_NotFound ("missing row", tblname, objref)) @@ -182,7 +181,7 @@ let create_row_locked t tblname kvs' new_objref = update_database t (add_row tblname new_objref row) ; Database.notify (Create - (tblname, new_objref, Row.fold (fun k _ v acc -> (k, v) :: acc) row []) + (tblname, new_objref, Row.fold (fun k _ (v, _) acc -> (k, v) :: acc) row []) ) (get_database t) diff --git a/ocaml/database/db_cache_types.ml b/ocaml/database/db_cache_types.ml index 6fc784faf9b..a1d85c1a82e 100644 --- a/ocaml/database/db_cache_types.ml +++ b/ocaml/database/db_cache_types.ml @@ -136,10 +136,17 @@ functor end module Row = struct - include Make (Schema.Value) + module CachedValue = struct + type t = Schema.Value.t * string + + let v v = (v, Schema.Value.marshal v) + end + + include Make (CachedValue) let add gen key v = add gen key + @@ CachedValue.v @@ match v with | Schema.Value.String x -> @@ -153,8 +160,17 @@ module Row = struct type value = Schema.Value.t + let iter f t = iter (fun k (v, _) -> f k v) t + + let touch generation key default row = + touch generation key (CachedValue.v default) row + + let update gen key default f row = + let f (v, _) = f v |> CachedValue.v in + update gen key (CachedValue.v default) f row + let find key t = - try find key t + try find key t |> fst with Not_found -> raise (DBCache_NotFound ("missing field", key, "")) let add_defaults g (schema : Schema.Table.t) t = @@ -175,7 +191,8 @@ module Row = struct else t ) - t (Schema.ColumnMap.to_list schema.Schema.Table.columns) + t + (Schema.ColumnMap.to_list schema.Schema.Table.columns) end module Table = struct diff --git a/ocaml/database/db_cache_types.mli b/ocaml/database/db_cache_types.mli index 2ffe79c411b..a07fe8b2983 100644 --- a/ocaml/database/db_cache_types.mli +++ b/ocaml/database/db_cache_types.mli @@ -81,6 +81,12 @@ end module Row : sig include MAP with type value = Schema.Value.t + + val fold : (string -> Stat.t -> (value * string) -> 'b -> 'b) -> t -> 'b -> 'b + (** [fold f t initial] folds [f key stats value acc] over the items in [t] *) + + val fold_over_recent : + Time.t -> (string -> Stat.t -> (value * string) -> 'b -> 'b) -> t -> 'b -> 'b val add_defaults : Time.t -> Schema.Table.t -> t -> t (** [add_defaults now schema t]: returns a row which is [t] extended to contain diff --git a/ocaml/database/db_xml.ml b/ocaml/database/db_xml.ml index d7c73db3d84..3bc5da3d4b9 100644 --- a/ocaml/database/db_xml.ml +++ b/ocaml/database/db_xml.ml @@ -67,7 +67,7 @@ module To = struct make_tag "row" (List.rev (Row.fold - (fun k _ v acc -> + (fun k _ (v, _) acc -> (k, Xml_spaces.protect (Schema.Value.marshal v)) :: acc ) row preamble