2 * Copyright (C) 2013 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 type goal_result_t = Goal_OK | Goal_failed of string
25 exception Goal_result of goal_result_t
27 let goal_failed msg = raise (Goal_result (Goal_failed msg))
30 if v then raise (Goal_result Goal_OK)
31 let target_all vs = target (List.fold_left (&&) true vs)
32 let target_exists vs = target (List.fold_left (||) false vs)
35 let file_exists = Sys.file_exists
37 let file_newer_than f1 f2 =
41 | Unix_error (ENOENT, _, _) -> None
42 | Unix_error (err, _, _) ->
43 let msg = sprintf "file_newer_than: %s: %s" f (error_message err) in
46 let s1 = stat f1 and s2 = stat f2 in
52 let msg = sprintf "file_newer_than: %s: file does not exist" f2 in
55 s1.st_mtime >= s2.st_mtime
57 let more_recent objs srcs =
58 if not (List.for_all file_exists objs) then false
61 fun obj -> List.for_all (file_newer_than obj) srcs
66 (* http://stackoverflow.com/questions/12199059/how-to-check-if-an-url-exists-with-the-shell-and-probably-curl *)
68 sprintf "curl --output /dev/null --silent --head --fail %s" (quote url) in
69 match Sys.command cmd with
73 let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
76 let file_contains_string filename str =
77 let cmd = sprintf "grep -q %s %s" (quote str) (quote filename) in
78 match Sys.command cmd with
82 let msg = sprintf "grep error testing for '%s' in '%s' (exit code %d)"
86 let url_contains_string url str =
87 let tmp = Filename.temp_file "goaljobsurl" "" in
89 sprintf "curl --output %s --silent --fail %s" (quote tmp) (quote url) in
90 (match Sys.command cmd with
93 let msg = sprintf "curl failed to download URL '%s'" url in
96 let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
99 let r = file_contains_string tmp str in
106 let cmd = "set -e\nset -x\n\n" ^ cmd in
107 let r = Sys.command cmd in
109 let msg = sprintf "external command failed with code %d" r in
116 let cmd = "set -e\nset -x\n\n" ^ cmd in
117 let chan = open_process_in cmd in
118 let lines = ref [] in
120 let line = input_line chan in
121 lines := line :: !lines;
124 (try loop () with End_of_file -> ());
125 let r = close_process_in chan in
127 | WEXITED 0 -> List.rev !lines
129 let msg = sprintf "external command failed with code %d" i in
132 let msg = sprintf "external command was killed by signal %d" i in
135 let msg = sprintf "external command was stopped by signal %d" i in
137 let shlines fs = ksprintf do_shlines fs
140 let lines = do_shlines cmd in
141 String.concat "\n" lines
142 let shout fs = ksprintf do_shout fs
145 val shell : string ref
149 val replace_substring : string -> string -> string -> string
152 let change_file_extension ext filename =
154 try String.rindex filename '.'
155 with Not_found -> String.length filename in
156 String.sub filename 0 i ^ "." ^ ext
159 val filter_file_extension : string -> string list -> string
162 (* XXX The Memory is not actually persistent yet. *)
163 let memory = Hashtbl.create 13
165 let memory_exists = Hashtbl.mem memory
166 let memory_set = Hashtbl.replace memory
167 let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None
168 let memory_delete = Hashtbl.remove memory
170 let published_goals = ref []
171 let publish name fn = published_goals := (name, fn) :: !published_goals
173 try Some (List.assoc name !published_goals) with Not_found -> None
175 let goal_file_exists filename =
176 if not (file_exists filename) then (
177 let msg = sprintf "file '%s' required but not found" filename in
180 let goal_file_newer_than f1 f2 =
181 if not (file_newer_than f1 f2) then (
182 let msg = sprintf "file %s is required to be newer than %s" f1 f2 in
185 let goal_more_recent objs srcs =
186 if not (more_recent objs srcs) then (
187 let msg = sprintf "object(s) %s are required to be newer than source(s) %s"
188 (String.concat " " objs) (String.concat " " srcs) in
191 let goal_url_exists url =
192 if not (url_exists url) then (
193 let msg = sprintf "url_exists: URL '%s' required but does not exist" url in
196 let goal_file_contains_string filename str =
197 if not (file_contains_string filename str) then (
198 let msg = sprintf "file_contains_string: file '%s' is required to contain string '%s'" filename str in
201 let goal_url_contains_string url str =
202 if not (url_contains_string url str) then (
203 let msg = sprintf "url_contains_string: URL '%s' is required to contain string '%s'" url str in
206 let goal_memory_exists k =
207 if not (memory_exists k) then (
208 let msg = sprintf "memory_exists: key '%s' required but does not exist" k in
212 (* Run the program. *)
214 let prog = Sys.executable_name in
215 let prog = Filename.basename prog in
219 let display_version () =
220 printf "%s %s\n" package_name package_version;
225 let names = !published_goals in
226 let names = List.map fst names in
227 let names = List.sort compare names in
228 List.iter print_endline names
231 let argspec = Arg.align [
232 "--goals", Arg.Unit list_goals, " List all goals";
233 "-l", Arg.Unit list_goals, " List all goals";
234 "-V", Arg.Unit display_version, " Display version number and exit";
235 "--version", Arg.Unit display_version, " Display version number and exit";
237 let anon_fun str = args := str :: !args in
238 let usage_msg = sprintf "\
239 %s: a script generated by goaljobs
241 List all goals: %s -l
242 Run a single goal like this: %s <name-of-goal> [<goal-args ...>]
244 For more information see the goaljobs(1) man page.
249 Arg.parse argspec anon_fun usage_msg;
251 let args = List.rev !args in
253 (* Was a goal named on the command line? *)
256 (match get_goal name with
259 eprintf "error: no goal called '%s' was found.\n" name;
260 eprintf "Use %s -l to list all published goals in this script.\n" name;
264 (* Does a published 'all' goal exist? *)
265 match get_goal "all" with
268 (* No published 'all' goal. This is only a warning, because
269 * other top-level code may exist in the script.
271 eprintf "warning: no 'all' goal found.\n"