From: David Scott <dave.scott@eu.citrix.com>
Date: Wed, 26 Jan 2011 17:39:06 +0000 (+0000)
Subject: Rewrite the database upgrade update_snapshots to use the type-safe Db.* API rather... 
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=28aa1f40be96c2f1097de95ea4aedc1d4ec4cf61;p=xcp%2Fxen-api.git

Rewrite the database upgrade update_snapshots to use the type-safe Db.* API rather than the unsafe low-level database API. Move this xapi-specific stuff out of the database layer and put it further up the stack.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>
---

diff --git a/ocaml/database/db_upgrade.ml b/ocaml/database/db_upgrade.ml
index 20c25c33..26cd3395 100644
--- a/ocaml/database/db_upgrade.ml
+++ b/ocaml/database/db_upgrade.ml
@@ -58,39 +58,10 @@ let apply_upgrade_rules rules previous_version db =
 			db
     ) db required_rules
   
-
-
-let update_snapshots db = 
-	(* GEORGE -> MIDNIGHT RIDE *)
-	let ts = Database.tableset db in
-	let vm_table = TableSet.find Names.vm ts in
-	let vm_rows = Table.rows vm_table in
-	let update_snapshots vm_row vm_table : Table.t =
-		let vm = Row.find Names.ref vm_row in
-		let snapshot_rows = List.filter (fun s -> Row.find Names.snapshot_of s = vm) vm_rows in
-		let compare s1 s2 =
-			let t1 = Row.find Names.snapshot_time s1 in
-			let t2 = Row.find Names.snapshot_time s2 in
-			compare t1 t2 in
-		let ordered_snapshot_rows = List.sort compare snapshot_rows in
-		debug "Snapshots(%s) = {%s}" vm (String.concat ", " (List.map (fun s -> Row.find Names.ref s) ordered_snapshot_rows));
-		let rec aux snaps vm_table = match snaps with
-			| [] | [_] -> vm_table
-			| s1 :: s2 :: t ->
-				let row' = Row.add Names.parent (Row.find Names.ref s1) s2 in
-				let vm_table = Table.add (Row.find Names.ref s2) s2 vm_table in
-				aux (s2 :: t) vm_table in
-		aux (ordered_snapshot_rows @ [ vm_row]) vm_table in
-	let vm_table = Table.fold (fun _ vm_row tbl -> update_snapshots vm_row tbl) vm_table vm_table in
-	set_table Names.vm vm_table db
-
 (** A list of all the custom database upgrade rules known to the system. *)
 let upgrade_rules = 
   let george = Datamodel.george_release_schema_major_vsn, Datamodel.george_release_schema_minor_vsn in
-  [ { description = "Updating snapshot parent references";
-      version = george;
-      fn = update_snapshots } ]
-
+  [ ]
 (** {Generic database upgrade handling} *)
 
 (** Automatically insert blank tables and new columns with default values *)
diff --git a/ocaml/xapi/xapi_db_upgrade.ml b/ocaml/xapi/xapi_db_upgrade.ml
index 33b2298e..576146a8 100644
--- a/ocaml/xapi/xapi_db_upgrade.ml
+++ b/ocaml/xapi/xapi_db_upgrade.ml
@@ -169,12 +169,34 @@ let upgrade_bios_strings = {
 				update_vms Xapi_globs.generic_bios_strings
 }
 
+let update_snapshots = {
+	description = "Updating snapshot parent references";
+	version = (fun x -> x <= george);
+	fn = fun ~__context ->
+		let all_vms = Db.VM.get_all ~__context in
+		let update_snapshots self =
+			let snapshots = List.filter (fun snap -> Db.VM.get_snapshot_of ~__context ~self:snap = self) all_vms in
+			let compare s1 s2 =
+				let t1 = Db.VM.get_snapshot_time ~__context ~self:s1 in
+				let t2 = Db.VM.get_snapshot_time ~__context ~self:s2 in
+				compare t1 t2 in
+			let ordered_snapshots = List.sort compare snapshots in
+			debug "Snapshots(%s) = {%s}" (Ref.string_of self) (String.concat ", " (List.map Ref.string_of ordered_snapshots));
+			let rec aux snaps = match snaps with
+				| [] | [_] -> ()
+				| s1 :: s2 :: t ->
+					Db.VM.set_parent ~__context ~self:s2 ~value:s1;
+					aux (s2 :: t) in
+			aux (ordered_snapshots @ [ self]) in
+		List.iter update_snapshots all_vms
+}
 
 let rules = [
 	upgrade_vm_memory_overheads;
 	upgrade_wlb_configuration;
 	upgrade_vm_memory_for_dmc;
 	upgrade_bios_strings;
+	update_snapshots;
 ]
 
 (* Maybe upgrade most recent db *)