aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/app.h6
-rw-r--r--src/gsql_conn.c205
-rw-r--r--src/gsql_lib.c47
-rw-r--r--src/guile-sql.h33
-rw-r--r--src/mysql.c131
-rw-r--r--src/pgsql.c140
6 files changed, 562 insertions, 0 deletions
diff --git a/src/app.h b/src/app.h
new file mode 100644
index 0000000..7b7358a
--- /dev/null
+++ b/src/app.h
@@ -0,0 +1,6 @@
+#ifdef USE_SQL_MYSQL
+extern struct sql_iface mysql_iface;
+#endif
+#ifdef USE_SQL_PGSQL
+extern struct sql_iface pgsql_iface;
+#endif
diff --git a/src/gsql_conn.c b/src/gsql_conn.c
new file mode 100644
index 0000000..a61f8f6
--- /dev/null
+++ b/src/gsql_conn.c
@@ -0,0 +1,205 @@
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <app.h>
+
+int num_iface;
+struct sql_iface sql_iftab[MAX_IFACES];
+
+long sql_connect_tag;
+
+/* SMOB functions: */
+static SCM
+sql_connect_mark (SCM connect_smob)
+{
+ struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob);
+ return sql_iftab[conn->iface].mark(conn);
+}
+
+static scm_sizet
+sql_connect_free (SCM connect_smob)
+{
+ scm_sizet size = sizeof(struct sql_connect);
+ struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob);
+ size += sql_iftab[conn->iface].free(conn);
+ if (conn->hostname)
+ free(conn->hostname);
+ if (conn->username)
+ free(conn->username);
+ if (conn->database)
+ free(conn->database);
+ free(conn);
+ return size;
+}
+
+static int
+sql_connect_print (SCM connect_smob, SCM port, scm_print_state * pstate)
+{
+ struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob);
+ scm_puts("#<SQL connection (", port);
+ scm_puts(sql_iftab[conn->iface].name, port);
+ scm_puts(")", port);
+ if (!conn->data)
+ scm_puts("not connected", port);
+ else {
+ scm_puts(conn->username, port);
+ scm_puts("@", port);
+ scm_puts(conn->hostname, port);
+ scm_puts(":", port);
+ scm_intprint(conn->port, 10, port);
+ scm_puts(" ", port);
+ scm_puts(conn->database, port);
+ };
+ scm_puts (">", port);
+ return 1;
+}
+
+int
+sql_find_iface(char *name)
+{
+ int iface;
+
+ for (iface = 0; iface < num_iface; iface++)
+ if (strcmp(sql_iftab[iface].name, name) == 0)
+ return iface;
+ return -1;
+}
+
+SCM
+sql_connect_create (char *name)
+{
+ struct sql_connect *conn;
+ int iface = sql_find_iface(name);
+ if (iface < 0)
+ scm_misc_error("sql_connect_create",
+ "Unknown SQL interface ~S",
+ SCM_LIST1(scm_makfrom0str(name)));
+
+ conn = scm_must_malloc (sizeof (*conn), "sql_connect");
+ memset(conn, 0, sizeof *conn);
+ conn->iface = iface;
+ SCM_RETURN_NEWSMOB (sql_connect_tag, conn);
+}
+
+int
+scm_is_sql_connect (SCM scm)
+{
+ return SCM_NIMP (scm) && SCM_CAR (scm) == sql_connect_tag;
+}
+
+/* Interface */
+
+SCM_DEFINE (sql_connect_internal, "sql-connect-internal", 5, 1, 0,
+ (SCM IFACE, SCM HOST, SCM PORT, SCM DB, SCM USER, SCM PASS),
+ "Connect to a database.")
+#define FUNC_NAME s_sql_connect_internal
+{
+ SCM smob;
+ char *hostname;
+ int port;
+ char *dbname;
+ char *user;
+ char *pass;
+ int iface;
+
+ if (SCM_IMP(IFACE) && SCM_INUMP(IFACE))
+ iface = SCM_INUM(IFACE);
+ else if (SCM_STRINGP(IFACE))
+ iface = sql_find_iface(SCM_CHARS(IFACE));
+ else {
+ SCM_ASSERT(IFACE == SCM_BOOL_T || IFACE == SCM_BOOL_F,
+ IFACE, SCM_ARG1, FUNC_NAME);
+ iface = 0;
+ }
+ if (iface < 0 || iface >= num_iface)
+ scm_misc_error(FUNC_NAME,
+ "Argument ~S (~S) out of range",
+ SCM_LIST2(SCM_MAKINUM(1),
+ IFACE));
+
+ SCM_ASSERT(SCM_STRINGP(HOST), HOST, SCM_ARG1, FUNC_NAME);
+ hostname = SCM_ROCHARS(HOST);
+
+ SCM_ASSERT(SCM_IMP(PORT) && SCM_INUMP(PORT),
+ PORT, SCM_ARG2, FUNC_NAME);
+ port = SCM_INUM(PORT);
+
+ SCM_ASSERT(SCM_STRINGP(DB), DB, SCM_ARG3, FUNC_NAME);
+ dbname = SCM_ROCHARS(DB);
+
+ SCM_ASSERT(SCM_STRINGP(USER), USER, SCM_ARG4, FUNC_NAME);
+ user = SCM_ROCHARS(USER);
+
+ if (SCM_UNBNDP(PASS))
+ pass = NULL;
+ else if (SCM_STRINGP(USER))
+ pass = SCM_ROCHARS(PASS);
+
+ smob = sql_iftab[iface].connect(hostname, port,
+ dbname, user, pass,
+ FUNC_NAME);
+ if (smob != SCM_BOOL_F) {
+ struct sql_connect *conn = (struct sql_connect *)SCM_CDR(smob);
+ conn->hostname = strdup(hostname);
+ conn->port = port;
+ conn->username = strdup(user);
+ conn->database = strdup(dbname);
+ }
+ return smob;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (sql_connect_close, "sql-connect-close", 1, 0, 0,
+ (SCM CONN),
+ "Close connection to a database.")
+#define FUNC_NAME s_sql_connect_close
+{
+ struct sql_connect *conn;
+ SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME);
+ conn = (struct sql_connect *)SCM_CDR(CONN);
+ sql_iftab[conn->iface].close(conn);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (sql_query_internal, "sql-query-internal", 2, 0, 0,
+ (SCM CONN, SCM QUERY),
+ "Run an SQL query")
+#define FUNC_NAME s_sql_query_internal
+{
+ struct sql_connect *conn;
+ void *ptr;
+ char *query;
+
+ SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME);
+ SCM_ASSERT(SCM_STRINGP(QUERY), QUERY, SCM_ARG2, FUNC_NAME);
+ conn = (struct sql_connect *)SCM_CDR(CONN);
+ query = SCM_ROCHARS(QUERY);
+ return sql_iftab[conn->iface].query(conn, query);
+}
+#undef FUNC_NAME
+
+int
+sql_register_iface(struct sql_iface *ifp)
+{
+ if (num_iface >= MAX_IFACES)
+ scm_misc_error("sql_register_iface",
+ "Too many ifaces registered",
+ SCM_EOL);
+ memcpy(&sql_iftab[num_iface], ifp, sizeof sql_iftab[0]);
+ sql_iftab[num_iface].name = strdup(ifp->name);
+ return num_iface++;
+}
+
+void
+gsql_conn_init()
+{
+ sql_connect_tag = scm_make_smob_type ("sql_connect",
+ sizeof (struct sql_connect));
+ scm_set_smob_mark (sql_connect_tag, sql_connect_mark);
+ scm_set_smob_free (sql_connect_tag, sql_connect_free);
+ scm_set_smob_print (sql_connect_tag, sql_connect_print);
+#include <gsql_conn.x>
+}
diff --git a/src/gsql_lib.c b/src/gsql_lib.c
new file mode 100644
index 0000000..fa28047
--- /dev/null
+++ b/src/gsql_lib.c
@@ -0,0 +1,47 @@
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include <guile-sql.h>
+#include <app.h>
+
+SCM
+scm_makenum (unsigned long val)
+{
+ if (SCM_FIXABLE ((long) val))
+ return SCM_MAKINUM (val);
+
+#ifdef SCM_BIGDIG
+ return scm_long2big (val);
+#else /* SCM_BIGDIG */
+ return scm_make_real ((double) val);
+#endif /* SCM_BIGDIG */
+}
+
+/*
+ * Chop off trailing whitespace. Return length of the resulting string
+ */
+int
+chop(char *str)
+{
+ int len;
+
+ for (len = strlen(str); len > 0 && isspace(str[len-1]); len--)
+ ;
+ str[len] = 0;
+ return len;
+}
+
+
+
+extern void
+gsql_init()
+{
+ gsql_conn_init();
+#ifdef USE_SQL_MYSQL
+ sql_register_iface(&mysql_iface);
+#endif
+#ifdef USE_SQL_PGSQL
+ sql_register_iface(&pgsql_iface);
+#endif
+}
+
diff --git a/src/guile-sql.h b/src/guile-sql.h
new file mode 100644
index 0000000..64fd0eb
--- /dev/null
+++ b/src/guile-sql.h
@@ -0,0 +1,33 @@
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <libguile.h>
+
+#define MAX_IFACES 32
+
+struct sql_connect {
+ int iface;
+ char *hostname;
+ struct in_addr hostaddr;
+ int port;
+ char *username;
+ char *database;
+ void *data;
+};
+
+struct sql_result {
+ SCM owner;
+ void *data;
+};
+
+struct sql_iface {
+ char *name;
+ SCM (*mark) (struct sql_connect *);
+ scm_sizet (*free) (struct sql_connect *);
+ SCM (*connect) (char *hostname, int port,
+ char *dbname, char *user, char *pass, char *why);
+ void (*close) (struct sql_connect *);
+ SCM (*query) (struct sql_connect *, char *query);
+};
+
+extern struct sql_iface sql_iftab[];
diff --git a/src/mysql.c b/src/mysql.c
new file mode 100644
index 0000000..8491bb4
--- /dev/null
+++ b/src/mysql.c
@@ -0,0 +1,131 @@
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <mysql/mysql.h>
+
+SCM
+s_mysql_mark(struct sql_connect *conn)
+{
+ return SCM_BOOL_F;
+}
+
+scm_sizet
+s_mysql_free(struct sql_connect *conn)
+{
+ MYSQL *mysql = (MYSQL*) conn->data;
+ if (!mysql)
+ return 0;
+ mysql_close(mysql);
+ free(mysql);
+ return sizeof(MYSQL);
+}
+
+SCM
+s_mysql_connect (char *hostname, int port,
+ char *dbname, char *user, char *pass, char *why)
+{
+ MYSQL *mysql;
+ SCM smob;
+ struct sql_connect *conn;
+
+ mysql = mysql_init(NULL);
+ if (!mysql)
+ return SCM_BOOL_F;
+ if (!mysql_real_connect(mysql, hostname,
+ user, pass, dbname,
+ port, NULL, 0)) {
+ mysql_close(mysql);
+ return SCM_BOOL_F;
+ }
+
+ smob = sql_connect_create("mysql");
+ conn = (struct sql_connect *)SCM_CDR(smob);
+ conn->data = mysql;
+ return smob;
+}
+
+SCM
+s_mysql_query(struct sql_connect *conn, char *query)
+{
+ MYSQL *mysql = conn->data;
+ MYSQL_RES *result;
+ SCM cell;
+
+ if (mysql_query(mysql, query))
+ scm_misc_error("s_mysql_query",
+ "MySQL error: ~S",
+ SCM_LIST1(scm_makfrom0str(mysql_error(mysql))));
+
+ result = mysql_store_result(mysql);
+
+ if (result) {
+ int nfields = mysql_num_fields(result);
+ int nrows = mysql_num_rows(result);
+ int i, j;
+ SCM row_head = SCM_EOL, row_tail;
+
+ for (i = 0; i < nrows; i++) {
+ SCM new_row;
+ SCM head = SCM_EOL, tail;
+ MYSQL_ROW row = mysql_fetch_row(result);
+
+ if (!row)
+ break;
+ for (j = 0; j < nfields; j++) {
+ SCM new_elt;
+ SCM_NEWCELL(new_elt);
+ SCM_SETCAR(new_elt, scm_makfrom0str(row[j]));
+ if (head == SCM_EOL)
+ head = new_elt;
+ else
+ SCM_SETCDR(tail, new_elt);
+ tail = new_elt;
+ }
+
+ if (head != SCM_EOL)
+ SCM_SETCDR(tail, SCM_EOL);
+
+ SCM_NEWCELL(new_row);
+ SCM_SETCAR(new_row, head);
+
+ if (row_head == SCM_EOL)
+ row_head = new_row;
+ else
+ SCM_SETCDR(row_tail, new_row);
+ row_tail = new_row;
+ }
+ if (row_head != SCM_EOL)
+ SCM_SETCDR(row_tail, SCM_EOL);
+ cell = row_head;
+ mysql_free_result(result);
+ } else { /* should it have returned something? */
+ if (mysql_field_count(mysql) == 0) {
+ cell = scm_makenum(mysql_affected_rows(mysql));
+ } else { /* mysql_store_result() should have returned data */
+ scm_misc_error("s_mysql_query",
+ "MySQL error: ~S",
+ SCM_LIST1(scm_makfrom0str(mysql_error(mysql))));
+ }
+ }
+ return cell;
+}
+
+void
+s_mysql_close(struct sql_connect *conn)
+{
+ if (conn->data)
+ mysql_close(conn->data);
+ conn->data = NULL;
+}
+
+struct sql_iface mysql_iface = {
+ "mysql",
+ s_mysql_mark,
+ s_mysql_free,
+ s_mysql_connect,
+ s_mysql_close,
+ s_mysql_query,
+};
+
diff --git a/src/pgsql.c b/src/pgsql.c
new file mode 100644
index 0000000..956f517
--- /dev/null
+++ b/src/pgsql.c
@@ -0,0 +1,140 @@
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <libpq-fe.h>
+
+SCM
+s_pgsql_mark(struct sql_connect *conn)
+{
+ return SCM_BOOL_F;
+}
+
+scm_sizet
+s_pgsql_free(struct sql_connect *conn)
+{
+ PGconn *pgconn = (PGconn*) conn->data;
+ if (!pgconn)
+ return 0;
+ PQfinish(pgconn);
+ return sizeof(pgconn);
+}
+
+SCM
+s_pgsql_connect (char *hostname, int port,
+ char *dbname, char *user, char *pass, char *why)
+{
+ PGconn *pgconn;
+ char buf[24];
+ SCM smob;
+ struct sql_connect *conn;
+
+ snprintf(buf, sizeof buf, "%d", port);
+ pgconn = PQsetdbLogin(hostname, buf, NULL, NULL, dbname, user, pass);
+ if (PQstatus(pgconn) == CONNECTION_BAD)
+ return SCM_BOOL_F;
+
+ smob = sql_connect_create("pgsql");
+ conn = (struct sql_connect *)SCM_CDR(smob);
+ conn->data = pgconn;
+ return smob;
+}
+
+SCM
+result_to_list(PGresult *res)
+{
+ int i, j;
+ int ntuples = PQntuples(res);
+ int nfields = PQnfields(res);
+ SCM row_head = SCM_EOL, row_tail;
+
+ for (i = 0; i < ntuples; i++) {
+ SCM new_row;
+ SCM head = SCM_EOL, tail;
+
+ for (j = 0; j < nfields; j++) {
+ SCM new_elt;
+ char *val = PQgetvalue(res, i, j);
+ SCM_NEWCELL(new_elt);
+ SCM_SETCAR(new_elt, scm_makfrom0str(val));
+ if (head == SCM_EOL)
+ head = new_elt;
+ else
+ SCM_SETCDR(tail, new_elt);
+ tail = new_elt;
+ }
+
+ if (head != SCM_EOL)
+ SCM_SETCDR(tail, SCM_EOL);
+
+ SCM_NEWCELL(new_row);
+ SCM_SETCAR(new_row, head);
+
+ if (row_head == SCM_EOL)
+ row_head = new_row;
+ else
+ SCM_SETCDR(row_tail, new_row);
+ row_tail = new_row;
+ }
+ if (row_head != SCM_EOL)
+ SCM_SETCDR(row_tail, SCM_EOL);
+ return row_head;
+}
+
+SCM
+s_pgsql_query(struct sql_connect *conn, char *query)
+{
+ PGconn *pgconn = (PGconn*) conn->data;
+ PGresult *res;
+ SCM cell;
+ ExecStatusType stat;
+
+ res = PQexec(pgconn, query);
+ if (!res)
+ scm_misc_error("s_mgsql_query",
+ "pgSQL error: ~S",
+ SCM_LIST1(scm_makfrom0str(PQerrorMessage(pgconn))));
+
+ stat = PQresultStatus(res);
+
+ switch (stat) {
+ case PGRES_COMMAND_OK:
+ /* Successful completion of a command returning no data */
+ cell = scm_makenum(strtoul(PQcmdTuples(res), NULL, 0));
+ break;
+ case PGRES_TUPLES_OK:
+ /* The query successfully executed */
+ cell = result_to_list(res);
+ PQclear(res);
+ break;
+ default:
+ scm_misc_error("s_mgsql_query",
+ "pgSQL error: ~S",
+ SCM_LIST1(scm_makfrom0str(PQresStatus(stat))));
+ }
+
+ return cell;
+}
+
+void
+s_pgsql_close(struct sql_connect *conn)
+{
+ PGconn *pgconn = (PGconn*) conn->data;
+ if (!pgconn)
+ return;
+ PQfinish(pgconn);
+ conn->data = NULL;
+}
+
+struct sql_iface pgsql_iface = {
+ "pgsql",
+ s_pgsql_mark,
+ s_pgsql_free,
+ s_pgsql_connect,
+ s_pgsql_close,
+ s_pgsql_query,
+};
+
+
+

Return to:

Send suggestions and report system problems to the System administrator.