Merge pull request #2018 from djs55/forupstream/database-schema

Database: document, re-add a test and use a value type rather than strings

Author: djs55

Makefile

@@ -60,8 +60,7 @@ test:
 	@echo
 	@echo @ HA binpack test
 	@./ocaml/xapi/binpack
-#	The following test no longer runs:
-#	./ocaml/database/database_test
+	./ocaml/database/database_test
 #	The following test no longer compiles:
 #	./ocaml/xenops/device_number_test
 #	The following test must be run in dom0:

ocaml/database/OMakefile

@@ -1,10 +1,11 @@
 
 OCAMLINCLUDES = ../idl/ocaml_backend ../xapi ../idl ../util ../autogen ..
-OCAMLPACKS    = xml-light2 stdext stunnel http-svr xcp sexpr rpclib uuid gzip xcp-inventory
+OCAMLPACKS    = xml-light2 stdext stunnel http-svr xcp sexpr rpclib uuid gzip xcp-inventory oUnit
 #OCAMLPPFLAGS  = -pp "camlp4o" 
 #OCAMLDEPFLAGS = -pp "camlp4o"
 
 UseCamlp4(rpclib.syntax, db_rpc_common_v2 db_cache_types db_filter_types)
+UseCamlp4(sexplib.syntax, schema)
 
 OCamlGeneratedFiles(db_filter_parse.ml db_filter_parse.mli db_filter_lex.ml)
 
@@ -19,8 +20,8 @@ BLOCK_DEVICE_IO_FILES = \
 OCamlProgram(block_device_io, $(BLOCK_DEVICE_IO_FILES))
 OCamlDocProgram(block_device_io, $(BLOCK_DEVICE_IO_FILES))
 
-DATABASE_SERVER_FILES = database_server_main test_schemas database_test ../autogen/db_actions 
-DATABASE_TEST_FILES = database_test database_test_main test_schemas
+DATABASE_SERVER_FILES = database_server_main test_schemas ../autogen/db_actions 
+DATABASE_TEST_FILES = db_cache_test test_schemas
 section:
 	#XXX there are lots of interdependencies which we should be aim to remove
 	OCAML_LIBS += ../util/version ../idl/ocaml_backend/common ../idl/ocaml_backend/client ../util/stats ../idl/ocaml_backend/server

ocaml/database/database_test.ml

@@ -175,61 +175,61 @@ module Tests = functor(Client: Db_interface.DB_ACCESS) -> struct
 		let dump db g = 
 			let tables = Db_cache_types.Database.tableset db in
 			Db_cache_types.TableSet.fold_over_recent g 
-				(fun c u d name table acc ->
+				(fun name _ table acc ->
 					 Db_cache_types.Table.fold_over_recent g 
-						 (fun c u d r acc -> 
+                                                 (fun r { Db_cache_types.Stat.created; modified; deleted } _ acc -> 
 							  let s = 
 								  try 
 									  let row = Db_cache_types.Table.find r table in
 									  let s = Db_cache_types.Row.fold_over_recent g 
-										  (fun c u d k v acc ->
+										  (fun k _ v acc ->
 											   Printf.sprintf "%s %s=%s" acc k v) row "" in
 									  s 
 								  with _ -> "(deleted)"
 							  in
-							  Printf.printf "%s(%s): (%Ld %Ld %Ld) %s\n" name r c u d s;
-							  ())
-						 (fun () -> ()) table ()) tables ()
+							  Printf.printf "%s(%s): (%Ld %Ld %Ld) %s\n" name r created modified deleted s;
+							  ()
+						 ) table ())  tables ()
 		in
 
 		let get_created db g =
 			let tables = Db_cache_types.Database.tableset db in
 			Db_cache_types.TableSet.fold_over_recent g
-				(fun c u d name table acc ->
+				(fun name _ table acc ->
 					 Db_cache_types.Table.fold_over_recent g
-						 (fun c u d r acc ->
-							  if c>=g then (name,r)::acc else acc) ignore table acc
+                                                 (fun r { Db_cache_types.Stat.created } _ acc ->
+							  if created>=g then (name,r)::acc else acc) table acc
 				) tables []
 		in
 
 		let get_updated db g =
 			let tables = Db_cache_types.Database.tableset db in
 			Db_cache_types.TableSet.fold_over_recent g
-				(fun c u d name table acc ->
+				(fun name _ table acc ->
 					 Db_cache_types.Table.fold_over_recent g
-						 (fun c u d r acc ->
+						 (fun r _ _ acc ->
 							  let row = Db_cache_types.Table.find r table in
 							  Db_cache_types.Row.fold_over_recent g 
-								  (fun c u d k v acc ->
+								  (fun k _ v acc ->
 									   (r,(k,v))::acc) row acc)
-						 ignore table acc) tables []
+						 table acc) tables []
 		in
 
 		let get_deleted db g =
 			let tables = Db_cache_types.Database.tableset db in
 			Db_cache_types.TableSet.fold_over_recent g
-				(fun c u d name table acc ->
-					 Db_cache_types.Table.fold_over_recent g
-						 (fun c u d r acc ->
-							  if d > g then r::acc else acc)
-						 ignore table acc) tables []
+				(fun name _ table acc ->
+					 Db_cache_types.Table.fold_over_deleted g
+                                                 (fun r { Db_cache_types.Stat.deleted } acc ->
+							  if deleted > g then r::acc else acc)
+						 table acc) tables []
 		in
 
 		let get_max db =
 			let tables = Db_cache_types.Database.tableset db in
 			Db_cache_types.TableSet.fold_over_recent (-1L)
-				(fun c u d _ _ largest ->
-					 max c (max u (max d largest))) tables (-1L)
+                        (fun _ { Db_cache_types.Stat.created; modified; deleted } _ largest ->
+					 max created (max modified (max deleted largest))) tables (-1L)
 		in
 
 		let db = Db_ref.get_database t in

ocaml/database/db_action_helper.ml

@@ -22,15 +22,11 @@ let events_notify ?(snapshot) ty op ref =
   match !__callback with
     | None -> ()
     | Some f -> f ?snapshot ty op ref
-	  
+	 (* 
 exception Db_set_or_map_parse_fail of string
   
 let parse_sexpr s : SExpr.t list =
   match SExpr_TS.of_string s with
     | SExpr.Node xs -> xs
     | _ -> raise (Db_set_or_map_parse_fail s)
-	
-let add_key_to_set key set =
-  if List.mem (SExpr.String key) set 
-  then set
-  else SExpr.String key :: set
+*)

ocaml/database/db_backend.ml

@@ -42,27 +42,28 @@ 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 created updated v (acc,max_upd) ->
+                        (fun name { Stat.created; modified } v (acc,max_upd) ->
 				try
 					let col = Schema.Table.find name schema in
-					let v',updated' = if col.Schema.Column.persistent then v,updated else col.Schema.Column.empty,g in
-					(Row.update updated' name "" (fun _ -> v') (Row.add created name v' acc),max max_upd updated')
+                                        let empty = col.Schema.Column.empty in
+					let v',modified' = if col.Schema.Column.persistent then v,modified else empty,g in
+					(Row.update modified' name empty (fun _ -> v') (Row.add created name v' acc),max max_upd modified')
 				with Not_found ->
 					Printf.printf "Skipping unknown column: %s\n%!" name;
-					(acc,max max_upd updated)) row (Row.empty,0L) in
+					(acc,max max_upd modified)) row (Row.empty,0L) in
 	(* Generate a new table *)
 	let table tblname tbl : Table.t =
 		let schema = Schema.Database.find tblname schema.Schema.database in
 		Table.fold
-			(fun objref created updated r acc ->
+                        (fun objref { Stat.created; modified } r acc ->
 				let (r,updated) = row schema r in
-				Table.update updated objref Row.empty (fun _ -> r) (Table.add created objref r acc)) tbl Table.empty in
+				Table.update modified objref Row.empty (fun _ -> r) (Table.add created objref r acc)) tbl Table.empty in
 	Database.update
 		(fun ts -> 
 			TableSet.fold 
-				(fun tblname created updated tbl acc ->
+                                (fun tblname { Stat.created; modified } tbl acc ->
 					let tbl' = table tblname tbl in
-					TableSet.add updated tblname tbl' acc) ts TableSet.empty)
+					TableSet.add modified tblname tbl' acc) ts TableSet.empty)
 		db
 
 let db_registration_mutex = Mutex.create ()