Matitaweb: several improvements to svn interface.

[helm.git] / matitaB / matita / matitaFilesystem.ml

diff --git a/matitaB/matita/matitaFilesystem.ml b/matitaB/matita/matitaFilesystem.ml
index 77e65822163657ffc7af9fce3bb662999f41148e..13c40664b0499d65b71598cb74b90b6282f126dc 100644 (file)
--- a/matitaB/matita/matitaFilesystem.ml
+++ b/matitaB/matita/matitaFilesystem.ml
@@ -103,6 +103,9 @@ let stat_classify line =
     | _ -> raise (SvnAnomaly line)
   in aux 0 []
 
+let count p l = 
+  List.length (List.filter p l)
+
 let stat_user user =
   let rt_dir = Helm_registry.get "matita.rt_base_dir" in
   let repo = Helm_registry.get "matita.weblib" in
@@ -122,10 +125,17 @@ let stat_user user =
 ;;
 
 (* update and checkout *)
-let up_classify line =
+let up_classify line uid =
+  let basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/users/" ^ uid ^ "/" in
   let rec aux n acc =
     match (line.[n], n) with
-    | _, n when n = 4 -> String.sub line 5 ((String.length line) - 5), acc
+    | _, n when n = 4 -> 
+       let fn = String.sub line 5 ((String.length line) - 5) in
+       let prefix_len = String.length basedir in
+       let fn_len = String.length fn in
+       if String.sub fn 0 prefix_len = basedir
+          then String.sub fn prefix_len (fn_len - prefix_len), acc
+          else fn, acc
     | ' ', _ -> aux (n+1) acc
     | 'A',_ when n = 0 || n = 1 -> aux (n+1) (Add::acc)
     | 'C',_ when n = 0 || n = 1 -> aux (n+1) (Conflict::acc)
@@ -136,18 +146,24 @@ let up_classify line =
     | _ -> raise (SvnAnomaly line)
   in aux 0 []
 
+let matita_flag_of_update fs =
+  if List.mem Conflict fs then Some MConflict
+  else if List.mem Delete fs then None
+  else if List.mem Merge fs then Some MModified
+  else Some MSynchronized
+
 (* this should be executed only for a freshly created user so no CS is needed *)
 let checkout user =
   let rt_dir = Helm_registry.get "matita.rt_base_dir" in
   let repo = Helm_registry.get "matita.weblib" in
 
   let errno, outlines, errlines = exec_process 
-    ("svn co " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/")
+    ("svn co --non-interactive " ^ repo ^ " " ^ rt_dir ^ "/users/" ^ user ^ "/")
   in
   let files, anomalies = 
     List.fold_left (fun (facc,eacc) line ->
       try
-        (up_classify line::facc), eacc
+        (up_classify line user::facc), eacc
       with
       | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
   in
@@ -254,16 +270,27 @@ let update_user user =
   let repo = Helm_registry.get "matita.weblib" in
 
   let errno, outlines, errlines = exec_process 
-    ("svn up " ^ rt_dir ^ "/users/" ^ user ^ "/")
+   ("svn up --non-interactive " ^ rt_dir ^ "/users/" ^ user ^ "/")
   in
   let files, anomalies = 
     List.fold_left (fun (facc,eacc) line ->
       try
-        (up_classify line::facc), eacc
+        (let fname,flags = up_classify line user in
+         (fname, flags)::facc), eacc
       with
       | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
   in
-  if errno = 0 then files, anomalies
+  let added = count (fun (_,flags) -> List.mem Add flags) files in
+  let conflict = count (fun (_,flags) -> List.mem Conflict flags) files in
+  let del = count (fun (_,flags) -> List.mem Delete flags) files in
+  let upd = count (fun (_,flags) -> List.mem Update flags) files in
+  let merged = count (fun (_,flags) -> List.mem Merge flags) files in
+
+  let files = 
+    List.map (fun (fname,flags) -> fname,matita_flag_of_update flags) files
+  in
+
+  if errno = 0 then files, anomalies, (added,conflict,del,upd,merged)
   else raise (SvnError (string_of_output outlines errlines))
 ;;
 
@@ -275,22 +302,23 @@ let commit user =
   let repo = Helm_registry.get "matita.weblib" in
 
   let errno, outlines, errlines = exec_process 
-    ("svn ci --message \"commit by user " ^ user ^ "\" " ^ rt_dir ^ "/users/" ^ user ^ "/")
+    ("svn ci --non-interactive --message \"commit by user " ^ user ^ "\" " ^ rt_dir ^ "/users/" ^ user ^ "/")
   in
-  if errno = 0 then ()
+  if errno = 0 then 
+    "BEGIN COMMIT - " ^ user ^ ":\n" ^ (string_of_output outlines errlines) ^ "END COMMIT - " ^ user ^ "\n\n"
   else raise (SvnError (string_of_output outlines errlines))
 ;;
 
 let do_global_commit () =
   prerr_endline ("to be committed: " ^ String.concat " " !to_be_committed);
   List.fold_left
-    (fun acc u ->
+    (fun (acc,out) u ->
        try
-         commit u;
-         acc
+         let newout = commit u in
+         acc, out ^ newout
        with
        | SvnError outstr -> 
-           prerr_endline outstr;
-           u::acc)
-  [] (List.rev !to_be_committed)
+           prerr_endline ("COMMIT OF " ^ user ^ "FAILED:" ^ outstr);
+           u::acc,out)
+  ([],"") (List.rev !to_be_committed)
 ;;