X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=tools%2Fwhenjobs.ml;h=bd265459b05350443538073bdd97090e3c939270;hp=3383c9131004277c950e42f4414c7e920c510d22;hb=2ce29ff559f9bc36733ab2dde5b657eaa76ea8a6;hpb=108dd86b36e82df2a2029dbd12700f9c83e501c1 diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml index 3383c91..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,10 +89,12 @@ 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"; + "--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"; @@ -191,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. @@ -348,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;