let load_root_file rootpath =
let data = HExtlib.input_file rootpath in
let lines = Str.split (Str.regexp "\n") data in
- let clean s = Pcre.replace ~pat:"^ *" (Pcre.replace ~pat:" *$" s) in
+ let clean s =
+ Pcre.replace ~pat:"[ \t]+" ~templ:" "
+ (Pcre.replace ~pat:"^ *" (Pcre.replace ~pat:" *$" s))
+ in
List.map
(fun l ->
match Str.split (Str.regexp "=") l with
raise (NoRootFor file)
;;
+let mk_baseuri root extra =
+ let chop name =
+ assert(Filename.check_suffix name ".ma" ||
+ Filename.check_suffix name ".mma");
+ try Filename.chop_extension name
+ with Invalid_argument "Filename.chop_extension" -> name
+ in
+ remove_trailing_slash (HExtlib.normalize_path (root ^ "/" ^ chop extra))
+;;
+
let baseuri_of_script ~include_paths file =
let root, buri, path = find_root_for ~include_paths file in
let path = HExtlib.normalize_path path in
| _ -> raise (NoRootFor (file ^" "^path^" "^root))
in
let extra_buri = substract lpath lroot in
- let chop name =
- assert(Filename.check_suffix name ".ma" ||
- Filename.check_suffix name ".mma");
- try Filename.chop_extension name
- with Invalid_argument "Filename.chop_extension" -> name
- in
let extra = String.concat "/" extra_buri in
root,
- remove_trailing_slash (HExtlib.normalize_path
- (buri ^ "/" ^ chop extra)),
+ mk_baseuri buri extra,
path,
extra
;;
options -> source_object -> string option * 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
+ val dotdothack: source_object -> source_object
end
module Make = functor (F:Format) -> struct
| Some _ as x -> x
| None ->
match F.mtime_of_target_object b with
- | Some t as x -> Hashtbl.add ct b x; x
+ | Some t as x ->
+ Hashtbl.remove ct b;
+ Hashtbl.add ct b x; x
| x -> x
with Not_found -> assert false
in
| Some _ as x -> x
| None ->
match F.mtime_of_target_object a with
- | Some t as x -> Hashtbl.add ct a x; x
+ | Some t as x ->
+ Hashtbl.remove ct b;
+ Hashtbl.add ct a x; x
| x -> x
with Not_found -> assert false
in
| Some _ as x -> x
| None ->
match F.mtime_of_target_object b with
- | Some t as x -> Hashtbl.add ct b x; x
+ | Some t as x ->
+ Hashtbl.remove ct b;
+ Hashtbl.add ct b x; x
| x -> x
with Not_found -> assert false
in
purge_unwanted_roots wanted (newroots @ rest)
;;
+ let is_not_ro (opts,_,_) (f,_,r,_) =
+ match r with
+ | Some root -> not (F.is_readonly_buri_of opts f)
+ | None -> assert false
+ ;;
+
let rec make_aux root (lo,_,ct as opts) compiled failed deps =
let todo = List.filter (is_buildable opts compiled deps) deps in
let todo = List.filter (fun (f,_,_,_)->not (List.mem f failed)) todo in
+ let todo =
+ let local, remote =
+ List.partition (fun (_,_,froot,_) -> froot = Some root) todo
+ in
+ let local, skipped = List.partition (is_not_ro opts) local in
+ List.iter
+ (fun x ->
+ HLog.warn("Read only baseuri for: "^F.string_of_source_object(fst4 x)))
+ skipped;
+ remote @ local
+ in
if todo <> [] then
let compiled, failed =
- let todo =
- let local, remote =
- List.partition (fun (_,_,froot,_) -> froot = Some root) todo
- in
- remote @ local
- in
List.fold_left
(fun (c,f) (file,_,froot,tgt) ->
let rc =
if targets = [] then
make_aux root opts [] [] deps
else
- make_aux root opts [] [] (purge_unwanted_roots targets deps)
+ make_aux root opts [] []
+ (purge_unwanted_roots (List.map F.dotdothack targets) deps)
in
HLog.debug ("Leaving directory '"^root^"'");
Sys.chdir old_root;
close_out oc;
HLog.message ("Generated: " ^ root ^ "/depends")
;;
-
+
+(* FG ***********************************************************************)
+
+(* scheme uri part as defined in URI Generic Syntax (RFC 3986) *)
+let uri_scheme_rex = Pcre.regexp "^[[:alpha:]][[:alnum:]\-+.]*:"
+
+let is_uri str =
+ Pcre.pmatch ~rex:uri_scheme_rex str