Skip to content
Browse files

First public source opening -> GitHub;

  • Loading branch information...
1 parent 4c22cf1 commit 6ffe62bfd19dfa1a143d4942f3721f636eef1a6a Tomas Morstein committed Jul 30, 2012
View
4 .gitignore
@@ -0,0 +1,4 @@
+log
+ebin
+deps
+.eunit
View
180 README.md
@@ -0,0 +1,180 @@
+IDEA EGTM: Erlang binding for GT.M database engine
+==================================================
+
+Software product description and documentation for application
+developers is to be found on [http://labs.idea.cz/egtm](
+http://labs.idea.cz/egtm "IDEA EGTM Technology").
+
+Installation
+------------
+* `git clone http://github.com/ztmr/egtm`
+* ensure the latest Erlang/OTP is installed
+* ensure GT.M is installed
+* change GT.M `gtm_dist` path in `priv/gtmenv` and `rebar.config`
+* `./rebar get-deps && ./rebar compile`
+* initialize database with `./priv/initdb`
+* run the console `./priv/egtm_console`
+* enjoy!
+
+Notes
+-----
+* **GT.M compatibility**
+ - EGTM is known to not work with GT.M V5.5-000 Linux x86\_64
+ because of [call-in bug](https://groups.google.com/d/topic/comp.lang.mumps/R_GvkUUZaq0/discussion "Call-in bug").
+* **performance:**
+ - per-operation lager debug logging (disabled by default)
+ means around ~2000 microseconds overhead,
+ - metrics (disabled by default) costs around
+ ~30 additional microseconds,
+ - both can be enabled using `EGTM_METRICS` and
+ `EGTM_TRACE` compile-time macros,
+ - unless `EGTM_METRICS` is defined, the `egtm_metrics`
+ configuration (in `priv/egtm.conf`) is ignored.
+* **transaction processing:**
+ - since *GT.M call-in interface does not allow us to call
+ standalone `TS`/`TC`/`TRO` commands*, we had to implement
+ TP emulation. This is done by storing all write/lock operations
+ within a virtual transaction buffer that is evaluated
+ at the time of commit.
+ - this has *some limitations*, for example:
+ <pre>
+ %% Expect the ^ZTMR to hold value of 0.
+ DataProcessing = fun () ->
+ &nbsp;&nbsp;io:put\_chars (egtm:get ("^ZTMR")),
+ &nbsp;&nbsp;egtm:set ("^ZTMR", 1), %% when in transaction, this is not done immediatelly but at the commit-time!!!
+ &nbsp;&nbsp;io:put\_chars (egtm:get ("^ZTMR")),
+ &nbsp;&nbsp;false %% Rollback!
+ end,
+ egtm\_util:transaction (DataProcessing), %% outputs 00{ok,rollback,unknown}
+ egtm\_util:transaction (DataProcessing), %% outputs 00{ok,rollback,unknown}
+ DataProcessing (), %% outputs 01false
+ DataProcessing (). %% outputs 11false
+ </pre>
+ - *operations supported by TP*:
+ `set`, `setp`, `kill`, `zkill`, `lock`, `unlock`.
+ - To get *full-featured GT.M TP*, feel free to *write your own*
+ `priv/rtns/MyRoutine.m` with any TP processing code and
+ call it using `egtm:do/2` or `egtm:call/2`.
+* **clustering and multi-site configurations:** EGTM HAC
+ is a separate and paid add-on product.
+* **consulting and support services, non-public/non-free add-ons**:
+ Support and consulting services and non-public add-ons may
+ be delivered individually under conditions specified in
+ a valid support/license contract in context of one or more
+ of these products:
+ - FIS GT.M and FIS PIP/DATA-QWIK framework,
+ - Erlang and ChicagoBoss framework,
+ - IDEA EGTM,
+ - IDEA Object Database (IODB),
+ - IDEA High-Available Cluster (EGTM HAC),
+ - IDEA CloudOS (ICOS).
+ Feel free to contact IDEA Systems via e-mail or
+ [www.idea.cz](http://www.idea.cz "IDEA Systems")
+ in any case of interest!
+
+TODO
+----
+* NIF upgrade/reload functinality -- GT.M call-ins
+ are limited to a single `gtm_init`/`gtm_exit` call
+ per each process, so we simply cannot unload GT.M
+ shared library and load its new version gracefully :-(
+* documentation: some `egtm` functions exists in more
+ overloaded variants resolved by guards and well
+ documented in source code itself.
+ The standard edoc generator works only with the first
+ match of all these variants, so the resulting HTML
+ documentation may not be complete! :-(
+* `init^%egtmapi` and error trapping
+* `egtm:lock` timeout support
+* EGTM NIF stores strings in static char array limited
+ by `EGTM$BUFLEN` constant although each string has
+ different lenght requirements on different places.
+ This should be changed in future releases!
+ Use the following:
+ - `MAXCODE = 8192`
+ (maximum length of a line of code for
+ the compiler / variable name)
+ - `MAXMSG = 2048`
+ (maximum length of a GT.M message)
+ - `MAXNAME = 32`
+ (one more than the maximum length of a GT.M name)
+ - `MAXSTR = 1048576`
+ (maximum length of a value that GT.M can return)
+* UTF-8 or Erlang-agnostic Latin-1 support without complicated
+ encoding/decoding!!
+ This is partially supported by `egtm_string` `encode`/`decode`,
+ but currenly only for VALUES in `set`/`setp` and `get`/`getp`,
+ thus NOT for: global names, subscripts, `do`/`call` arguments.
+* Counters for intercluster load distribution purposes
+ as well as for a common SNMP monitoring purposes.
+ SNMP data may be based on Folsom metrics.
+* WebAdmin (at least global browser) -- as ICOS Application?
+
+
+Architecture Schema Design
+--------------------------
+<pre>
+......................................
+: Erlang/OTP Application Server #1 :
+: :..
+: +----------------------------+ :
+: | Application that uses EGTM | :
+: +--------------+-------------+ :
+: | :
+: +------------+-----------------+ :
+: | EGTM Master Broker Server | :
+: |..............................| :
+: | does request routing logic | :
+: | based on deployment setup | (A) single standalone worker
+: | (standalone, pool, cluster) | (B) pool of local workers
+: |..............................| (C) cluster of A/B-mode servers
+: | (A)(B)(C) | :
+: +-------+--+--+----------------+ :
+: / | \ :.......
+: / | \ :
+: / / +--+--------------------+ :
+: / / | EGTM Cluster Manager | :
+: / / | with IntelliRoute | :
+: / / +----------+------------+ :
+: / / | ..............:
+: / | +---------+------------+
+: / | | .: |
+: | +--+--------+-------+ : +-------+---------------------+
+: | | EGTM Worker Pool | : | EGTM Cluster Neighbour Pool |
+: | | egtm1, egtm2, ... | : +---------+-------------------+
+: | +-----------+-------+ : |
+: | | ........: |
+: | | : |
+: | | : +---------------+-------------+
+: +--+----------+ | : | EGTM Slave Broker Server |
+: | Standalone | | : | another worker/pool/cluster |
+: | EGTM Worker | | : | SCHEMA RECURSION GOES HERE |
+: +------+------+ | : +---------------+-------------+
+: | | : |
+: +-----+--------+-+ : +--+------------+
+: | GT.M master DB |===(replication)===| GT.M slave DB |
+: +----------------+ : +---------------+
+:......................:
+</pre>
+
+
+Licensing
+=========
+Copyright (C) 2012 Tomas Morstein, IDEA Systems
+
+This program is free software: you can redistribute
+it and/or modify it under the terms of the GNU Affero
+General Public License as published by the Free Software
+Foundation, either version 3 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 Affero General
+Public License for more details.
+
+You should have received a copy of the GNU Affero
+General Public License along with this program.
+If not, see [http://www.gnu.org/licenses/](
+http://www.gnu.org/licenses/ "GNU Licensing Overview").
View
1 c_src/.gitignore
@@ -0,0 +1 @@
+*.o
View
585 c_src/egtm_worker.c
@@ -0,0 +1,585 @@
+/*
+ * Module: egtm_worker -- EGTM NIF library
+ * Created: 05-APR-2012 20:11
+ * Author: tmr
+ *
+ * Copyright 2012 Tomas Morstein, IDEA Systems.
+ *
+ * This program is free software: you can redistribute
+ * it and/or modify it under the terms of the GNU Affero
+ * General Public License as published by the Free Software
+ * Foundation, either version 3 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 Affero General
+ * Public License for more details.
+ *
+ * You should have received a copy of the GNU Affero
+ * General Public License along with this program.
+ * If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <termios.h>
+#include <stdbool.h>
+//#include <stdio.h>
+
+#include "erl_nif.h"
+#include "gtmxc_types.h"
+
+#define EGTM$BUFLEN 512
+#define EGTM$BUFLENBIG 65536
+#define EGTM$LOCKNAM "EGTM$MUTEX"
+
+#define LOCK(critical_section) { \
+ enif_mutex_lock (m_Lock); \
+ { critical_section } \
+ enif_mutex_unlock (m_Lock); \
+ }
+
+#define NIFARGS \
+ ErlNifEnv * env, int argc, const ERL_NIF_TERM argv []
+#define NIF(name) \
+ ERL_NIF_TERM (name) (NIFARGS)
+
+ERL_NIF_TERM c_AtomOK;
+ERL_NIF_TERM c_AtomError;
+
+ErlNifMutex * m_Lock;
+
+struct termios m_StderrOrig, m_StdinOrig, m_StdoutOrig;
+
+int check_status (gtm_status_t status, char msg []) {
+
+ if (status != 0) {
+ gtm_zstatus (msg, EGTM$BUFLEN);
+
+ return -10;
+ }
+
+ return 0;
+}
+
+static int load_internal (ErlNifEnv * env, void ** priv, void ** old_priv, ERL_NIF_TERM load_info, bool upgrade) {
+
+ c_AtomOK = enif_make_atom (env, "ok");
+ c_AtomError = enif_make_atom (env, "error");
+ m_Lock = enif_mutex_create (EGTM$LOCKNAM);
+
+ // XXX: not so correct in the case of upgrade!!
+ tcgetattr (0, &m_StdinOrig);
+ tcgetattr (1, &m_StdoutOrig);
+ tcgetattr (2, &m_StderrOrig);
+
+ /*
+ * priv = malloc (sizeof (int));
+ if (old_priv == NULL)
+ ** (int **) priv = 0;
+ else
+ ** (int **) priv = (** (int **) old_priv) +1;
+ fprintf (stderr, "PRIV=%d\n", (int) ** (int **) priv);
+ */
+
+ if (!upgrade) {
+ char emsg [EGTM$BUFLEN];
+ gtm_status_t status;
+
+ status = gtm_init ();
+ check_status (status, emsg); // XXX: check status
+
+ // XXX: do we want it to call only on init or also on upgrade?
+ status = gtm_ci ("m_init");
+ check_status (status, emsg); // XXX: check status
+ }
+
+ return 0;
+}
+
+static int load (ErlNifEnv * env, void ** priv, ERL_NIF_TERM load_info) {
+
+ //fprintf (stderr, "LOAD\n");
+ return load_internal (env, priv, NULL, load_info, false);
+}
+
+/*
+static int upgrade (ErlNifEnv * env, void ** priv, void ** old_priv, ERL_NIF_TERM load_info) {
+
+ //fprintf (stderr, "UPGRADE\n");
+ return load_internal (env, priv, old_priv, load_info, true);
+}
+
+static int reload (ErlNifEnv * env, void ** priv, ERL_NIF_TERM load_info) {
+
+ //fprintf (stderr, "RELOAD\n");
+ return 0;
+}
+*/
+
+static void unload (ErlNifEnv * env, void * priv) {
+
+ //fprintf (stderr, "UNLOAD=%d\n", * (int *) priv);
+
+ enif_mutex_destroy (m_Lock);
+ gtm_status_t status = gtm_exit ();
+
+ // XXX: check status
+ char emsg [EGTM$BUFLEN];
+ check_status (status, emsg);
+
+ tcsetattr (0, 0, &m_StdinOrig);
+ tcsetattr (1, 0, &m_StdoutOrig);
+ tcsetattr (2, 0, &m_StderrOrig);
+}
+
+NIF (m_horo) {
+
+ char val [64]; gtm_status_t status;
+ LOCK(status = gtm_ci ("m_horo", val);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, val, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_job) {
+
+ char val [64]; gtm_status_t status;
+ LOCK(status = gtm_ci ("m_job", val);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, val, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_zver) {
+
+ char val [128];
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_zver", val);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, val, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_get) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char val [EGTM$BUFLENBIG];
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_get", val, key);)
+
+ char emsg [EGTM$BUFLENBIG];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, val, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_getp) {
+
+ if (argc != 3) return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ int piece;
+ if (enif_get_int (env, argv [1], &piece) < 0)
+ return enif_make_badarg (env);
+
+ char delim [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [2], delim, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char val [EGTM$BUFLENBIG];
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_getp", val, key, piece, delim);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, val, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_set) {
+
+ if (argc != 2) return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char val [EGTM$BUFLENBIG];
+ if (enif_get_string (env, argv [1], val, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_set", key, val);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_setp) {
+
+ if (argc != 4) return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], key, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ int piece;
+ if (enif_get_int (env, argv [1], &piece) < 0)
+ return enif_make_badarg (env);
+
+ char delim [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [2], delim, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char val [EGTM$BUFLENBIG];
+ if (enif_get_string (env, argv [3], val, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_setp", key, piece, delim, val);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_order) {
+
+ if (argc != 2) return enif_make_badarg (env);
+
+ char gbl [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gbl, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ int dir;
+ if (enif_get_int (env, argv [1], &dir) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_order", key, gbl, dir);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, key, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_fast_order) {
+
+ if (argc != 2) return enif_make_badarg (env);
+
+ char gbl [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gbl, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ int dir;
+ if (enif_get_int (env, argv [1], &dir) < 0)
+ return enif_make_badarg (env);
+
+ char key [EGTM$BUFLEN];
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_fast_order", key, gbl, dir);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, key, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_kill) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char gvn [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_kill", gvn);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_zkill) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char gvn [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_zkill", gvn);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_do) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char cmd [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], cmd, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_do", cmd);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_call) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char cmd [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], cmd, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ char res [EGTM$BUFLENBIG]; res[0]='\0';
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_call", res, cmd);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_string (env, res, ERL_NIF_LATIN1));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_merge) {
+
+ if (argc != 2) return enif_make_badarg (env);
+
+ char gvn1 [EGTM$BUFLEN]; char gvn2 [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn1, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+ if (enif_get_string (env, argv [1], gvn2, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_merge", gvn1, gvn2);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_xecute) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char cmd [EGTM$BUFLENBIG];
+ if (enif_get_string (env, argv [0], cmd, EGTM$BUFLENBIG, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_xecute", cmd);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_tstart) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char opts [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], opts, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_tstart", opts);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_tcommit) {
+
+ if (argc != 0) return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_tcommit");)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_trollback) {
+
+ if (argc != 0) return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_trollback");)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_lock) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char gvn [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_lock", gvn);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_unlock) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char gvn [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ gtm_status_t status;
+ LOCK(status = gtm_ci ("m_unlock", gvn);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return c_AtomOK;
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+NIF (m_data) {
+
+ if (argc != 1) return enif_make_badarg (env);
+
+ char gvn [EGTM$BUFLEN];
+ if (enif_get_string (env, argv [0], gvn, EGTM$BUFLEN, ERL_NIF_LATIN1) < 0)
+ return enif_make_badarg (env);
+
+ int ret; gtm_status_t status;
+ LOCK(status = gtm_ci ("m_data", &ret, gvn);)
+
+ char emsg [EGTM$BUFLEN];
+ if (check_status (status, emsg) == 0)
+ return enif_make_tuple2 (env, c_AtomOK,
+ enif_make_int (env, ret));
+ else
+ return enif_make_tuple2 (env, c_AtomError,
+ enif_make_string (env, emsg, ERL_NIF_LATIN1));
+}
+
+static ErlNifFunc nif_funcs [] = {
+ {"m_set", 2, m_set},
+ {"m_setp", 4, m_setp},
+ {"m_get", 1, m_get},
+ {"m_getp", 3, m_getp},
+ {"m_order", 2, m_order},
+ {"m_fast_order", 2, m_fast_order},
+ {"m_kill", 1, m_kill},
+ {"m_zkill", 1, m_zkill},
+ {"m_do", 1, m_do},
+ {"m_call", 1, m_call},
+ {"m_merge", 2, m_merge},
+ {"m_xecute", 1, m_xecute},
+ {"m_tstart", 1, m_tstart},
+ {"m_tcommit", 0, m_tcommit},
+ {"m_trollback", 0, m_trollback},
+ {"m_lock", 1, m_lock},
+ {"m_unlock", 1, m_unlock},
+ {"m_data", 1, m_data},
+ {"m_horo", 0, m_horo},
+ {"m_zver", 0, m_zver},
+ {"m_job", 0, m_job}
+};
+
+//ERL_NIF_INIT (egtm_worker, nif_funcs, &load, &reload, &upgrade, &unload);
+ERL_NIF_INIT (egtm_worker, nif_funcs, &load, NULL, NULL, &unload);
+
+// vim: fdm=syntax:fdn=1:tw=74:ts=2:syn=c
View
66 c_src/gtmxc_types.h
@@ -0,0 +1,66 @@
+/****************************************************************
+ * *
+ * Copyright 2001, 2007 Fidelity Information Services, Inc *
+ * *
+ * This source code contains the intellectual property *
+ * of its copyright holder(s), and is made available *
+ * under a license. If you do not know the terms of *
+ * the license, please stop and do not read further. *
+ * *
+ ****************************************************************/
+
+/* gtmxc_types.h - GT.M, Unix Edition External Call type definitions. */
+
+#ifdef __osf__
+/* Ensure 32-bit pointers for compatibility with GT.M internal representations. */
+#pragma pointer_size (save)
+#pragma pointer_size (short)
+#endif
+
+typedef int xc_status_t;
+typedef int xc_int_t;
+typedef unsigned int xc_uint_t;
+
+#if defined(__osf__)
+typedef int xc_long_t;
+typedef unsigned int xc_ulong_t;
+#else
+typedef long xc_long_t;
+typedef unsigned long xc_ulong_t;
+#endif
+
+typedef float xc_float_t;
+
+typedef double xc_double_t;
+
+typedef char xc_char_t;
+
+typedef int (*xc_pointertofunc_t)();
+
+typedef struct
+{
+ xc_long_t length;
+ xc_char_t *address;
+} xc_string_t;
+
+#ifdef __osf__
+#pragma pointer_size (restore)
+#endif
+
+/* new types for external/call-in user - xc_* types still valid for backward compatibility */
+typedef xc_status_t gtm_status_t;
+typedef xc_int_t gtm_int_t;
+typedef xc_uint_t gtm_uint_t;
+typedef xc_long_t gtm_long_t;
+typedef xc_ulong_t gtm_ulong_t;
+typedef xc_float_t gtm_float_t;
+typedef xc_double_t gtm_double_t;
+typedef xc_char_t gtm_char_t;
+typedef xc_string_t gtm_string_t;
+typedef xc_pointertofunc_t gtm_pointertofunc_t;
+
+/* call-in interface */
+xc_status_t gtm_ci(const char *c_rtn_name, ...);
+xc_status_t gtm_init(void);
+xc_status_t gtm_exit(void);
+void gtm_zstatus(char* msg, int len);
View
4 doc/.gitignore
@@ -0,0 +1,4 @@
+*.html
+*.css
+*.png
+edoc-info
View
BIN doc/ERL_logo.jpg
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN doc/GTM_logo.jpg
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN doc/IDEA_logo.jpg
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
50 doc/overview.edoc
@@ -0,0 +1,50 @@
+<?xml version="1.0" encoding="utf-8"?>
+
+@author Tomas Morstein <tmr&idea.cz>
+@copyright 2012 Tomas Morstein, IDEA Systems.
+
+@title EGTM: Erlang binding for GT.M high-end database
+
+@doc EGTM is a glue for two amazing technologies: Erlang and MUMPS.
+Erlang is known for its great high-availability and high-concurrency
+properties while MUMPS is known as superfast, schema-less and
+space-efficient data processing platform.
+
+
+<div>
+ <hr />
+ Technology websites powered by IDEA:
+ <table width="100%">
+ <tr>
+ <td>
+ <ul>
+ <li><a href="http://www.idea.cz">IDEA Systems</a></li>
+ <li><a href="http://www.mumps.cz">MUMPS.cz</a></li>
+ <li><a href="http://www.openvms.cz">OpenVMS.cz</a></li>
+ </ul>
+ </td>
+ <td width="50%"><span /></td>
+ <td><a href="http://fis-gtm.com"><img src="GTM_logo.jpg" /></a></td>
+ <td><a href="http://www.idea.cz"><img src="IDEA_logo.jpg" /></a></td>
+ <td><a href="http://www.erlang.org"><img src="ERL_logo.jpg" /></a></td>
+ </tr>
+ </table>
+</div>
+
+<div>
+<hr />
+<p>This program is free software: you can redistribute
+it and/or modify it under the terms of the GNU Affero
+General Public License as published by the Free Software
+Foundation, either version 3 of the License,
+or (at your option) any later version.</p>
+<p>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 Affero General
+Public License for more details.</p>
+<p>You should have received a copy of the GNU Affero
+General Public License along with this program.
+If not, see <a href="http://www.gnu.org/licenses/">
+http://www.gnu.org/licenses/</a>.</p>
+</div>
View
1 ebin/.gitignore
@@ -0,0 +1 @@
+*.beam
View
81 include/egtm.hrl
@@ -0,0 +1,81 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm -- description
+%% Created: 08-MAY-2012 17:14
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+-ifndef (EGTM_HRL).
+-define (EGTM_HRL, true).
+
+-type order_direction () :: forward | backward. %% $Order direction.
+-type global_name () :: string (). %% MUMPS Global Variable Name.
+-type subscripts () :: list (). %% MUMPS Subscript Index Path.
+-type tp_options () :: string (). %% MUMPS transaction processing options.
+-type program_name () :: string (). %% MUMPS entryref `Label^MyRoutine'
+
+-ifndef (EGTM_APPNAME).
+-define (EGTM_APPNAME, egtm).
+-endif.
+
+-ifndef (EGTM_NULLKEY).
+-define (EGTM_NULLKEY, "#null").
+-endif.
+
+-ifndef (EGTM_LONGSTRING_BLOCKSIZE).
+-define (EGTM_LONGSTRING_BLOCKSIZE, 4000).
+-endif.
+
+-define (str (V), egtm_util:stringify (V)).
+
+-ifdef (EGTM_TRACE).
+-define (trace (Name), ?trace (Name, [])).
+-define (trace (Name, Args),
+ lager:debug ("EGTM CallTrace: ~s:~s ~s",
+ [?MODULE, ?str (Name), ?str (Args)])).
+-define (trace_code (Code), Code).
+-else.
+-define (trace (Name), ok).
+-define (trace (Name, Args), ok).
+-define (trace_code (Code), ok).
+-endif.
+
+-define (report_error (Error),
+ lager:error ("EGTM Common Error: ~s: ~s",
+ [?MODULE, ?str (Error)])).
+
+-define (report_warning (Warn),
+ lager:warning ("EGTM Common Warning: ~s: ~s",
+ [?MODULE, ?str (Warn)])).
+
+-define (report_info (Info), ?report_info (Info, [])).
+-define (report_info (Info, Args),
+ lager:info (Info, Args)).
+
+-ifdef (EGTM_METRICS).
+-define (metrics (Name, Fun), .?metrics (Name, Fun)).
+-else.
+-define (metrics (Name, Fun), Fun ()).
+-endif.
+
+-endif. % EGTM_HRL
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
1 priv/.gitignore
@@ -0,0 +1 @@
+*.so
View
22 priv/calltab.ci
@@ -0,0 +1,22 @@
+m_init :void init^%egtmapi()
+m_set :void set^%egtmapi(I:gtm_char_t*,I:gtm_char_t*)
+m_setp :void setp^%egtmapi(I:gtm_char_t*,I:gtm_int_t,I:gtm_char_t*,I:gtm_char_t*)
+m_get :gtm_char_t* get^%egtmapi(I:gtm_char_t*)
+m_getp :gtm_char_t* getp^%egtmapi(I:gtm_char_t*,I:gtm_int_t,I:gtm_char_t*)
+m_order :gtm_char_t* order^%egtmapi(I:gtm_char_t*,I:gtm_int_t)
+m_fast_order:gtm_char_t* fastOrder^%egtmapi(I:gtm_char_t*,I:gtm_int_t)
+m_kill :gtm_char_t* kill^%egtmapi(I:gtm_char_t*)
+m_zkill :gtm_char_t* zkill^%egtmapi(I:gtm_char_t*)
+m_do :void do^%egtmapi(I:gtm_char_t*)
+m_call :gtm_char_t* call^%egtmapi(I:gtm_char_t*)
+m_merge :void merge^%egtmapi(I:gtm_char_t*,I:gtm_char_t*)
+m_tstart :void tstart^%egtmapi(I:gtm_char_t*)
+m_tcommit :void tcommit^%egtmapi()
+m_trollback :void trollback^%egtmapi()
+m_lock :void lock^%egtmapi(I:gtm_char_t*)
+m_unlock :void unlock^%egtmapi(I:gtm_char_t*)
+m_data :gtm_int_t* data^%egtmapi(I:gtm_char_t*)
+m_xecute :void xecute^%egtmapi(I:gtm_char_t*)
+m_horo :gtm_char_t* horo^%egtmapi()
+m_zver :gtm_char_t* zver^%egtmapi()
+m_job :gtm_char_t* job^%egtmapi()
View
6 priv/dm
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/mumps -di
+
View
6 priv/dse
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/dse $@
+
View
44 priv/egtm.conf
@@ -0,0 +1,44 @@
+%% --------------------------------------------
+%% *** EGTM Configuration ***
+%% --------------------------------------------
+
+%% egtm core setup
+{egtm, [
+
+ %% Defaults
+ {defaults, [
+
+ %% $Piece default delimiter
+ {piece_delim, "|"}
+ ]},
+
+ %% Mode of operation
+ %% single (= use NIF directly),
+ %% pool (= use multiple slave ErlVMs)
+ %% NOTE: pooling is 10times slower than 'single'
+ %% and is also disabled by default. To enable it,
+ %% you need to define EGTM_POOL_ENABLED macro
+ {mode, single},
+
+ %% Workers are slave ErlVMs with GT.M call-in NIF
+ {workers, [
+
+ %% Slave nodes to be autostarted
+ {nodes, [egtm1, egtm2, egtm3, egtm4]}
+ ]},
+
+ %% Functions that are for some (security) reason denied
+ %{deny, [kill, do, call, merge, xecute]}
+ {deny, []}
+ %,
+ %% String encoder/decoder functions
+ %{string_conversion, [
+ % {encode, {egtm_string, erl2utf} },
+ % {decode, {egtm_string, utf2erl} } ]}
+]}.
+
+%% egtm metrics: histograms and counters
+%% NOTE: if enabled, all egtm-core operations are slower!
+{egtm_metrics, [{enabled, false}]}.
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
4 priv/egtm_console
@@ -0,0 +1,4 @@
+#!/bin/sh
+
+erl -pa ebin -pa deps/*/ebin -pa test -pa test/* -sname egtm_console $@
+
View
4 priv/egtm_console_gdb
@@ -0,0 +1,4 @@
+#!/bin/sh
+
+gdberl -pa ebin -pa deps/*/ebin -pa test -pa test/* -sname egtm_console $@
+
View
2 priv/gbls/.gitignore
@@ -0,0 +1,2 @@
+*.gld
+*.dat
View
6 priv/gde
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/mumps -r ^GDE
+
View
12 priv/gtmenv
@@ -0,0 +1,12 @@
+#!/bin/sh
+
+if [ ! -d "${EGTM_PRIV}" ] ; then
+ SWD=`dirname $0` ; CWD=`pwd`
+ cd ${SWD} ; SWD=`pwd` ; cd ${CWD}
+ EGTM_PRIV=${SWD}
+fi
+
+export gtm_dist=/usr/lib/fis-gtm/V54002Bx64
+export gtmroutines="$gtm_dist ${EGTM_PRIV}/rtns ."
+export gtmgbldir="${EGTM_PRIV}/gbls/egtm.gld"
+
View
41 priv/initdb
@@ -0,0 +1,41 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+DIR=`pwd` ; PRIV=`dirname $0` ; cd $PRIV ; PRIV=`pwd` ; cd $DIR
+
+egtm_db=$PRIV/gbls/egtm.dat
+egtmbig_db=$PRIV/gbls/egtmbig.dat
+
+if [ -f ${egtm_db} ] ; then
+ #echo "Database already exists!"
+ #echo "*** NOT INITIALIZING IT ***"
+ exit 0
+fi
+
+$gtm_dist/mumps -r ^GDE << EOF
+D-R DEFAULT
+D-S DEFAULT
+T-S -Bloc=4096
+T-S -Lock=40
+T-S -Glob=4096
+T-S -Alloc=1000
+T-S -Ext=3000
+T-R -Rec=4080
+T-R -Key=255
+T-R -N=AL
+T-R -J=BE
+A-S EGTM -F="$egtm_db"
+A-S EGTMBIG -BLOCK=32256 -F="$egtmbig_db"
+A-R EGTM -D=EGTM
+A-R EGTMBIG -REC=32240 -D=EGTMBIG
+LOC -R=EGTM
+C-N * -R=EGTM
+A-N Big* -R=EGTMBIG
+SH -A
+V -A
+E
+EOF
+
+$gtm_dist/mupip create
+
View
6 priv/lke
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/lke $@
+
View
6 priv/mupip
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/mupip $@
+
View
1 priv/rtns/.gitignore
@@ -0,0 +1 @@
+*.o
View
91 priv/rtns/_egtmapi.m
@@ -0,0 +1,91 @@
+; GT.M call-in API for Erlang NIF library
+; XXX: temporary --> convert indirection to Xecutes
+; XXX: (because of speed and also to make TP emulation easier)
+
+init q ;s $zt="n tmp s e=$ecode s tmp=$p($ecode,"","",2) q:$q $e(tmp,2,$l(tmp)) q" q
+set(k,v) d txsubmitcmd("s @k=$g(v)","k,v") q
+setp(k,d,p,v) d txsubmitcmd("s $p(@k,p,d)=$g(v)","k,d,p,v") q
+get(k) q $g(@$g(k))
+getp(k,d,p) q $p($g(@$g(k)),p,d)
+order(k,d) q $o(@k,d)
+kill(k) d txsubmitcmd("k @k","k") q
+zkill(k) d txsubmitcmd("zkill @k","k") q
+do(c) d @c q
+call(c) n x x "s x=$$"_c q $g(x)
+merge(k1,k2) d txsubmitcmd("m @k1=@k2","k1,k2") q
+tstart(v) d txstart() q ; XXX: TP Arguments?
+tcommit d txcommit() q
+trollback d txrollback() q
+lock(k) d txsubmitcmd("l +@k","k") q ; XXX: Lock timeout?
+;lock(k,t) s t=+$g(t)
+; i t>-1 l +@k:t q $T
+; e l +@k q $T
+unlock(k) d txsubmitcmd("l -@k","k") q
+data(k) q $d(@k)
+xecute(x) x x q
+
+horo() q $h
+zver() q $zver
+job() q $j
+
+; TP emulation internals
+txtest(k,d,p,w) d txsubmitcmd("w k,d,p,w,!") q
+txsubmitcmd(cmd,pars)
+ i $G(%EGTMTP) d
+ . n cmdid,i,var s cmdid=$O(%EGTMTP($G(%EGTMTP),""),-1)+1
+ . f i=1:1:10 s var=$P(pars,",",i) q:var="" d
+ . . s %EGTMTP(%EGTMTP,cmdid,var)=@var
+ . s %EGTMTP(%EGTMTP,cmdid)=cmd_";;;"_pars
+ e x cmd
+ q
+txstart() s %EGTMTP=$G(%EGTMTP)+1 q
+txrollback() d txclear($G(%EGTMTP)) q
+txcommit()
+ tstart n i,j,id,cmd,pars s id=$G(%EGTMTP)
+ s i="" f s i=$O(%EGTMTP(id,i)) q:i="" d
+ . s cmd=$P($G(%EGTMTP(id,i)),";;;")
+ . s pars=$P($G(%EGTMTP(id,i)),";;;",2) n @pars
+ . s j="" f s j=$O(%EGTMTP(id,i,j)) q:j="" d
+ . . s @j=%EGTMTP(id,i,j)
+ . x cmd
+ tcommit d txclear(id) q
+txclear(id) k %EGTMTP(id) s %EGTMTP=$G(%EGTMTP)-1 q
+
+; Test labels for `call' and `do'
+testIntrinsic(a,b) q +$g(a)+$g(b) ; to be called by `call'
+testExtrinsic(a,b) s ^ZTMR=+$g(a)+$g(b) q ; to be called by `do'
+testBlocking(n)
+ n i f i=0:1:n s ^ZTMR(i)="abc"
+ q
+
+testPerformance(n)
+ k ^%EUnit("perf","m") n t1 s t1=$h
+ n i f i=0:1:n d
+ . s ^%EUnit("perf","m",i)=$tr($r(123456789),"1234567890","ABCDEFGHIJ")
+ f i=0:1:n d
+ . n rnd s rnd=$r(123456789)
+ . n j s j="" f s j=$o(^%EUnit("perf","m",j)) q:j="" d:j=rnd
+ . . s rnd=$increment(^%EUnit("perf","m",j,"upd"))
+ n t2 s t2=$h
+ q (+t2-t1)_","_($p(t2,",",2)-$p(t1,",",2))
+
+testPerfOrder1() ; native order (fast)
+ n i,r s (i,r)="" f s i=$o(^%EUnit("perf","e",i)) q:i="" d
+ . s r=r+$g(^%EUnit("perf","e",i))
+ q r
+testPerfOrder2() ; using indirection-based order (slow)
+ n i,r s (i,r)="" f s i=$$order^%egtmapi("^%EUnit(""perf"",""e"","""_i_""")",1) q:i="" d
+ . s r=r+$g(^%EUnit("perf","e",i))
+ q r
+testPerfOrder3() ; using xecute-based order (fast)
+ n i,r s (i,r)="" f s i=$$fastOrder^%egtmapi("^%EUnit(""perf"",""e"","""_i_""")",1) q:i="" d
+ . s r=r+$g(^%EUnit("perf","e",i))
+ q r
+
+testPerfPrepare()
+ n i f i=0:1:10000 s ^%EUnit("perf","e",i)=$r(1234567890)
+ q
+
+fastOrder(name,direction) n x x "s x=$order("_name_",direction)" q x
+
+; vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=mumps
View
6 priv/run
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+. `dirname $0`/gtmenv
+
+$gtm_dist/mumps -r $@
+
View
BIN rebar
Binary file not shown.
View
29 rebar.config
@@ -0,0 +1,29 @@
+{port_sources, ["c_src/*.c"]}.
+{so_name, "egtm_worker.so"}.
+
+{cover_enabled, false}.
+{eunit_opts, [verbose]}.
+
+{erl_opts, [
+
+ %% Important for BEAM reconstruction!!!
+ debug_info,
+
+ %% Lager pre-compile transformation
+ {parse_transform, lager_transform}
+]}.
+
+{deps, [
+ %% Lager must be first because of Erlang form transformations
+ {lager, ".*", {git, "https://github.com/basho/lager.git", "master"}},
+ {deepprops, ".*", {git, "https://github.com/keynslug/deepprops.git", "master"}},
+ {folsom, ".*", {git, "https://github.com/boundary/folsom.git", "master"}}
+]}.
+
+{port_envs, [
+ %% GT.M flags
+ {".*", "gtm_dist", "/usr/lib/fis-gtm/V54002Bx64"},
+ {".*", "LDFLAGS", "$LDFLAGS -I$gtm_dist -L$gtm_dist -Wl,-rpath -Wl,$gtm_dist -lgtmshr -lc"}
+]}.
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
28 src/egtm.app.src
@@ -0,0 +1,28 @@
+%%
+%% @copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+{application, egtm, [
+ {description, "IDEA EGTM: Erlang GT.M binding"},
+ {vsn, "0.2.1"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel, stdlib]},
+ {env, []},
+ {mod, {egtm, []}}
+]}.
View
574 src/egtm.erl
@@ -0,0 +1,574 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm -- description
+%% Created: 05-APR-2012 20:11
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+%% @doc Erlang binding for GT.M database
+%%
+%% Example of usage:
+%% ```
+%% erl> egtm:start ().
+%% ok
+%% erl> egtm:zversion().
+%% "GT.M V5.4-002B Linux x86_64"
+%% erl> egtm:job().
+%% "13757"
+%% erl> egtm:get ("^ZTMR").
+%% []
+%% erl> egtm:set ("^ZTMR", [1,2,3], egtm:zversion ()).
+%% ok
+%% erl>
+%% egtm:get ("^ZTMR").
+%% []
+%% erl> egtm:get ("^ZTMR", [1,2,3]).
+%% "GT.M V5.4-002B Linux x86_64"
+%% erl> Rand = fun (N) -> random:uniform (N) end.
+%% #Fun<erl_eval.6.111823515>
+%% erl> egtm:set ("^ZTMR", [Rand (10), Rand (10)], Rand (10000)).
+%% ok
+%% erl> egtm:set ("^ZTMR", [Rand (10), Rand (10)], Rand (10000)).
+%% ok
+%% erl> egtm:set ("^ZTMR", [Rand (10), Rand (10)], Rand (10000)).
+%% ok
+%% erl> egtm:set ("^ZTMR", [Rand (10), Rand (10)], Rand (10000)).
+%% ok
+%% erl> egtm:set ("^ZTMR", [Rand (10), Rand (10)], Rand (10000)).
+%% ok
+%% erl> egtm_util:foreach ("^ZTMR", [],
+%% fun (G, S, R) -> egtm_util:foreach (G, S), [] end).
+%% ^ZTMR["1","2"]=[]
+%% ^ZTMR["2","3"]="6972"
+%% ^ZTMR["2","6"]="2150"
+%% ^ZTMR["4","6"]="9157"
+%% ^ZTMR["7","5"]="5966"
+%% ^ZTMR["8","10"]="5015"
+%% {ok,[]}
+%% erl> egtm:order ("^ZTMR", ["2", ""], backward).
+%% ["2","6"]
+%% erl> egtm:order ("^ZTMR", ["2", ""], forward).
+%% ["2","3"]
+%% erl> egtm:stop ().
+%% ok
+%% erl>
+%% '''
+-module (egtm).
+-behaviour (application).
+
+-export ([start/0, start/2, stop/0, stop/1, perform/2]).
+-export ([
+ set/3, set/2,
+ setp/5, setp/4, setp/3, setp/2,
+ get/2, get/1,
+ getp/4, getp/3, getp/2, getp/1,
+ gorder/0, gorder/1, order/0, order/1, order/2, order/3,
+ kill/1, kill/2, zkill/1, zkill/2,
+ do/1, do/2, call/1, call/2, merge/4, merge/2,
+ tstart/0, tstart/1, tcommit/0, trollback/0,
+ lock/1, lock/2, unlock/1, unlock/2,
+ data/1, data/2, xecute/1,
+ zversion/0, horolog/0, job/0]).
+-export ([fast_order/2, call_fast_order/2, xecute_fast_order/2]).
+%-compile (export_all).
+
+-include_lib ("egtm.hrl").
+
+%% --- Public API ---------
+%% @doc application:start callback, do not use directly!
+start (_Type, _Args) ->
+ lager:start (),
+ ?report_info ("Starting up ~p on node ~p...", [?MODULE, node ()]),
+ egtm_admin:initdb (),
+ case operation_mode () of
+ worker -> egtm_worker_sup:start_link ();
+ manager -> egtm_pool_sup:start_link ()
+ end.
+
+%% @doc Start EGTM application.
+start () -> application:start (?MODULE).
+
+%% @doc application:stop callback, do not use directly!
+stop (_State) ->
+ ?report_info ("Shutting down ~p on node ~p...", [?MODULE, node ()]),
+ case operation_mode () of
+ worker -> egtm_worker:terminate (stop, []);
+ manager -> egtm_pool:terminate (stop, [])
+ end,
+ ok.
+
+%% @doc Stop EGTM application.
+stop () -> application:stop (?MODULE).
+
+%% @equiv get (Gvn, [])
+get (Gvn) -> get (Gvn, []).
+
+%% @doc Get value of specified node (MUMPS: `$Get(@Gvn@(Subs))').
+-spec get (Gvn::global_name (), Subs::subscripts ()) -> string ().
+get (Gvn, Subs) when is_list (Subs) ->
+ ?trace ("get", [Gvn, Subs]),
+ egtm_string:decode (perform (get, [format_gvn (Gvn, Subs)])).
+
+%% @doc Get value of specific position in specified node
+%% value delimited by specified delimiter
+%% (MUMPS: `$Piece($Get(@Gvn@(Subs)),Delim,Piece)').
+-spec getp (Gvn::global_name (), Subs::subscripts (),
+ Piece::integer (), Delim::string ()) -> string ().
+getp (Gvn, Subs, Piece, Delim) when is_number (Piece) ->
+ ?trace ("getp", [Gvn, Subs, Piece, Delim]),
+ egtm_string:decode (perform (getp,
+ [format_gvn (Gvn, Subs), Piece, Delim])).
+
+%% @equiv getp (Gvn, Subs, Piece, Delim)
+getp (Gvn, Piece, Delim) when is_number (Piece) ->
+ getp (Gvn, [], Piece, Delim);
+getp (Gvn, Subs, Piece) ->
+ getp (Gvn, Subs, Piece,
+ egtm_config:param ([egtm,defaults,piece_delim])).
+
+%% @equiv getp (Gvn, Subs, Piece, Delim)
+getp (Gvn, Piece) when is_number (Piece) ->
+ getp (Gvn, [], Piece);
+getp (Gvn, Subs) when is_list (Subs) ->
+ getp (Gvn, Subs, 1).
+
+%% @equiv getp (Gvn, Subs, Piece, Delim)
+getp (Gvn) -> getp (Gvn, []).
+
+%% @equiv set (Gvn, Subs, Val)
+set (Gvn, Val) -> set (Gvn, [], Val).
+
+%% @doc Set value of specified node (MUMPS `Set @Gvn@(Subs)=Val').
+-spec set (Gvn::global_name (), Subs::subscripts (),
+ Val::string ()) -> ok.
+set (Gvn, Subs, Val) ->
+ ?trace ("set", [Gvn, Subs, Val]),
+ perform (set, [format_gvn (Gvn, Subs),
+ format_val (egtm_string:encode (Val))]).
+
+%% @doc Set value of specific position in specified node
+%% value delimited by specified delimiter
+%% (MUMPS: `Set $Piece($Get(@Gvn@(Subs)),Piece,Delim)=Val').
+-spec setp (Gvn::global_name (), Subs::subscripts (),
+ Piece::integer (), Delim::string (),
+ Val::string ()) -> ok.
+setp (Gvn, Subs, Piece, Delim, Val) when is_number (Piece) ->
+ ?trace ("setp", [Gvn, Subs, Piece, Delim, Val]),
+ perform (setp, [format_gvn (Gvn, Subs), Piece, Delim,
+ format_val (egtm_string:encode (Val))]).
+
+%% @equiv setp (Gvn, Subs, Piece, Delim, Val)
+setp (Gvn, Piece, Delim, Val) when is_number (Piece) ->
+ setp (Gvn, [], Piece, Delim, Val);
+setp (Gvn, Subs, Piece, Val) ->
+ setp (Gvn, Subs, Piece,
+ egtm_config:param ([egtm,defaults,piece_delim]), Val).
+
+%% @equiv setp (Gvn, Subs, Piece, Delim, Val)
+setp (Gvn, Piece, Val) when is_number (Piece) ->
+ setp (Gvn, [], Piece, Val);
+setp (Gvn, Subs, Val) when is_list (Subs) ->
+ setp (Gvn, Subs, 1, Val).
+
+%% @equiv setp (Gvn, Subs, Piece, Delim, Val)
+setp (Gvn, Val) ->
+ setp (Gvn, [], Val).
+
+%% @equiv gorder ([])
+gorder () -> gorder ([]).
+
+%% @doc A special case of `egtm:order ()' where
+%% we want order not only over subscripts, but
+%% over global names.
+%%
+%% If no `Gvn' specified, "^%" is used as it
+%% is the first possible name of any global name.
+%%
+%% Since the use of `gorder' is limited only
+%% to few cases, we support only `forward'
+%% direction.
+gorder ([]) -> gorder ("^%");
+gorder (Gvn) ->
+ ?trace ("gorder", [Gvn]),
+ case perform (order, [Gvn, 1]) of
+ {error, X} -> {error, X};
+ Res -> Res
+ end.
+
+%% @equiv gorder ()
+order () -> gorder ().
+
+%% @equiv gorder (Gvn)
+order (Gvn) -> gorder (Gvn).
+
+%% @equiv order (Gvn, Subs, forward)
+order (Gvn, Subs) -> order (Gvn, Subs, forward).
+
+%% @doc Obtain next/previous key from global name `Gvn'
+%% and subscript index `Subs' with respect to `Direction'
+%% (MUMPS: `$Order(@Gvn@(Subs),Direction)').
+%%
+%% Returns a next (full) subscript to use, example:
+%% <ul>
+%% <li>let's have global like `^X(0,1)="A",^X(0,2)="B",^X(0,3)="C"'</li>
+%% <li>`egtm:order ("^X", [0, ""]) = [0,1]'</li>
+%% <li>`egtm:order ("^X", [0, 1]) = [0,2]'</li>
+%% <li>`egtm:order ("^X", [0, 2]) = [0,3]'</li>
+%% <li>`egtm:order ("^X", [0, 3]) = [0,""]'</li>
+%% </ul>
+%%
+%% Note that empty `Subs' list is treated XXX
+-spec order (Gvn::global_name (),
+ Subs::subscripts (),
+ Dir::order_direction ()) -> subscripts ().
+order (Gvn, [], Direction) -> order (Gvn, [""], Direction);
+order (Gvn, Subs, Direction) when is_list (Subs) ->
+ ?trace ("order", [Gvn, Subs, Direction]),
+ D = case Direction of
+ backward -> -1;
+ _ -> 1
+ end,
+ case perform (order, [format_gvn (Gvn, Subs, true), D]) of
+ {error, X} -> {error, X};
+ Res -> [_|SubsH] = lists:reverse (Subs),
+ lists:reverse ([Res|SubsH])
+ end.
+
+%% @equiv kill (Gvn, [])
+kill (Gvn) -> kill (Gvn, []).
+
+%% @doc Kill specified node including all its
+%% parents (MUMPS: `Kill @Gvn@(Subs)').
+-spec kill (Gvn::global_name (), Subs::subscripts ()) -> ok.
+kill (Gvn, Subs) ->
+ ?trace ("kill", [Gvn, Subs]),
+ perform (kill, [format_gvn (Gvn, Subs)]).
+
+%% @equiv zkill (Gvn, [])
+zkill (Gvn) -> zkill (Gvn, []).
+
+%% @doc ZKILL/ZWITHDRAW operation kills only specified
+%% node without affecting any of subnodes
+%% (MUMPS: `ZKill @Gvn@(Subs)').
+-spec zkill (Gvn::global_name (), Subs::subscripts ()) -> ok.
+zkill (Gvn, Subs) ->
+ ?trace ("zkill", [Gvn, Subs]),
+ perform (zkill, [format_gvn (Gvn, Subs)]).
+
+%% @equiv do (Gvn, [])
+do (Pgm) -> do (Pgm, []).
+
+%% @doc Extrinsic call to external routine (MUMPS: `Do @Pgm@(Args)').
+-spec do (Pgm::program_name (), Args::list ()) -> ok.
+do (Pgm, Args) when is_list (Args) ->
+ ?trace ("do", [Pgm, Args]),
+ perform (do, [format_pgm_call (Pgm, Args)]).
+
+%% @equiv call (Gvn, [])
+call (Pgm) -> call (Pgm, []).
+
+%% @doc Intrinsic call to external routine (MUMPS: `$$@Pgm@(Args)').
+-spec call (Pgm::program_name (), Args::list ()) -> string ().
+call (Pgm, Args) when is_list (Args) ->
+ ?trace ("call", [Pgm, Args]),
+ perform (call, [format_pgm_call (Pgm, Args)]).
+
+%% @equiv merge (SrcGvn, [], DstGvn, [])
+merge (SrcGvn, DstGvn) -> merge (SrcGvn, [], DstGvn, []).
+
+%% @doc Merge/copy one sparse array to another one
+%% (MUMPS: `Merge @DstGvn@(DstSubs)=@SrcGvn@(SrcSubs)').
+-spec merge (SrcGvn::global_name (), SrcSubs::subscripts (),
+ DstGvn::global_name (), DstSubs::subscripts ()) -> ok.
+merge (SrcGvn, SrcSubs, DstGvn, DstSubs) ->
+ ?trace ("merge", [SrcGvn, SrcSubs, DstGvn, DstSubs]),
+ perform (merge, [format_gvn (DstGvn, DstSubs),
+ format_gvn (SrcGvn, SrcSubs)]).
+
+%% @equiv tstart ("")
+tstart () -> tstart ("").
+
+%% @doc Start a new level of transaction
+%% (MUMPS: `TStart @Opt').
+-spec tstart (Opt::tp_options ()) -> ok.
+tstart (Opt) ->
+ ?trace ("tstart", [Opt]),
+ perform (tstart, [Opt]).
+
+%% @doc Commit the current transaction level and
+%% clear the transaction buffer (MUMPS: `TCommit').
+-spec tcommit () -> ok.
+tcommit () ->
+ ?trace ("tcommit"),
+ perform (tcommit, []).
+
+%% @doc Roll back the current transaction level
+%% and clear the transaction buffer (MUMPS: `TRollback').
+-spec trollback () -> ok.
+trollback () ->
+ ?trace ("trollback"),
+ perform (trollback, []).
+
+%% @equiv lock (Gvn, [])
+lock (Gvn) -> lock (Gvn, []).
+
+%% @doc Lock a subtree of global variable (MUMPS: `Lock +@Gvn@(Subs)').
+-spec lock (Gvn::global_name (), Subs::subscripts ()) -> ok.
+lock (Gvn, Subs) when is_list (Subs) ->
+ ?trace ("lock", [Gvn, Subs]),
+ perform (lock, [format_gvn (Gvn, Subs)]).
+
+%% @equiv unlock (Gvn, [])
+unlock (Gvn) -> unlock (Gvn, []).
+
+%% @doc Unlock a subtree of global variable (MUMPS: `Lock -@Gvn@(Subs)').
+-spec unlock (Gvn::global_name (), Subs::subscripts ()) -> ok.
+unlock (Gvn, Subs) when is_list (Subs) ->
+ ?trace ("unlock", [Gvn, Subs]),
+ perform (unlock, [format_gvn (Gvn, Subs)]).
+
+%% @doc data (Gvn, []).
+data (Gvn) -> data (Gvn, []).
+
+%% @doc Check if the subtree of global variable
+%% contains any records (MUMPS: `$Data(@Gvn@(Subs))').
+-spec data (Gvn::global_name (), Subs::subscripts ()) -> integer ().
+data (Gvn, Subs) when is_list (Subs) ->
+ ?trace ("data", [Gvn, Subs]),
+ perform (data, [format_gvn (Gvn, Subs)]).
+
+%% @doc Evaluate MUMPS code (MUMPS: `Xecute Mcode').
+%% USE CAREFULLY!
+-spec xecute (Mcode::string ()) -> ok.
+xecute (Mcode) ->
+ ?trace ("xecute", [Mcode]),
+ perform (xecute, [Mcode]).
+
+%% @doc Return GT.M version information (MUMPS: `$Zversion').
+-spec zversion () -> string ().
+zversion () ->
+ ?trace ("zversion"),
+ perform (zver, []).
+
+%% @doc Return the current time in MUMPS $H-format (MUMPS: `$Horolog').
+%% XXX: what about transforming it from string "X,Y" to Erlang tuple {X,Y}?
+-spec horolog () -> string ().
+horolog () ->
+ ?trace ("horolog"),
+ perform (horo, []).
+
+%% @doc Return process ID of the GT.M worker job (MUMPS: `$Job').
+%% XXX: what about transforming it from string to integer or long?
+-spec job () -> string ().
+job () ->
+ ?trace ("job"),
+ perform (job, []).
+
+%% @doc XXX: Alternative `egtm:order ()' experiment.
+fast_order (Gvn, Subs) ->
+ Fmt = format_gvn (Gvn, Subs, true),
+ ?trace ("fast_order", [Fmt, 1]),
+ N = length (Subs),
+ Subs2 = lists:sublist (Subs, N-1),
+ case perform (fast_order, [Fmt, 1]) of
+ {error, Error} -> {error, Error};
+ Res -> Subs2++[Res]
+ end.
+
+%% @doc XXX: Alternative `egtm:order ()' experiment.
+call_fast_order (Gvn, Subs) ->
+ Fmt = format_gvn (Gvn, Subs, true),
+ ?trace ("call_fast_order", [Fmt, 1]),
+ N = length (Subs),
+ Subs2 = lists:sublist (Subs, N-1),
+ case call ("fastOrder^%egtmapi", [Fmt, 1]) of
+ {error, Error} -> {error, Error};
+ Res -> Subs2++[Res]
+ end.
+
+%% @doc XXX: Alternative `egtm:order ()' experiment.
+%% XXX: Ensure it to run on the same `egtm_worker'
+xecute_fast_order (Gvn, Subs) ->
+ Fmt = format_gvn (Gvn, Subs, true),
+ ?trace ("xecute_fast_order", [Fmt, 1]),
+ N = length (Subs),
+ Subs2 = lists:sublist (Subs, N-1),
+ Cmd = lists:flatten (io_lib:format ("S %OrderVal=$O(~s)", [Fmt])),
+ case xecute (Cmd) of
+ ok -> Subs2++[egtm:get ("%OrderVal")];
+ Whatever -> {error, Whatever}
+ end.
+
+%% --- Internal utils ---------
+%-define (EGTM_POOL_ENABLED, 1).
+-ifdef (EGTM_POOL_ENABLED).
+operation_mode () ->
+ case egtm_config:param ([egtm, mode]) of
+ single -> worker;
+ pool ->
+ [NodeS|_] = string:tokens (atom_to_list (node ()), "@"),
+ Node = list_to_atom (NodeS),
+ IsSlave = lists:member (Node,
+ egtm_config:param ([egtm,workers,nodes])),
+ case IsSlave of
+ true -> worker;
+ false -> manager
+ end
+ end.
+-else.
+operation_mode () -> worker.
+-endif.
+
+%% @doc Perform EGTM operation. A wrapper for all calls
+%% with integrated decision logic if the operation is
+%% to be performed by local worker, via pool, or via
+%% cluster API.
+%% This function is used as a proxy for all EGTM operations
+%% within `egtm' module.
+%% It is not recommended to use it directly from applications
+%% as it calls raw NIF functions without any additional logic.
+perform (Op, Args) ->
+ case lists:member (Op, egtm_config:param ([egtm, deny])) of
+ true -> {error, {security, operation_denied, Op}};
+ false -> perform_internal (Op, Args)
+ end.
+
+perform_internal (Operation, Args) ->
+ Result = case operation_mode () of
+ worker ->
+ ?metrics ("egtm.worker.op."++atom_to_list (Operation),
+ fun () -> egtm_worker:perform (Operation, Args) end);
+ manager ->
+ ?metrics ("egtm.pool.op."++atom_to_list (Operation),
+ fun () -> egtm_pool:perform (Operation, Args) end)
+ end,
+ case Result of
+ {ok, Res} -> Res;
+ {error, Error} -> ?report_error (Error), [];
+ Whatever -> Whatever
+ end.
+
+format_gvn (Gvn, Subs) -> format_gvn (Gvn, Subs, false).
+
+format_gvn (Gvn, [], _) -> Gvn;
+format_gvn (Gvn, Subs, AllowNull) ->
+ [SubsT|SubsH] = lists:reverse (Subs),
+ P1 = ["\""++format_key (S, false)++"\"" || S <- lists:reverse (SubsH)]
+ ++ ["\""++format_key (SubsT, AllowNull)++"\""],
+ P2 = string:join (P1, ","),
+ lists:flatten (io_lib:format ("~s(~s)", [Gvn, P2])).
+
+format_pgm_call (Pgm, Args) ->
+ format_gvn (Pgm, Args).
+
+format_key ([], AllowNull) -> format_key (undefined, AllowNull);
+format_key (undefined, false) -> ?EGTM_NULLKEY;
+format_key (undefined, true) -> [];
+format_key (Key, _) -> term2str (Key).
+
+format_val (Val) -> term2str (Val).
+
+term2str ([]) -> "";
+term2str (undefined) -> "";
+term2str (T) when is_atom (T) -> atom_to_list (T);
+term2str (T) when is_list (T) -> mumps_escape (T);
+term2str (T) -> term2str (lists:flatten (io_lib:format ("~p", [T]))).
+
+mumps_escape ([]) -> [];
+mumps_escape ([$"|T]) -> [$",$"|mumps_escape (T)];
+mumps_escape ([H|T]) -> [H|mumps_escape (T)].
+
+
+%% EUnit Tests
+-ifdef (TEST).
+-include_lib ("eunit/include/eunit.hrl").
+
+basic_test () ->
+ ?MODULE:start (),
+
+ RndStr = egtm_util_eunit:rnd_str_fun (),
+ {Gvn, Subs} = {"^EUnit", ["egtm:basic", RndStr (8)]},
+ Text = RndStr (256),
+
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs, Text)),
+ ?assertEqual (Text, ?MODULE:get (Gvn, Subs)),
+
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs, "")),
+ ?assertEqual ("", ?MODULE:get (Gvn, Subs)),
+
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs, 256.99)),
+ ?assertEqual ("256.99", ?MODULE:get (Gvn, Subs)),
+
+ ?assertEqual (ok, ?MODULE:zkill (Gvn, Subs)),
+ ?assertEqual ("", ?MODULE:get (Gvn, Subs)),
+
+ ?MODULE:stop (),
+ ok.
+
+order_direction_test () ->
+ ?MODULE:start (),
+
+ RndStr = egtm_util_eunit:rnd_str_fun (),
+ {Gvn, Subs} = {"^EUnit", ["egtm:order_direction", RndStr (8)]},
+
+ ?assertEqual (ok, ?MODULE:kill (Gvn, Subs)),
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs++["1"], "one")),
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs++[2], "two")),
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs++[2.5], "two point five")),
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs++["3","hello"], "three")),
+ ?assertEqual (ok, ?MODULE:set (Gvn, Subs++["4"], "four")),
+
+ ?assertEqual (Subs++["1"], ?MODULE:order (Gvn, Subs++[""])),
+ ?assertEqual (Subs++["1"], ?MODULE:order (Gvn, Subs++[""], forward)),
+ ?assertEqual (Subs++["2"], ?MODULE:order (Gvn, Subs++[1], forward)),
+ ?assertEqual (Subs++["4"], ?MODULE:order (Gvn, Subs++[""], backward)),
+
+ ?MODULE:stop (),
+ ok.
+
+order_speed_test () ->
+ ?MODULE:start (),
+ ?MODULE:do ("testPerfPrepare^%egtmapi()"),
+
+ egtm_util_eunit:perform_speed ([
+ {fun () -> ?MODULE:zversion () end,
+ 50, "Erlang $ZVersion"},
+ {fun () -> ?MODULE:call ("testPerfOrder1^%egtmapi()") end,
+ 10, "Native $Order"},
+ {fun () -> ?MODULE:call ("testPerfOrder2^%egtmapi()") end,
+ 10, "Indirection-based"},
+ {fun () -> ?MODULE:call ("testPerfOrder3^%egtmapi()") end,
+ 10, "Xecute-based"},
+ {fun () -> egtm_util_eunit:order_loop (?MODULE, indirection, 100) end,
+ 5, "Erlang Indirection-based"},
+ {fun () -> egtm_util_eunit:order_loop (?MODULE, call_xecute, 100) end,
+ 5, "Erlang Call-Xecute-based"},
+ {fun () -> egtm_util_eunit:order_loop (?MODULE, xecute, 100) end,
+ 5, "Erlang Xecute-based"},
+ {fun () -> egtm_util_eunit:order_loop (?MODULE, erl_xecute, 100) end,
+ 5, "Erlang ErlXecute-based"}
+ ]),
+
+ ?MODULE:stop (),
+ ok.
+-endif.
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
67 src/egtm_admin.erl
@@ -0,0 +1,67 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm_admin -- description
+%% Created: 28-APR-2012 20:10
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+%% @doc EGTM Administration Tools.
+-module (egtm_admin).
+-export ([initdb/0, backup/1, restore/1]).
+
+-include ("egtm.hrl").
+
+%% @doc Initialize database using `$PROJECT/priv/initdb'
+initdb () ->
+ output (run_util ("initdb")).
+
+%% @doc Make a ZWR-backup using MUPIP EXTRACT
+backup (File) ->
+ output (run_util ("mupip", ["extract", File])).
+
+%% @doc Restore a ZWR-backup file using MUPIP LOAD
+restore (File) ->
+ output (run_util ("mupip", ["load", File])).
+
+output (String) ->
+ ?report_info (String), String.
+
+run_util (Name) -> run_util (Name, []).
+run_util (Name, Args) ->
+ Cmd = [get_util (Name), " ", string:join (Args, " ")],
+ ?report_info ("Running OS command: ~s", [lists:flatten (Cmd)]),
+ os:cmd (lists:flatten (Cmd)).
+
+get_util (Name) ->
+ Path = case code:priv_dir (?EGTM_APPNAME) of
+ {error, bad_name} ->
+ case filelib:is_dir (filename:join (["..", priv])) of
+ true -> filename:join (["..", priv, Name]);
+ _ -> filename:join ([priv, Name])
+ end;
+ Dir -> filename:join (Dir, Name)
+ end,
+ case Path of
+ [$/|P] -> "/"++P;
+ P -> "./"++P
+ end.
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
125 src/egtm_config.erl
@@ -0,0 +1,125 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm_config -- description
+%% Created: 08-APR-2012 00:43
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+%% @doc EGTM Configuration Manager.
+%% EGTM configuration is loaded from file that
+%% may look like this one:
+%%
+%% ```
+%% %% egtm core setup
+%% {egtm, [
+%%
+%% %% Defaults
+%% {defaults, [
+%%
+%% %% $Piece default delimiter
+%% {piece_delim, "|"}
+%% ]},
+%%
+%% %% Mode of operation
+%% %% single (= use NIF directly),
+%% %% pool (= use multiple slave ErlVMs)
+%% %% NOTE: pooling is 10times slower than 'single'
+%% %% and is also disabled by default. To enable it,
+%% %% you need to define EGTM_POOL_ENABLED macro
+%% {mode, single},
+%%
+%% %% Workers are slave ErlVMs with GT.M call-in NIF
+%% {workers, [
+%%
+%% %% Slave nodes to be autostarted
+%% {nodes, [egtm1, egtm2, egtm3, egtm4]}
+%% ]},
+%%
+%% %% Functions that are for some (security) reason denied
+%% %{deny, [kill, do, call, merge, xecute]}
+%% {deny, []}
+%% %,
+%% %% String encoder/decoder functions
+%% %{string_conversion, [
+%% % {encode, {egtm_string, erl2utf} },
+%% % {decode, {egtm_string, utf2erl} } ]}
+%% ]}.
+%%
+%% %% egtm metrics: histograms and counters
+%% %% NOTE: if enabled, all egtm-core operations are slower!
+%% {egtm_metrics, [{enabled, false}]}.
+%% '''
+-module (egtm_config).
+-export ([param/1]).
+
+-include_lib ("egtm.hrl").
+
+config_name () -> "egtm.conf". %% to be optionally overriden
+module_name () -> ?EGTM_APPNAME. %% to be optionally overriden
+
+config_path () ->
+ ConfName = config_name (),
+ case code:priv_dir (module_name ()) of
+ {error,_} -> filename:join (["priv", ConfName]);
+ Path -> filename:join ([Path, ConfName])
+ end.
+
+%% NOTE: This is to be inherited and overriden
+%% for egtm_cluster_config and iodb_config modules.
+defaults () ->
+ [{egtm,
+ [{defaults,[{piece_delim,"|"}]},
+ {mode, single},
+ {workers,[{nodes,[egtm1,egtm2,egtm3,egtm4]}]},
+ {deny,[kill,do,call,merge,xecute]}]},
+ {egtm_metrics, [{enabled, false}]}].
+
+%% @doc Get a config value from `priv/egtm.conf'.
+%% Example: ```egtm_config:param ([egtm, workers, nodes])'''
+%% ...will return `[a,b,c,d]' from config file like this:
+%% ```{egtm, [{workers, [{nodes, [a,b,c,d]}]}]}'''
+-spec param (Path::list ()) -> Result::any ().
+param (Path) ->
+ param (Path, param ()).
+param (Path, Conf) ->
+ case deepprops:get (Path, Conf) of
+ undefined -> deepprops:get (Path, defaults ());
+ Value -> Value
+ end.
+param () ->
+ case application:get_env (module_name (), config) of
+ undefined ->
+ case ct_config_plain:read_config (config_path ()) of
+ {ok, Conf} ->
+ application:set_env (module_name (), config, Conf),
+ Conf;
+ {error, Error} ->
+ io:format ("ConfigError: ~p~n", [Error]),
+ application:set_env (module_name (), config, {}),
+ {};
+ _ ->
+ application:set_env (module_name (), config, {}),
+ {}
+ end;
+ {ok, Conf} -> Conf
+ end.
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
84 src/egtm_metrics.erl
@@ -0,0 +1,84 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm_metrics -- description
+%% Created: 22-APR-2012 23:44
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+%% @doc EGTM Code Metering Tools.
+-module (egtm_metrics).
+-export ([submit/2]).
+
+-include_lib ("egtm.hrl").
+
+ensure_running () ->
+ case application:start (folsom) of
+ ok -> ok;
+ {error, {already_started, _}} -> ok;
+ {error, _} ->
+ ?report_warning ("Unable to start Folsom, the metrics server!"),
+ ok %% XXX: handle this!
+ end.
+
+%% @doc Submit a code to be metered.
+%% This function will execute function `Fun' while
+%% measuring execution time and save that time into
+%% a specified namespace `Nsp' within Folsom Metrics
+%% toolset.
+%%
+%% `Nsp' may look like:
+%% <ul>
+%% <li>`egtm.operation.get', `.set', `.order', ...</li>
+%% <li>`egtm.cluster.operation.get', `.set', `.order', ...</li>
+%% </ul>
+%%
+%% At the moment, we measure only execution time
+%% (histogram) and number of executions (counter).
+%%
+%% To simplify calling `egtm_metrics:submit()', there is
+%% also `?metrics ()' macro available.
+%%
+%% Example: ```
+%% ?metrics ("myapp.call.myfun", fun () -> myfun (1, 2, 3) end).
+%% '''
+submit (Nsp, Fun) when is_atom (Nsp) and is_function (Fun) ->
+ submit (atom_to_list (Nsp), Fun);
+submit (Nsp, Fun) when is_list (Nsp) and is_function (Fun) ->
+ case egtm_config:param ([egtm_metrics, enabled]) of
+ true ->
+ ensure_running (),
+ {Time, Result} = timer:tc (fun () -> Fun () end),
+ NspH = Nsp ++ ".histogram",
+ NspC = Nsp ++ ".counter",
+ folsom_metrics:new_histogram (NspH),
+ folsom_metrics:notify ({NspH, Time}),
+ folsom_metrics:new_counter (NspC),
+ folsom_metrics_counter:inc (NspC),
+ Result;
+ _ ->
+ Fun ()
+ end.
+
+%% XXX: analyze metrics data
+% folsom_metrics:get_histogram_statistics (Nsp)
+% folsom_metrics:get_metric_value (Nsp)
+
+%% vim: fdm=syntax:fdn=3:tw=74:ts=2:syn=erlang
View
173 src/egtm_pool.erl
@@ -0,0 +1,173 @@
+%%
+%% $Id: $
+%%
+%% Module: egtm_pool -- description
+%% Created: 06-APR-2012 22:40
+%% Author: tmr
+%%
+%% Copyright 2012 Tomas Morstein, IDEA Systems.
+%%
+%% This program is free software: you can redistribute
+%% it and/or modify it under the terms of the GNU Affero
+%% General Public License as published by the Free Software
+%% Foundation, either version 3 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 Affero General
+%% Public License for more details.
+%%
+%% You should have received a copy of the GNU Affero
+%% General Public License along with this program.
+%% If not, see <http://www.gnu.org/licenses/>.
+
+%% @doc EGTM worker pool manager process.
+%%
+%% In principle, it is similar to standard Erlang `pool' module,
+%% and since we use GT.M via NIF interface, we have to run
+%% each worker in a separate Erlang process to make it some sense.
+%%
+%% This is done via `slave' module that "forks" off slave
+%% nodes based on configuration `[egtm, workers, nodes]', the
+%% array of nodenames to start.
+%%
+%% So this pool forms a small Erlang distribution cluster
+%% restricted to run on a single host with the same GT.M
+%% database.
+%%
+%% For more advanced configurations with multiple hosts,
+%% replication, intelliroute, and other advanced features,
+%% take a look at EGTM/Cluster product.
+%%
+%% Keep in mind that since pool uses EPMD-based RPC between
+%% slave ErlVM nodes, it is always slower than single-worker
+%% configuration. Basic test shows about 10-time slowdown.
+%% That's the reason why egtm_pool is disabled by default
+%% and to use it, you have to compile EGTM with `EGTM_POOL_ENABLED'
+%% macro defined.
+%%
+%% Once we're compiled with `EGTM_POOL_ENABLED', you can
+%% configure pool by setting `[egtm, mode]' to `pool'.
+-module (egtm_pool).
+-behaviour (gen_server).
+
+%-export ([start/0, status/0, perform/2, restart/0, stop/0]).
+-export ([init/1,
+ handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+-export ([start_link/0, perform/2]).
+-compile (export_all).
+
+-include ("egtm.hrl").
+
+init (_Args) ->
+ ?report_info ("Starting up ~p...", [?MODULE]),
+ {ok, [ {N, node_bring_up (N)} || N <- get_nodes ('configured') ]}.
+
+start_link () ->
+ gen_server:start_link ({local, ?MODULE}, ?MODULE, [], []).
+
+%% @doc Call a core-EGTM operation `Operation' with
+%% arguments `Args' via one of `egtm_worker' processes
+%% in this pool.
+perform (Operation, Args) -> perform (Operation, Args, 2).
+perform (_Operation, _Args, 0) -> {timeout, retry_limit_reached};
+perform (Operation, Args, _Retries) ->
+ case catch (gen_server:call (?MODULE, {op, Operation, Args})) of
+ {'EXIT', X} -> {error, X};
+ %case X of
+ % {timeout, _} ->
+ % ?report_error ("Request timeout, trying again..."),
+ % timer:sleep (500),
+ % perform (Operation, Args, Retries-1);
+ % X -> ?report_error (X), {error, X}
+ %end;