added margin option to the pp

[helm.git] / helm / software / components / library / librarian.ml

diff --git a/helm/software/components/library/librarian.ml b/helm/software/components/library/librarian.ml
index 9b08f46145c6879a745aa9de619d6a1e84cdd4da..62a8a892c3887f5b965266e49077846456ffa227 100644 (file)
--- a/helm/software/components/library/librarian.ml
+++ b/helm/software/components/library/librarian.ml
@@ -191,7 +191,9 @@ module type Format =
     val string_of_target_object: target_object -> string
     val build: options -> source_object -> bool
     val root_and_target_of: 
-          options -> source_object -> string option * target_object
+          options -> source_object -> 
+          (* root, writeable target, read only target *)
+          string option * target_object * target_object
     val mtime_of_source_object: source_object -> float option
     val mtime_of_target_object: target_object -> float option
     val is_readonly_buri_of: options -> source_object -> bool
@@ -209,8 +211,10 @@ module Make = functor (F:Format) -> struct
   let fst4 = function (x,_,_,_) -> x;;
 
   let modified_before_s_t (_,cs, ct, _, _) a b = 
-    prerr_endline ("L s_t: a " ^ F.string_of_source_object a);
-    prerr_endline ("L s_t: b " ^ F.string_of_target_object b);  
+(*   
+    time_stamp ("L s_t: a " ^ F.string_of_source_object a);
+    time_stamp ("L s_t: b " ^ F.string_of_target_object b);
+*)    
     let a = try Hashtbl.find cs a with Not_found -> assert false in
     let b = 
       try
@@ -228,13 +232,17 @@ module Make = functor (F:Format) -> struct
        | Some a, Some b -> a <= b
        | _ -> false
     in
-    prerr_endline ("L s_t: " ^ string_of_bool r); r
+(*
+    time_stamp ("L s_t: " ^ string_of_bool r);
+*)
+    r
 
-  let modified_before_t_t (_,_,ct, _, _) a b = 
-(*    
-    prerr_endline ("L t_t: a " ^ F.string_of_target_object a);
-    prerr_endline ("L t_t: b " ^ F.string_of_target_object b);
-*)    let a = 
+  let modified_before_t_t (_,_,ct, _, _) a b =
+(*
+    time_stamp ("L t_t: a " ^ F.string_of_target_object a);
+    time_stamp ("L t_t: b " ^ F.string_of_target_object b);
+*)    
+    let a = 
       try
         match Hashtbl.find ct a with
         | Some _ as x -> x
@@ -259,15 +267,18 @@ module Make = functor (F:Format) -> struct
       with Not_found -> assert false
     in
     let r = match a, b with
-    | Some a, Some b ->
-(*       
-       prerr_endline ("tt: a " ^ string_of_float a);
-       prerr_endline ("tt: b " ^ string_of_float b);
-*)       
-       a <= b
-    | _ -> false
+       | Some a, Some b ->
+(*
+       time_stamp ("tt: a " ^ string_of_float a);
+       time_stamp ("tt: b " ^ string_of_float b);
+*)
+          a <= b
+       | _ -> false
     in
-    prerr_endline ("L t_t: " ^ string_of_bool r); r
+(*
+    time_stamp ("L t_t: " ^ string_of_bool r);
+*)
+    r
 
   let rec purge_unwanted_roots wanted deps =
     let roots, rest = 
@@ -391,10 +402,10 @@ module Make = functor (F:Format) -> struct
        let r = make_one root opts okd whatd in 
        r, okt && modified_before_t_t opts tgtd tgt
     in
-    prerr_endline ("L : processing " ^ str);
+    time_stamp ("L : processing " ^ str);
     try 
        let r = Hashtbl.find cc t in
-       prerr_endline ("L : " ^ string_of_bool r ^ " " ^ str);
+       time_stamp ("L : " ^ string_of_bool r ^ " " ^ str);
        ok && r
 (* say "already built" *)
     with Not_found ->
@@ -411,14 +422,16 @@ module Make = functor (F:Format) -> struct
                   let res = F.build lo t in
                   time_stamp ("L : DONE     " ^ str); res
                end else begin
-                  HLog.warn("Read only baseuri for: "^ str); false
+                  HLog.error ("Read only baseuri for: "^ str^
+                     ", I won't compile it even if it is out of date"); 
+                  false
                end
              | Some froot -> make froot [t]
              | None -> 
                 HLog.error ("No root for: " ^ str); false
           else false
        in
-       prerr_endline ("L : " ^ string_of_bool res ^ " " ^ str);
+       time_stamp ("L : " ^ string_of_bool res ^ " " ^ str);
        Hashtbl.add cc t res; ok && res
 
 (****************************************************************************)
@@ -437,11 +450,21 @@ module Make = functor (F:Format) -> struct
     let deps = 
       List.map 
         (fun (file,d) -> 
-          let r,tgt = F.root_and_target_of local_options file in
+          let r,wtgt,rotgt = F.root_and_target_of local_options file in
           Hashtbl.add caches file (F.mtime_of_source_object file);
-          Hashtbl.add cachet tgt (F.mtime_of_target_object tgt); 
-          Hashtbl.add cached file (file, d, r, tgt);
-          (file, d, r, tgt)
+         (* if a read only target exists, we use that one, otherwise
+            we use the writeable one that may be compiled *)
+         let _,_,_, tgt as tuple = 
+           match F.mtime_of_target_object rotgt with
+           | Some _ as mtime ->
+               Hashtbl.add cachet rotgt mtime; 
+              (file, d, r, rotgt)
+           | None -> 
+               Hashtbl.add cachet wtgt (F.mtime_of_target_object wtgt); 
+              (file, d, r, wtgt)
+         in
+          Hashtbl.add cached file tuple;
+          tuple
        )
         deps
     in