open Unix
open Printf
+open Goaljobs_config
+
+let (//) = Filename.concat
+let quote = Filename.quote
+
type goal_result_t = Goal_OK | Goal_failed of string
exception Goal_result of goal_result_t
let target v =
if v then raise (Goal_result Goal_OK)
-let require = function
- | Goal_OK -> ()
- | r -> raise (Goal_result r)
+let target_all vs = target (List.fold_left (&&) true vs)
+let target_exists vs = target (List.fold_left (||) false vs)
+let require () = ()
let file_exists = Sys.file_exists
in
let s1 = stat f1 and s2 = stat f2 in
match s1 with
- | None -> ()
+ | None -> false
| Some s1 ->
match s2 with
| None ->
| Some s2 ->
s1.st_mtime >= s2.st_mtime
-let url_exists url = goal_failed "url_exists not implemented!"
+let more_recent objs srcs =
+ if not (List.for_all file_exists objs) then false
+ else (
+ List.for_all (
+ fun obj -> List.for_all (file_newer_than obj) srcs
+ ) objs
+ )
+
+let url_exists url =
+ (* http://stackoverflow.com/questions/12199059/how-to-check-if-an-url-exists-with-the-shell-and-probably-curl *)
+ let cmd =
+ sprintf "curl --output /dev/null --silent --head --fail %s" (quote url) in
+ match Sys.command cmd with
+ | 0 -> true
+ | 1 -> false
+ | r ->
+ let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
+ goal_failed msg
+
+let file_contains_string filename str =
+ let cmd = sprintf "grep -q %s %s" (quote str) (quote filename) in
+ match Sys.command cmd with
+ | 0 -> true
+ | 1 -> false
+ | r ->
+ let msg = sprintf "grep error testing for '%s' in '%s' (exit code %d)"
+ str filename r in
+ goal_failed msg
+
+let url_contains_string url str =
+ let tmp = Filename.temp_file "goaljobsurl" "" in
+ let cmd =
+ sprintf "curl --output %s --silent --fail %s" (quote tmp) (quote url) in
+ (match Sys.command cmd with
+ | 0 -> ()
+ | 1 ->
+ let msg = sprintf "curl failed to download URL '%s'" url in
+ goal_failed msg
+ | r ->
+ let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
+ goal_failed msg
+ );
+ let r = file_contains_string tmp str in
+ unlink tmp;
+ r
+
let sh fs =
let do_sh cmd =
- print_endline cmd;
- let cmd = "set -e\n\n" ^ cmd in
- let r = System.command cmd in
+ let cmd = "set -e\nset -x\n\n" ^ cmd in
+ let r = Sys.command cmd in
if r <> 0 then (
- let msg = sprintf "sh: external command failed with code %d" r in
+ let msg = sprintf "external command failed with code %d" r in
goal_failed msg
)
in
ksprintf do_sh fs
-(*
-val shout : ('a, unit, string) format -> 'a
-val shlines : ('a, unit, string) format -> 'a
+let do_shlines cmd =
+ let cmd = "set -e\nset -x\n\n" ^ cmd in
+ let chan = open_process_in cmd in
+ let lines = ref [] in
+ let rec loop () =
+ let line = input_line chan in
+ lines := line :: !lines;
+ loop ()
+ in
+ (try loop () with End_of_file -> ());
+ let r = close_process_in chan in
+ match r with
+ | WEXITED 0 -> List.rev !lines
+ | WEXITED i ->
+ let msg = sprintf "external command failed with code %d" i in
+ goal_failed msg
+ | WSIGNALED i ->
+ let msg = sprintf "external command was killed by signal %d" i in
+ goal_failed msg
+ | WSTOPPED i ->
+ let msg = sprintf "external command was stopped by signal %d" i in
+ goal_failed msg
+let shlines fs = ksprintf do_shlines fs
+let do_shout cmd =
+ let lines = do_shlines cmd in
+ String.concat "\n" lines
+let shout fs = ksprintf do_shout fs
+
+(*
val shell : string ref
*)
(*
val replace_substring : string -> string -> string -> string
-val change_file_extension : string -> string -> string
+*)
+
+let change_file_extension ext filename =
+ let i =
+ try String.rindex filename '.'
+ with Not_found -> String.length filename in
+ String.sub filename 0 i ^ "." ^ ext
+
+(*
val filter_file_extension : string -> string list -> string
*)
+(* XXX The Memory is not actually persistent yet. *)
+let memory = Hashtbl.create 13
+
+let memory_exists = Hashtbl.mem memory
+let memory_set = Hashtbl.replace memory
+let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None
+let memory_delete = Hashtbl.remove memory
+
+let published_goals = ref []
+let publish name fn = published_goals := (name, fn) :: !published_goals
+let get_goal name =
+ try Some (List.assoc name !published_goals) with Not_found -> None
+
let goal_file_exists filename =
if not (file_exists filename) then (
- let msg = sprintf "file_exists: %s: file not found" filename in
+ let msg = sprintf "file '%s' required but not found" filename in
goal_failed msg
)
let goal_file_newer_than f1 f2 =
if not (file_newer_than f1 f2) then (
- let msg = sprintf "file %s is not newer than %s" f1 f2 in
+ let msg = sprintf "file %s is required to be newer than %s" f1 f2 in
+ goal_failed msg
+ )
+let goal_more_recent objs srcs =
+ if not (more_recent objs srcs) then (
+ let msg = sprintf "object(s) %s are required to be newer than source(s) %s"
+ (String.concat " " objs) (String.concat " " srcs) in
goal_failed msg
)
let goal_url_exists url =
if not (url_exists url) then (
- let msg = sprintf "url_exists: %s: URL does not exist" url in
+ let msg = sprintf "url_exists: URL '%s' required but does not exist" url in
+ goal_failed msg
+ )
+let goal_file_contains_string filename str =
+ if not (file_contains_string filename str) then (
+ let msg = sprintf "file_contains_string: file '%s' is required to contain string '%s'" filename str in
+ goal_failed msg
+ )
+let goal_url_contains_string url str =
+ if not (url_contains_string url str) then (
+ let msg = sprintf "url_contains_string: URL '%s' is required to contain string '%s'" url str in
goal_failed msg
)
+let goal_memory_exists k =
+ if not (memory_exists k) then (
+ let msg = sprintf "memory_exists: key '%s' required but does not exist" k in
+ goal_failed msg
+ )
+
+(* Run the program. *)
+let init () =
+ let prog = Sys.executable_name in
+ let prog = Filename.basename prog in
+
+ let args = ref [] in
+
+ let display_version () =
+ printf "%s %s\n" package_name package_version;
+ exit 0
+ in
+
+ let list_goals () =
+ let names = !published_goals in
+ let names = List.map fst names in
+ let names = List.sort compare names in
+ List.iter print_endline names
+ in
+
+ let argspec = Arg.align [
+ "--goals", Arg.Unit list_goals, " List all goals";
+ "-l", Arg.Unit list_goals, " List all goals";
+ "-V", Arg.Unit display_version, " Display version number and exit";
+ "--version", Arg.Unit display_version, " Display version number and exit";
+ ] in
+ let anon_fun str = args := str :: !args in
+ let usage_msg = sprintf "\
+%s: a script generated by goaljobs
+
+List all goals: %s -l
+Run a single goal like this: %s <name-of-goal> [<goal-args ...>]
+
+For more information see the goaljobs(1) man page.
+
+Options:
+" prog prog prog in
+
+ Arg.parse argspec anon_fun usage_msg;
+
+ let args = List.rev !args in
+
+ (* Was a goal named on the command line? *)
+ match args with
+ | name :: args ->
+ (match get_goal name with
+ | Some fn -> fn args
+ | None ->
+ eprintf "error: no goal called '%s' was found.\n" name;
+ eprintf "Use %s -l to list all published goals in this script.\n" name;
+ exit 1
+ )
+ | [] ->
+ (* Does a published 'all' goal exist? *)
+ match get_goal "all" with
+ | Some fn -> fn []
+ | None ->
+ (* No published 'all' goal. This is only a warning, because
+ * other top-level code may exist in the script.
+ *)
+ eprintf "warning: no 'all' goal found.\n"
git.annexia.org / goaljobs.git / blobdiff