diff --git a/TODO b/TODO
index f0dfa93173bba69c1fb188127394cd769eb4123e..f68c09889a92cbbe6e13ae035a74e717770c4952 100644
--- a/TODO
+++ b/TODO
@@ -1,12 +1,11 @@
Enhancements to pa_goal:
- - Include the goal name, source file location in the generated
- rule so we can improve error messages.
+ - Include the source file location in the generated goal code so we
+ can improve error messages.
- Implement some sort of tracing based on the above.
-It should be possible to register goal "atexit [of goal]" handlers.
-These only run when the goal successfully exits, allowing:
+Now that we have 'onrun' handlers, can we do the following on goal exit:
- implicit memory_set
diff --git a/configure.ac b/configure.ac
index ebc5cfd5c715eac89b0767c1b707b0c58c4d08d2..9754b5b1da37ec132b1d1e088d9ec0d18f239876 100644
--- a/configure.ac
+++ b/configure.ac
@@ -106,6 +106,12 @@ fi
AM_CONDITIONAL([HAVE_POD2MAN],
[test "x$POD2MAN" != "xno"])
+dnl Check for mailx (for sending email).
+AC_CHECK_PROG(MAILX,mailx,mailx)
+if test "x$MAILX" = "x"; then
+ AC_MSG_ERROR([You must install the mailx program])
+fi
+
AC_CONFIG_HEADERS([config.h])
AC_CONFIG_FILES([goaljobs_config.ml
goaljobs.spec
diff --git a/goaljobs-reference.pod b/goaljobs-reference.pod
index 79125689f797576a938210799ea6f3614c80b3f8..393e4b543896b21f293e05a9b234a50ed8a3c76c 100644
--- a/goaljobs-reference.pod
+++ b/goaljobs-reference.pod
@@ -180,6 +180,70 @@ program:
cc %s -o %s
" object program
+=head1 SPECIAL VALUES INSIDE GOALS
+
+=head2 goalname
+
+Inside goals, you can use C<goalname> to get the name of the goal, ie:
+
+ let goal foo () =
+ printf "my name is %s\n" goalname
+
+would print:
+
+ my name is foo
+
+=head2 onfail, onsuccess, onrun
+
+Inside goals you can register function(s) which run if the goal
+completes successfully (C<onsuccess>), if the goal completes
+successfully after running to the end (C<onrun>), or if the goal fails
+(C<onfail>).
+
+For example:
+
+ let goal built () =
+ onfail (fun _ -> eprintf "goal '%s' failed\n" goalname);
+ sh "
+ cc -o program main.o
+ "
+
+If the shell command (or another part of the goal) fails, then this
+would print out:
+
+ goal 'built' failed
+
+The single parameter passed to C<onfail> is the exception that was
+thrown.
+
+Note that the helper function C<Goaljobs.mailto> is a useful function
+to call from an C<onfail> handler:
+
+ let from = "me@example.com"
+ let to_ = "you@example.com"
+ let logfile = log_program_output ()
+
+ let goal built () =
+ onfail (fun _ ->
+ let subject = sprintf "goal: %s: BUILD FAILED" goalname in
+ mailto ~from ~subject ~attach:[logfile] to_);
+ sh "
+ cc -o program main.o
+ "
+
+C<onsuccess> and C<onrun> are slightly different from C<onfail> and
+from each other:
+
+C<onsuccess> functions can be called if a C<target> condition is met
+and the rest of the goal is short-circuited. C<onrun> will only be
+called if all the instructions in the goal actually run and succeed.
+
+The single unit C<()> parameter is passed to the C<onsuccess> and
+C<onrun> functions.
+
+You can register as many functions as you want for each handler. The
+order in which the functions are called is not defined.
+
=head1 PERIODIC JOBS
If you want to have a goal that runs when some outside event happens
diff --git a/goaljobs.ml b/goaljobs.ml
index 489f38743ab65028cb0ab9ed4172b650ed7a5d66..9688a9c424473703e03e5222ec14836af3899298 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -403,6 +403,27 @@ 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;
+ 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
diff --git a/goaljobs.mli b/goaljobs.mli
index c1dff52749a93337cfd3c823c63ab0c604e23d5c..a6361c53693745626295234d4fa5cdd1907d2710 100644
--- a/goaljobs.mli
+++ b/goaljobs.mli
@@ -296,6 +296,28 @@ val publish : string -> (string list -> unit) -> unit
the place to perform string to int conversion, checks, and
so on (remember that OCaml is strongly typed). *)
+(** {2 Logging script output} *)
+
+val log_program_output : unit -> string
+ (** [log_program_output] should be called at most once, usually at
+ the top-level of the script. It creates a temporary file
+ and redirects stdout and stderr into this file (they are still
+ sent to the ordinary output, so it acts like [tee]). The
+ filename of the temporary file is returned. *)
+
+(** {2 Sending email} *)
+
+val mailto : ?from:string -> subject:string -> ?attach:string list-> string -> unit
+ (** Send email.
+
+ Optional [?from] is the sender email address.
+
+ Required [~subject] is the subject line.
+
+ Optional [?attach] is a list of attachments (filenames).
+
+ The bare argument is the destination email address. *)
+
(**/**)
(* Goal versions of some common functions. You are using these
diff --git a/goaljobs.spec.in b/goaljobs.spec.in
index 04ed74ccced6e762b06e5a5e40e9142203a83b6c..af8db09811721e2abb12053d159d8a907bbc3992 100644
--- a/goaljobs.spec.in
+++ b/goaljobs.spec.in
@@ -19,6 +19,9 @@ BuildRequires: ocaml-calendar-devel
# For building manual pages.
BuildRequires: perl-podlators
+# For sending email.
+BuildRequires: mailx
+
# Requires camlp4 and ocamlfind and libraries at runtime.
Requires: /usr/bin/ocamlc
Requires: ocaml-camlp4-devel
@@ -26,6 +29,7 @@ Requires: ocaml-findlib-devel
Requires: ocaml-calendar-devel
Requires: curl
+Requires: mailx
%description
Goaljobs is make & cron replacement and business rules manager.
diff --git a/goaljobs_config.ml.in b/goaljobs_config.ml.in
index 38f8146dfb661f65dddee78b303019cd69aed090..812fa425d06e7856c91fa8d3d0ba7362f62dceb8 100644
--- a/goaljobs_config.ml.in
+++ b/goaljobs_config.ml.in
@@ -19,3 +19,5 @@
let package_name = "@PACKAGE_NAME@"
let package_version = "@PACKAGE_VERSION@"
+
+let mailx = "@MAILX"
diff --git a/pa_goal.ml b/pa_goal.ml
index 86f67db8aac6fef0bb419a5e3a233dca1a86b7f7..e7952336b35f3aee1cc0db809aa09ad67165e1f7 100644
--- a/pa_goal.ml
+++ b/pa_goal.ml
@@ -84,7 +84,44 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) =
);
(* Put a try-clause around the body. *)
- let body = <:expr< try $body$ with Goal_result Goal_OK -> () >> in
+ let body = <:expr<
+ (* Define a goal name which the body may use. *)
+ let goalname = $str:name$ in
+ (* Define onsuccess, onrun, onfail functions that the body may call. *)
+ let _on, _call_on =
+ let _on fns f = fns := f :: !fns in
+ let _call_on fns a = List.iter (fun f -> f a) !fns in
+ _on, _call_on
+ in
+ let onfail, _call_onfails =
+ let fns = ref [] in (_on fns), (_call_on fns)
+ in
+ let onrun, _call_onruns =
+ let fns = ref [] in (_on fns), (_call_on fns)
+ in
+ let onsuccess, _call_onsuccesses =
+ let fns = ref [] in (_on fns), (_call_on fns)
+ in
+
+ try
+ $body$ ;
+ _call_onruns ();
+ _call_onsuccesses ();
+
+ (* Avoid a compiler warning: *)
+ ignore (goalname)
+ with
+ (* target() within the body may raise Goal_OK meaning that the
+ * goal should be short-circuited. We return as if it's an
+ * ordinary function exit.
+ *)
+ | Goal_result Goal_OK ->
+ _call_onsuccesses ();
+ ()
+ | exn ->
+ _call_onfails exn;
+ raise exn
+ >> in
(* Recreate the function with parameters. *)
let expr =