From 3acfed6261fc1ec02e370183ac2f76c095ad0cdf Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Sat, 8 Mar 2014 21:27:40 +0000
Subject: [PATCH] Add a command line tool for examining the goaljobs persistent
memory.
goaljobs-memory list
goaljobs-memory set target_foo 1.2
---
.depend | 2 ++
.gitignore | 1 +
Makefile.am | 11 +++++++--
goaljobs.ml | 8 +++++++
goaljobs.mli | 3 +++
goaljobs_memory.ml | 58 ++++++++++++++++++++++++++++++++++++++++++++++
6 files changed, 81 insertions(+), 2 deletions(-)
create mode 100644 goaljobs_memory.ml
diff --git a/.depend b/.depend
index e4f3d09..8fa0086 100644
--- a/.depend
+++ b/.depend
@@ -3,3 +3,5 @@ goaljobs.cmo : goaljobs_config.cmo goaljobs.cmi
goaljobs.cmx : goaljobs_config.cmx goaljobs.cmi
goaljobs_config.cmo :
goaljobs_config.cmx :
+goaljobs_memory.cmo : goaljobs.cmi
+goaljobs_memory.cmx : goaljobs.cmx
diff --git a/.gitignore b/.gitignore
index a385798..177201c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -26,6 +26,7 @@ Makefile
/goaljobs_config.ml
/goaljobs.spec
/goaljobs-*.tar.gz
+/goaljobs-memory
/install-sh
/libtool
/ltmain.sh
diff --git a/Makefile.am b/Makefile.am
index 54c3a6f..7ed61d1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -25,6 +25,7 @@ EXTRA_DIST = \
goaljobs_config.ml.in \
goaljobs.ml \
goaljobs.mli \
+ goaljobs_memory.ml \
goaljobs.pod \
goaljobs-reference.pod \
goaljobs.spec \
@@ -40,9 +41,10 @@ SUBDIRS = . examples tests
sources = \
goaljobs_config.ml \
goaljobs.ml \
- goaljobs.mli
+ goaljobs.mli \
+ goaljobs_memory.ml
-bin_SCRIPTS = goaljobs
+bin_SCRIPTS = goaljobs goaljobs-memory
# These targets are noinst because we use a custom install hook to
# install them, and are _SCRIPTS because automake doesn't know how to
@@ -61,6 +63,11 @@ pa_goal.cmo: pa_goal.ml
$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package camlp4.lib -linkpkg \
-pp $(CAMLP4OF) -c $< -o $@
+# Standalone program for examining the goaljobs memory.
+goaljobs-memory: goaljobs_config.cmx goaljobs.cmx goaljobs_memory.cmx
+ $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) \
+ $^ -linkpkg -o $@
+
# Install.
install-data-hook:
mkdir -p $(DESTDIR)$(OCAMLLIB)
diff --git a/goaljobs.ml b/goaljobs.ml
index 4024b6d..208882c 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -420,6 +420,14 @@ let memory_delete key =
Pervasives.flush chan;
)
+let memory_list () =
+ with_memory_locked (
+ fun fd ->
+ let chan = in_channel_of_descr fd in
+ let memory : (string, string) Hashtbl.t = input_value chan in
+ Hashtbl.fold (fun key value xs -> (key, value) :: xs) memory []
+ )
+
let published_goals = ref []
let publish name fn = published_goals := (name, fn) :: !published_goals
let get_goal name =
diff --git a/goaljobs.mli b/goaljobs.mli
index 43432f1..7374f54 100644
--- a/goaljobs.mli
+++ b/goaljobs.mli
@@ -265,6 +265,9 @@ val memory_get : string -> string option
val memory_delete : string -> unit
(** Delete the [key]. If the key doesn't exist, has no effect. *)
+val memory_list : unit -> (string * string) list
+ (** Return all [(key, value)] pairs in the memory. *)
+
(** {2 Publishing goals} *)
val publish : string -> (string list -> unit) -> unit
diff --git a/goaljobs_memory.ml b/goaljobs_memory.ml
new file mode 100644
index 0000000..a2cf618
--- /dev/null
+++ b/goaljobs_memory.ml
@@ -0,0 +1,58 @@
+(* goaljobs
+ * Copyright (C) 2013-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Unix
+open Printf
+
+open Goaljobs
+
+(* Stand-alone tool to read and modify the user's goaljobs memory. *)
+
+let usage ret =
+ printf " %s list\n" Sys.executable_name;
+ printf " %s [exists|get|delete] key\n" Sys.executable_name;
+ printf " %s set key value\n" Sys.executable_name;
+ printf "Subcommands:\n";
+ printf " exists - Check if key exists, exit code 0 if exists, 1 if not\n";
+ printf " get - Print the current value of the key\n";
+ printf " set - Set the key to a new value\n";
+ printf " delete - Delete the key\n";
+ printf " list - List the names and values of all keys\n";
+ exit ret
+
+let () =
+ match Array.to_list Sys.argv with
+ | [] -> usage 1
+ | [ ("--help" | "-h" | "-?") ] -> usage 0
+ | [ _; "exists"; key ] ->
+ if memory_exists key then exit 0 else exit 1
+ | [ _; "get"; key ] ->
+ (match memory_get key with
+ | None ->
+ eprintf "%s: key '%s' not found in memory\n" Sys.executable_name key;
+ exit 1
+ | Some v -> print_endline v
+ )
+ | [ _; "set"; key; value ] ->
+ memory_set key value
+ | [ _; "delete"; key ] ->
+ memory_delete key
+ | [ _; "list" ] ->
+ let mem = memory_list () in
+ List.iter (fun (key, value) -> printf "%s\t%s\n" key value) mem
+ | _ -> usage 1
--
GitLab