X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=tools%2Fwhenjobs.ml;h=bd265459b05350443538073bdd97090e3c939270;hp=dade6c2b0936c5091fd4a67d543682f80d2c0669;hb=545581eb916ac5f020295b59458e16af51ea6cc5;hpb=61cad7bbaf63389b520b695eefdd735bc11a8aa6

diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml
index dade6c2..bd26545 100644
--- a/tools/whenjobs.ml
+++ b/tools/whenjobs.ml
@@ -20,6 +20,11 @@ open Big_int
 open Unix
 open Printf
 
+open Whenutils
+
+(* Ensures that Whentools module is linked to the whenjobs tool. *)
+let _ = Whentools.set_variable
+
 let libdir = ref Libdir.libdir
 
 let jobsdir =
@@ -76,6 +81,7 @@ let rec main () =
   in
 
   let argspec = Arg.align [
+    "--cancel", Arg.Unit (set_mode `Cancel), " Cancel a job";
     "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon";
     "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon";
     "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon";
@@ -83,11 +89,13 @@ let rec main () =
     "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script";
     "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script";
     "--get", Arg.Unit (set_mode `Get), " Display the variable";
+    "--jobs", Arg.Unit (set_mode `Jobs), " List running jobs";
     "-l", Arg.Unit (set_mode `List), " List the script";
     "--list", Arg.Unit (set_mode `List), " List the script";
     "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
     "--set", Arg.Unit (set_mode `Set), " Set the variable";
-    "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type";
+    "--start", Arg.Unit (set_mode `Start), " Start a job manually";
+    "--type", Arg.Set_string typ, "bool|int|float|string|unit Set the variable type";
     "--upload", Arg.Unit (set_mode `Upload), " Upload the script";
     "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
     "-V", Arg.Unit display_version, " Display version number and exit";
@@ -130,6 +138,7 @@ Options:
     | "string" -> `String
     | "int" -> `Int
     | "float"|"double" -> `Float
+    | "unit" -> `Unit
     | t ->
       eprintf "whenjobs: --type: unknown type (%s)\n" t;
       exit 1 in
@@ -190,6 +199,27 @@ Options:
     unused_error args "--daemon-status";
     daemon_status ()
 
+  | Some `Jobs ->
+    unused_error args "--jobs";
+    jobs ()
+
+  | Some `Cancel ->
+    if List.length args != 1 then (
+      eprintf "whenjobs --cancel serial\n";
+      suggest_help ();
+      exit 1
+    );
+    cancel_job (List.hd args)
+
+  | Some `Start ->
+    if List.length args != 1 then (
+      eprintf "whenjobs --start jobname\n";
+      eprintf "If 'value' contains spaces, you may need to quote it.\n";
+      suggest_help ();
+      exit 1
+    );
+    start_job (List.hd args)
+
 and edit_file () =
   (* If there is no initial file, create an empty one containing the
    * tutorial.
@@ -248,7 +278,7 @@ and upload_file () =
   );
 
   (* Test-load the jobs file to ensure it makes sense. *)
-  Whenfile.init ();
+  Whenfile.init Whenstate.empty;
   (try
      Dynlink.loadfile cmo_file
    with
@@ -293,10 +323,22 @@ and set_variable name value typ =
        with Failure _ ->
          eprintf "whenjobs: variable is not a floating point number\n";
          exit 1
-      ) in
+      )
+    | `Unit ->
+      if value <> "" then (
+        eprintf "whenjobs: unit variables must be empty strings\n";
+        exit 1
+      );
+      `unit_t in
 
   let client = start_client () in
-  Whenproto_clnt.When.V1.set_variable client (name, value);
+  (match Whenproto_clnt.When.V1.set_variable client (name, value) with
+  | `ok -> ()
+  | `error msg ->
+    eprintf "whenjobs: set: %s\n" msg;
+    suggest_check_server_logs ();
+    exit 1
+  );
   stop_client client
 
 and get_variable name =
@@ -319,7 +361,15 @@ and daemon_start () =
   assert false
 
 and daemon_stop () =
-  assert false
+  let client = start_client () in
+  (match Whenproto_clnt.When.V1.exit_daemon client () with
+  | `ok -> ()
+  | `error msg ->
+    eprintf "whenjobs: daemon-stop: %s\n" msg;
+    suggest_check_server_logs ();
+    exit 1
+  );
+  stop_client client
 
 and daemon_restart () =
   assert false
@@ -327,6 +377,50 @@ and daemon_restart () =
 and daemon_status () =
   assert false
 
+and jobs () =
+  let client = start_client () in
+  let jobs = Whenproto_clnt.When.V1.get_jobs client () in
+  stop_client client;
+
+  let cmp { Whenproto_aux.job_name = name1; job_serial = serial1 }
+      { Whenproto_aux.job_name = name2; job_serial = serial2 } =
+    let i = compare name1 name2 in
+    if i <> 0 then i
+    else
+      compare_big_int (big_int_of_string serial1) (big_int_of_string serial2)
+  in
+  Array.sort cmp jobs;
+
+  Array.iter (
+    fun { Whenproto_aux.job_serial = serial; job_name = name;
+          job_tmpdir = tmpdir; job_start_time = time } ->
+      printf "%s %s\n\trunning in: %s\n\tstarted at: %s\n"
+        serial name tmpdir
+        (string_of_time_t ~localtime:true (Int64.to_float time))
+  ) jobs
+
+and cancel_job serial =
+  let client = start_client () in
+  (match Whenproto_clnt.When.V1.cancel_job client serial with
+  | `ok -> ()
+  | `error msg ->
+    eprintf "whenjobs: cancel-job: %s\n" msg;
+    suggest_check_server_logs ();
+    exit 1
+  );
+  stop_client client
+
+and start_job name =
+  let client = start_client () in
+  (match Whenproto_clnt.When.V1.start_job client name with
+  | `ok -> ()
+  | `error msg ->
+    eprintf "whenjobs: start-job: %s\n" msg;
+    suggest_check_server_logs ();
+    exit 1
+  );
+  stop_client client
+
 and unused_error args op =
   if args <> [] then (
     eprintf "whenjobs %s: unused parameters on the command line.\n" op;
@@ -370,6 +464,7 @@ and stop_client client =
   Rpc_client.shut_down client
 
 and string_of_variable = function
+  | `unit_t -> ""
   | `bool_t b -> string_of_bool b
   | `string_t s -> s
   | `int_t i -> i (* passed on the wire as a string *)