+let string_of_output outlines errlines =
+ let output = "std out =\n" ^ String.concat "\n" (List.rev outlines) in
+ let errors = "std err =\n" ^ String.concat "\n" (List.rev errlines) in
+ output ^ "\n\n" ^ errors
+
+type svn_flag =
+| Add
+| Conflict
+| Modified
+| NotAdded
+| Delete
+| Update
+| Merge
+
+type matita_flag =
+| MUnversioned
+| MSynchronized
+| MAdd
+| MModified
+| MConflict
+
+let string_of_matita_flag = function
+| MUnversioned -> "unversioned"
+| MSynchronized -> "synchronized"
+| MAdd -> "new"
+| MModified -> "modified"
+| MConflict -> "conflict!"
+
+exception SvnAnomaly of string
+
+let stat_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 = 7 ->
+ let fn = String.sub line 8 ((String.length line) - 8) 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',0 -> aux (n+1) (Add::acc)
+ | 'C',_ when n = 0 || n = 1 -> aux (n+1) (Conflict::acc)
+(* | 'D',0 -> aux (n+1) (Delete::acc) *)
+(* | 'I',0 -> aux (n+1) (Ignore::acc) *)
+ | 'M',_ when n = 0 || n = 1 -> aux (n+1) (Modified::acc)
+(* | 'R',0 -> aux (n+1) (Replaced::acc) *)
+(* | 'X',0 -> aux (n+1) (UnversionedDir::acc) *)
+ | '?',0 -> aux (n+1) (NotAdded::acc)
+(* | '!',0 -> aux (n+1) (Missing::acc) *)
+(* | '~',0 -> aux (n+1) (Obstructed::acc) *)
+(* | 'L',2 -> aux (n+1) (Lock::acc) *)
+(* | '+',3 -> aux (n+1) (History::acc) *)
+(* | 'S',4 -> aux (n+1) (SwitchedUrl::acc) *)
+(* | 'X',4 -> aux (n+1) (External::acc) *)
+(* | 'K',5 -> aux (n+1) (LockToken::acc) *)
+(* | 'C',6 -> aux (n+1) (TreeConflict::acc) *)
+ | _ -> raise (SvnAnomaly line)
+ in aux 0 []
+
+let count p l =
+ List.length (List.filter p l)
+
+exception Unimplemented
+
+let matita_flag_of_stat fs =
+ if List.mem Conflict fs then MConflict
+ else if List.mem Modified fs then MModified
+ else if List.mem Add fs then MAdd
+ else if List.mem Delete fs then raise Unimplemented
+ else if List.mem NotAdded fs then MUnversioned
+ else MSynchronized
+
+let stat_user 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 stat " ^ rt_dir ^ "/users/" ^ user ^ "/")
+ in
+ let files, anomalies =
+ List.fold_left (fun (facc,eacc) line ->
+ try
+ (stat_classify line user::facc), eacc
+ with
+ | SvnAnomaly l -> facc, l::eacc) ([],[]) outlines
+ in
+ let files =
+ List.map (fun (fname,flags) -> fname,Some (matita_flag_of_stat flags)) files
+ in
+
+ if errno = 0 then files, anomalies
+ else raise (SvnError ("Anomalies: " ^ (String.concat "\n" anomalies) ^ "\n\n" ^ (string_of_output outlines errlines)))
+;;
+
+(* update and checkout *)
+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 ->
+ 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)
+ | 'D',_ when n = 0 || n = 1 -> aux (n+1) (Delete::acc)
+ | 'U',_ when n = 0 || n = 1 -> aux (n+1) (Update::acc)
+ | 'G',_ when n = 0 || n = 1 -> aux (n+1) (Merge::acc)
+(* | 'E',_ when n = 0 || n = 1 -> aux (n+1) (Exist::acc) *)
+ | _ -> 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 *)