[unison-svn] r521 - trunk/src

[email protected]
Newsgroups gmane.network.unison.devel
Message-ID <[email protected]>
Author: schmitta
Date: 2013-03-11 04:41:44 -0400 (Mon, 11 Mar 2013)
New Revision: 521

Modified:
   trunk/src/common.ml
   trunk/src/common.mli
   trunk/src/recon.ml
   trunk/src/transport.ml
   trunk/src/uicommon.ml
   trunk/src/uitext.ml
Log:
Added a string to the Conflict direction to document the reason of the conflict.
The text UI has been adapted to this change, the other UIs need to be modified.

Modified: trunk/src/common.ml
===================================================================
--- trunk/src/common.ml	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/common.ml	2013-03-11 08:41:44 UTC (rev 521)
@@ -118,17 +118,21 @@
     props : Props.t list }         (* Parent properties *)
 
 type direction =
-    Conflict
+    Conflict of string (* The string is the reason of the conflict *)
   | Merge
   | Replica1ToReplica2
   | Replica2ToReplica1
 
 let direction2string = function
-    Conflict -> "conflict"
+    Conflict _ -> "conflict"
   | Merge -> "merge"
   | Replica1ToReplica2 -> "replica1 to replica2"
   | Replica2ToReplica1 -> "replica2 to replica1"
 
+let isConflict = function
+    Conflict _ -> true
+  | _ -> false
+
 type difference =
   { rc1 : replicaContent;
     rc2 : replicaContent;
@@ -176,7 +180,7 @@
       begin match dir with
         Replica1ToReplica2 -> rcLength rc1 rc2
       | Replica2ToReplica1 -> rcLength rc2 rc1
-      | Conflict           -> Uutil.Filesize.zero
+      | Conflict _         -> Uutil.Filesize.zero
       | Merge              -> Uutil.Filesize.zero (* underestimate :-*)
       end
   | _ ->
@@ -205,14 +209,14 @@
 let problematic ri =
   match ri.replicas with
     Problem _      -> true
-  | Different diff -> diff.direction = Conflict
+  | Different diff -> isConflict diff.direction
 
 let partiallyProblematic ri =
   match ri.replicas with
     Problem _      ->
       true
-  | Different diff ->
-      diff.direction = Conflict || diff.errors1 <> [] || diff.errors2 <> []
+  | Different diff -> 
+     isConflict diff.direction || diff.errors1 <> [] || diff.errors2 <> []
 
 let isDeletion ri =
   match ri.replicas with

Modified: trunk/src/common.mli
===================================================================
--- trunk/src/common.mli	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/common.mli	2013-03-11 08:41:44 UTC (rev 521)
@@ -96,13 +96,15 @@
     props : Props.t list }         (* Parent properties *)
 
 type direction =
-    Conflict
+    Conflict of string (* The string is the reason of the conflict *)
   | Merge
   | Replica1ToReplica2
   | Replica2ToReplica1
 
 val direction2string : direction -> string
 
+val isConflict : direction -> bool
+
 type difference =
   { rc1 : replicaContent;           (* - content of first replica *)
     rc2 : replicaContent;           (* - content of second replica *)

Modified: trunk/src/recon.ml
===================================================================
--- trunk/src/recon.ml	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/recon.ml	2013-03-11 08:41:44 UTC (rev 521)
@@ -27,7 +27,7 @@
   match ri.replicas with
     Different
       ({rc1 = rc1; rc2 = rc2; direction = d; default_direction = default } as diff)
-          when force=`Force || default=Conflict ->
+          when force=`Force || isConflict default ->
       if dir=`Replica1ToReplica2 then
         diff.direction <- Replica1ToReplica2
       else if dir=`Replica2ToReplica1 then
@@ -37,10 +37,10 @@
       end else begin  (* dir = `Older or dir = `Newer *)
         match rc1.status, rc2.status with
           `Deleted, _ ->
-            if default=Conflict then
+            if isConflict default then
               diff.direction <- Replica2ToReplica1
         | _, `Deleted ->
-            if default=Conflict then
+            if isConflict default then
               diff.direction <- Replica1ToReplica2
         | _ ->
             let comp = Props.time rc1.desc -. Props.time rc2.desc in
@@ -253,25 +253,33 @@
                       (Int64.of_int (Prefs.read maxSizeThreshold)))
   in
   match actionKind rc1 rc2 with
-    `UPDATE   -> test `UPDATE || testSize rc1
-  | `DELETION -> test `UPDATE || test `DELETION
-  | `CREATION -> test `CREATION  || testSize rc1
+    `UPDATE   -> 
+     if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
+     else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
+  | `DELETION -> 
+     if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
+     else test `DELETION, "would delete a file with nodeletion or nodeletionpartial set"
+  | `CREATION ->
+     if test `CREATION then true, "would create a file with nocreation or nocreationpartial set"
+     else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
 
 let filterRi root1 root2 ri =
   match ri.replicas with
     Problem _ ->
       ()
   | Different diff ->
-      if
-        match diff.direction with
-          Replica1ToReplica2 ->
-            shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
-        | Replica2ToReplica1 ->
-            shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
-        | Conflict | Merge ->
-            false
-      then
-        diff.direction <- Conflict
+     let cancel,reason = 
+       match diff.direction with
+         Replica1ToReplica2 ->
+          shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
+       | Replica2ToReplica1 ->
+          shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
+       | Conflict _ | Merge ->
+          false,""
+     in 
+     if cancel 
+     then
+       diff.direction <- Conflict reason
 
 let filterRis ris =
   let (root1, root2) = Globals.rawRootPair () in
@@ -534,7 +542,7 @@
 (* --                                                                        *)
 let rec reconcile
           allowPartial path ui1 props1 ui2 props2 counter equals unequals =
-  let different uc1 uc2 oldType equals unequals =
+  let different uc1 uc2 reason oldType equals unequals =
     (equals,
      Tree.add unequals
        (propagateErrors allowPartial
@@ -542,7 +550,8 @@
                               path true ui1 props1 uc1 oldType;
                       rc2 = update2replicaContent
                               path true ui2 props2 uc2 oldType;
-                      direction = Conflict; default_direction = Conflict;
+                      direction = Conflict reason;
+                      default_direction = Conflict reason;
                       errors1 = []; errors2 = []}))) in
   let toBeMerged uc1 uc2 oldType equals unequals =
     (equals,
@@ -583,7 +592,7 @@
            let action =
              if propsChanged1 = PropsSame then Replica2ToReplica1
              else if propsChanged2 = PropsSame then Replica1ToReplica2
-             else Conflict in
+             else Conflict "properties changed on both sides" in
            (equals,
             Tree.add unequals
               (Different
@@ -618,23 +627,27 @@
 (* expect this.)                                                             *)
              let uc1' = File(desc1,ContentsSame) in
              let uc2' = File(desc2,ContentsSame) in
-             different uc1' uc2' (oldType prev) equals unequals
+             different uc1' uc2' "properties changed on both sides" 
+                       (oldType prev) equals unequals
        | ContentsSame, ContentsSame when Props.similar desc1 desc2 ->
            (add_equal counter equals (uc1, uc2), unequals)
        | ContentsUpdated _, ContentsUpdated _
              when Globals.shouldMerge path ->
            toBeMerged uc1 uc2 (oldType prev) equals unequals
        | _ ->
-           different uc1 uc2 (oldType prev) equals unequals
+           different uc1 uc2 "contents changed on both sides"
+                     (oldType prev) equals unequals
        end
   | (Updates (Symlink(l1) as uc1, prev),
      Updates (Symlink(l2) as uc2, _)) ->
        if l1 = l2 then
          (add_equal counter equals (uc1, uc2), unequals)
        else
-         different uc1 uc2 (oldType prev) equals unequals
+         different uc1 uc2 "symbolic links changed on both sides"
+                   (oldType prev) equals unequals
   | (Updates (uc1, prev), Updates (uc2, _)) ->
-      different uc1 uc2 (oldType prev) equals unequals
+      different uc1 uc2 "conflicting updates"
+                (oldType prev) equals unequals
 
 (* Sorts the paths so that they will be displayed in order                   *)
 let sortPaths pathUpdatesList =

Modified: trunk/src/transport.ml
===================================================================
--- trunk/src/transport.ml	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/transport.ml	2013-03-11 08:41:44 UTC (rev 521)
@@ -151,9 +151,9 @@
         {rc1 = rc1; rc2 = rc2; direction = dir; default_direction = def} ->
       let notDefault = dir <> def in
       match dir with
-        Conflict ->
-          Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n"
-                       (Path.toString path));
+        Conflict c ->
+          Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n  %s\n"
+                       (Path.toString path) c);
           return ()
       | Replica1ToReplica2 ->
           doAction

Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/uicommon.ml	2013-03-11 08:41:44 UTC (rev 521)
@@ -267,7 +267,7 @@
 
 let direction2action partial dir =
   match dir with
-    Conflict           -> ASkip partial
+    Conflict _         -> ASkip partial
   | Replica1ToReplica2 -> ALtoR partial
   | Replica2ToReplica1 -> ARtoL partial
   | Merge              -> AMerge

Modified: trunk/src/uitext.ml
===================================================================
--- trunk/src/uitext.ml	2013-03-11 08:41:38 UTC (rev 520)
+++ trunk/src/uitext.ml	2013-03-11 08:41:44 UTC (rev 521)
@@ -218,7 +218,7 @@
   match ri.replicas with
     Problem _ ->
       alwaysDisplay s
-  | Different {direction = d} when d=Conflict ->
+  | Different {direction = d} when isConflict d ->
       alwaysDisplay s
   | _ ->
       display s
@@ -254,7 +254,7 @@
         match ri.replicas with
           Problem s -> display "\n"; display s; display "\n"; next()
         | Different ({rc1 = rc1; rc2 = rc2; direction = dir} as diff) ->
-            if Prefs.read Uicommon.auto && dir<>Conflict then begin
+            if Prefs.read Uicommon.auto && not (isConflict dir) then begin
               display "\n"; next()
             end else
               let (descr, descl) =
@@ -271,14 +271,14 @@
               end;
               selectAction
                 (if Prefs.read Globals.batch then Some " " else None)
-                [((if dir=Conflict && not (Prefs.read Globals.batch)
+                [((if (isConflict dir) && not (Prefs.read Globals.batch)
                      then ["f"]  (* Offer no default behavior if we've got
                                     a conflict and we're in interactive mode *)
                      else ["";"f";" "]),
                   ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"),
                   fun ()->
                     newLine ();
-                    if dir = Conflict && not (Prefs.read Globals.batch)
+                    if (isConflict dir) && not (Prefs.read Globals.batch)
                     then begin
                       display "No default action [type '?' for help]\n";
                       repeat()
@@ -360,7 +360,7 @@
                  (["/"],
                   ("skip"),
                   (fun () ->
-                    diff.direction <- Conflict;
+                    if not (isConflict dir) then diff.direction <- Conflict "skip requested";
                     redisplayri();
                     next()));
                  ([">";"."],
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.