X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=goaljobs.ml;h=4024b6da999770be1dc4c56fcc60853c95e2f541;hb=bd08c0a87a906c312deeed28f55bd94e76fecac7;hp=94843acb97126264005c83b6c0a79e866e9c24fd;hpb=e945605c6b1db3490c81a1434824151e8854dff6;p=goaljobs.git

diff --git a/goaljobs.ml b/goaljobs.ml
index 94843ac..4024b6d 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -33,11 +33,31 @@ exception Goal_result of goal_result_t
 
 let goal_failed msg = raise (Goal_result (Goal_failed msg))
 
+let depth = ref 0
+let indent fs =
+  let do_indent str =
+    prerr_string "| ";
+    for i = 0 to !depth-1 do prerr_string "  " done;
+    prerr_string str;
+    Pervasives.flush Pervasives.stderr
+  in
+  ksprintf do_indent fs
+
 let target v =
   if v then raise (Goal_result Goal_OK)
 let target_all vs = target (List.fold_left (&&) true vs)
 let target_exists vs = target (List.fold_left (||) false vs)
-let require f = f ()
+let require name f =
+  indent "require: %s\n" name;
+  incr depth;
+  let r = (try Either (f ()) with exn -> Or exn) in
+  decr depth;
+  match r with
+  | Either x -> x
+  | Or exn -> raise exn
+
+let _enter_goal name = indent "enter goal: %s\n" name
+let _leave_goal name = indent "leave goal: %s\n" name
 
 type period_t = Seconds | Days | Months | Years
 let seconds = (1, Seconds)
@@ -196,7 +216,7 @@ let url_exists url =
     goal_failed msg
 
 let file_contains_string filename str =
-  let cmd = sprintf "grep -q %s %s" (quote str) (quote filename) in
+  let cmd = sprintf "grep -q -F %s %s" (quote str) (quote filename) in
   match Sys.command cmd with
   | 0 -> true
   | 1 -> false
@@ -242,7 +262,7 @@ let rm_rf dir =
 let shell = ref "/bin/sh"
 
 (* Used by sh, shout, shlines to handle the script and temporary dir. *)
-let with_script ?(tmpdir = false) script f =
+let with_script ?(tmpdir = true) script f =
   let dir = if tmpdir then Some (make_tmpdir ()) else None in
   let script_file, chan =
     match dir with
@@ -340,6 +360,7 @@ let with_memory_locked ?(write = false) f =
   let filename = getenv "HOME" // ".goaljobs-memory" in
   let fd = openfile filename [O_RDWR; O_CREAT] 0o644 in
   lockf fd (if write then F_LOCK else F_RLOCK) 0;
+
   (* If the file is newly created with zero size, write an
    * empty hash table.
    *)
@@ -354,6 +375,7 @@ let with_memory_locked ?(write = false) f =
   (* Run the function. *)
   let r = try Either (f fd) with exn -> Or exn in
   lockf fd F_ULOCK 0;
+  close fd;
   match r with
   | Either x -> x
   | Or exn -> raise exn
@@ -403,6 +425,28 @@ 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 log_program_output () =
+  let filename = Filename.temp_file "goaljobslog" ".txt" in
+  let cmd = "tee " ^ quote filename in
+  let chan = open_process_out cmd in
+  let fd = descr_of_out_channel chan in
+  dup2 fd stdout;
+  dup2 fd stderr;
+  filename
+
+let mailto ?from ~subject ?(attach = []) to_ =
+  let cmd = ref (sprintf "%s -s %s" mailx (quote subject)) in
+  (match from with
+  | None -> ()
+  | Some f -> cmd := !cmd ^ " -r " ^ quote f
+  );
+  List.iter (
+    fun a -> cmd := !cmd ^ " -a " ^ quote a
+  ) attach;
+  cmd := !cmd ^ " " ^ quote to_;
+  if Sys.command !cmd <> 0 then
+    goal_failed "mailto: could not send email"
+
 let goal_file_exists filename =
   if not (file_exists filename) then (
     let msg = sprintf "file '%s' required but not found" filename in