# # # patch "database.ml" # from [1b9ae88030a71571e23412a593ed034cbb5fa143] # to [d791f5492e2d4f5e367383639fb9ec2383a0ce74] # ============================================================ --- database.ml 1b9ae88030a71571e23412a593ed034cbb5fa143 +++ database.ml d791f5492e2d4f5e367383639fb9ec2383a0ce74 @@ -20,7 +20,7 @@ let setup_sqlite ?busy_handler db = if Viz_misc.debug "sql" then Sqlite3.trace_set db - (fun s -> prerr_string "### sql: " ; prerr_endline s) ; + (fun s -> Printf.eprintf "### %2.3f sql: %s\n%!" (Sys.time ()) s) ; Sqlite3.exec db "PRAGMA temp_store = MEMORY" ; may (Sqlite3.busy_set db) @@ -154,42 +154,58 @@ let ensure_node g id k = let n = { id = id ; kind = k ; family = [] } in n, { g with nodes = NodeMap.add id n g.nodes } -let process_regular_node g s = - let id = Sqlite3.column_text s 0 in - let _, g = ensure_node g id REGULAR in - g +let connect_nodes n1 n2 = + n1.family <- (n2.id, CHILD) :: n1.family ; + n2.family <- (n1.id, PARENT) :: n2.family -let add_edge g id1 k1 id2 k2 ek = +let add_edge g id1 id2 ek = + { g with ancestry = EdgeMap.add (id1, id2) ek g.ancestry } + +let add_nodes_with_edge g id1 k1 id2 k2 ek = let n1, g = ensure_node g id1 k1 in - n1.family <- (id2, CHILD) :: n1.family ; let n2, g = ensure_node g id2 k2 in - n2.family <- (id1, PARENT) :: n2.family ; - { g with ancestry = EdgeMap.add (id1, id2) ek g.ancestry } + connect_nodes n1 n2 ; + add_edge g id1 id2 ek +let process_regular_node g s = + let id = Sqlite3.column_text s 0 in + let _, g = ensure_node g id REGULAR in + g + let process_neighb_in g s = let id = Sqlite3.column_text s 0 in let child = Sqlite3.column_text s 1 in - add_edge g id NEIGHBOUR_IN child REGULAR BRANCHING_NEIGH + assert (NodeMap.mem child g.nodes) ; + add_nodes_with_edge g id NEIGHBOUR_IN child REGULAR BRANCHING_NEIGH let process_neighb_out db = let is_interesting = is_interesting_neighbour_out db in fun g s -> let parent = Sqlite3.column_text s 0 in let id = Sqlite3.column_text s 1 in + assert (NodeMap.mem parent g.nodes) ; if is_interesting parent id - then add_edge g parent REGULAR id NEIGHBOUR_OUT BRANCHING_NEIGH + then add_nodes_with_edge g parent REGULAR id NEIGHBOUR_OUT BRANCHING_NEIGH else g let process_ancestry g s = let parent = Sqlite3.column_text s 0 in let child = Sqlite3.column_text s 1 in - add_edge g parent REGULAR child REGULAR SAME_BRANCH + assert (NodeMap.mem parent g.nodes) ; + assert (NodeMap.mem child g.nodes) ; + assert (not (EdgeMap.mem (parent, child) g.ancestry)) ; + add_nodes_with_edge g parent REGULAR child REGULAR SAME_BRANCH let process_branching_edge g s = let parent = Sqlite3.column_text s 0 in let child = Sqlite3.column_text s 1 in - add_edge g parent REGULAR child REGULAR BRANCHING + let e = parent, child in + assert (EdgeMap.mem e g.ancestry) ; + if EdgeMap.find e g.ancestry = SAME_BRANCH + then add_edge g parent child BRANCHING + else g + let fetch_agraph_with_view db base64 (query, query_limit) = @@ -209,18 +225,22 @@ let fetch_agraph_with_view db base64 (qu (* neighbor IN *) let agraph = Sqlite3.fetch_f db - "SELECT parent, child \ - FROM %s, revision_ancestry \ - WHERE id = child AND parent != '' AND parent NOT IN %s" + "SELECT parent, child \ + FROM %s AS D1 \ + JOIN revision_ancestry ON D1.id = child \ +LEFT OUTER JOIN %s AS D2 ON D2.id = parent \ + WHERE D2.id ISNULL" view_name_limit view_name_domain process_neighb_in agraph in (* neighbor OUT *) let agraph = Sqlite3.fetch_f db - "SELECT parent, child \ - FROM %s, revision_ancestry \ - WHERE id = parent AND child NOT IN %s" + "SELECT parent, child \ + FROM %s AS D1 \ + JOIN revision_ancestry ON D1.id = parent \ +LEFT OUTER JOIN %s AS D2 ON D2.id = child \ + WHERE D2.id ISNULL" view_name_limit view_name_domain (process_neighb_out db) agraph in