(* version.ml - Don Yang (uguu.org) repository_root, current_root, and snapshot_list can be evaluated only once because: - version.ml may use these variables more than once, but never modifies the repository state. - commit.ml modifies repository state, but does not use any variables more than once. 04/16/06 *) (* Memoized states *) let repository_root = Lazy.lazy_from_fun Repository.locate;; let current_root = Lazy.lazy_from_fun Repository.current_root;; let relative_path = lazy (Path.replace_root (Lazy.force current_root) "" (Path.normalize (Sys.getcwd())));; (* Create string for root directory of new version *) let new_version () = let t = Unix.gmtime (Unix.time()) in Printf.sprintf "%04d-%02d-%02d-%02d-%02d-%02d" (t.Unix.tm_year + 1900) (t.Unix.tm_mon + 1) t.Unix.tm_mday t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec;; (* Get list of available snapshots, from latest to earliest *) let rec get_snapshot_list_recurse root subdir_list index = try let path = root ^ Path.separator_str ^ (subdir_list.(index)) in let s = Unix.stat path in if s.Unix.st_kind = Unix.S_DIR then path::(get_snapshot_list_recurse root subdir_list (index + 1)) else get_snapshot_list_recurse root subdir_list (index + 1) with Unix.Unix_error _ -> get_snapshot_list_recurse root subdir_list (index + 1) | Invalid_argument _ -> [];; let snapshot_list = lazy (let repository = Lazy.force repository_root in if repository = "" then [] else (let subdir_list = Sys.readdir repository in Array.sort (fun a b -> -(compare a b)) subdir_list; get_snapshot_list_recurse repository subdir_list 0));; let get_snapshot_list () = Lazy.force snapshot_list;; (* Get root directory of latest version in repository *) let last_snapshot_path () = match get_snapshot_list() with a::b -> a | [] -> "";; (* Filter items in list *) let rec filter_items include_test items = match items with a::b -> if include_test a then a::(filter_items include_test b) else filter_items include_test b | [] -> [];; (* Expand * or ... filepattern *) let expand_pattern root pattern = let normalized_pattern = Path.normalize (root ^ Path.separator_str ^ (Lazy.force relative_path) ^ Path.separator_str ^ pattern) in let regexp, enum_type = Path.pattern_to_regexp normalized_pattern in if enum_type = Path.SINGLE_FILE then [normalized_pattern] else let base_path = Filename.dirname normalized_pattern in let files = List.map (fun x -> fst x) (snd (Dir.split_file_list ((if enum_type = Path.SUB_DIR then Dir.enumerate else Dir.enumerate_no_recurse) base_path))) in let filter x = Str.string_match (Str.regexp (regexp ^ "$")) x 0 in filter_items filter files;; (* Expand # arguments *) let expand_repository_root arg = let root = Lazy.force repository_root in if root = "" then failwith "Repository not found" else [root ^ Path.separator_str ^ (String.sub arg 1 ((String.length arg) - 1))];; (* Expand # arguments *) let expand_last_version pattern = let last_version = last_snapshot_path() in if last_version = "" then failwith "No previous version"; let filelist = expand_pattern last_version pattern in if List.length filelist = 0 then failwith (Printf.sprintf "%s# did not match any files (relative path = %s)" pattern (Lazy.force relative_path)) else filelist;; (* Expand # arguments *) let rec enumerate_new_version snapshots pattern index = match snapshots with a::b -> if index = -1 then expand_pattern a pattern else enumerate_new_version b pattern (index + 1) | [] -> invalid_arg "version";; let rec enumerate_old_version snapshots pattern index = match snapshots with a::b -> if index = 0 then expand_pattern a pattern else enumerate_old_version b pattern (index - 1) | [] -> invalid_arg "version";; let expand_indexed_version pattern index = try let s = get_snapshot_list() in let filelist = (if index < 0 then enumerate_new_version s pattern index else enumerate_old_version s pattern ((List.length s) - index)) in if List.length filelist = 0 then failwith (Printf.sprintf "%s#%d did not match any files (relative path = %s)" pattern index (Lazy.force relative_path)) else filelist with Invalid_argument "version" -> failwith (Printf.sprintf "Can not expand %s#%d, version index out of bounds" pattern index);; (* Expand # arguments *) let expand_dated_version pattern date = let version_prefix = (Lazy.force repository_root) ^ Path.separator_str ^ (try Scanf.sscanf date "%d-%d-%d-%d-%d-%d" (Printf.sprintf "%04d-%02d-%02d-%02d-%02d-%02d") with End_of_file | Scanf.Scan_failure _ -> try Scanf.sscanf date "%d-%d-%d-%d-%d" (Printf.sprintf "%04d-%02d-%02d-%02d-%02d") with End_of_file | Scanf.Scan_failure _ -> try Scanf.sscanf date "%d-%d-%d-%d" (Printf.sprintf "%04d-%02d-%02d-%02d") with End_of_file | Scanf.Scan_failure _ -> try Scanf.sscanf date "%d-%d-%d" (Printf.sprintf "%04d-%02d-%02d") with End_of_file | Scanf.Scan_failure _ -> failwith (Printf.sprintf "Can not expand %s#%s" pattern date)) in let versions = filter_items (fun x -> try (String.sub x 0 (String.length version_prefix)) = version_prefix with Invalid_argument _ -> false) (get_snapshot_list()) in if List.length versions = 0 then failwith (Printf.sprintf "%s#%s did not match any versions" pattern (Filename.basename version_prefix)); let filelist = List.flatten (List.map (fun x -> expand_pattern x pattern) versions) in if List.length filelist = 0 then failwith (Printf.sprintf "%s#%s did not match any files" pattern (Filename.basename version_prefix)); filelist;; (* Check argument string to select expansion type *) let expansion_mux arg = try let s = String.rindex arg '#' in if s = 0 then expand_repository_root arg else if (String.get arg (s - 1)) = '\\' then [arg] else let version = String.sub arg (s + 1) ((String.length arg) - s - 1) in let pattern = String.sub arg 0 s in if version = "" || version = "0" then expand_last_version pattern else try expand_indexed_version pattern (int_of_string version) with Failure "int_of_string" -> expand_dated_version pattern version with Not_found -> [arg];; (* Expand command line arguments *) let expand_args args = List.flatten (List.map (fun x -> expansion_mux x) args);;