summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2010-03-15 20:07:36 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2010-03-15 20:07:36 (GMT)
commit7c6a94930dae634efd8af6db16578d8317153a9a (patch) (side-by-side diff)
tree2d931e2e4595c88c4f704151dcc2316337d4dfa5
parent04b9cd97aa9287668ce41e3db7e273324d3136bc (diff)
downloadgamma-7c6a94930dae634efd8af6db16578d8317153a9a.tar.gz
gamma-7c6a94930dae634efd8af6db16578d8317153a9a.tar.bz2
Fix exception generation in (gamma sql)
* src/gsql_conn.c (gsql_error): Rename to gamma_sql_error. Change Scheme name to sql-error. All callers updated. * src/guile-sql.h: Likewise. * src/mysql.c (s_mysql_connect, s_mysql_query): Use scm_error to generate error exceptions. * src/pgsql.c (s_pgsql_connect, s_pgsql_query): Likewise. * src/sql.sci (sql-catch-failure) (sql-ignore-failure): Update. * doc/sql.texi: Update.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--doc/sql.texi48
-rw-r--r--src/gsql_conn.c2
-rw-r--r--src/guile-sql.h2
-rw-r--r--src/mysql.c43
-rw-r--r--src/pgsql.c26
-rw-r--r--src/sql.sci10
6 files changed, 94 insertions, 37 deletions
diff --git a/doc/sql.texi b/doc/sql.texi
index 8e1b4da..5a35fdd 100644
--- a/doc/sql.texi
+++ b/doc/sql.texi
@@ -97,7 +97,7 @@ If @var{query} results in some modifications to the database (e.g. an
the number of affected database rows.
@end deffn
-@defvr {Error Keyword} gsql-error
+@defvr {Error Keyword} sql-error
An error of this type is raised when any of the above functions
fails. Two arguments are supplied: a string describing the error,
and error message from the underlying @acronym{SQL} implementation.
@@ -106,17 +106,51 @@ and error message from the underlying @acronym{SQL} implementation.
@deffn {Scheme syntax} sql-catch-failure (handler) expr
@deffnx {Scheme syntax} sql-catch-failure expr
This syntax executes the Scheme expression @var{expr} and calls
-@code{handler} if a @code{gsql-error} exception occurs. The handler
-must be declared as follows:
+@code{handler} if a @code{gsql-error} exception occurs.
+In its second form, @code{sql-catch-failure} calls a function named
+@code{sql-error-handler} if a @code{sql-error} exception occurs.
+The @code{sql-error-handler} must be declared by the user.
+
+The error handler must be declared as follows:
@lisp
-(define (handler err descr)
+(define (handler key func fmt fmtargs data)
...)
@end lisp
-In its second form, @code{sql-catch-failure} calls a function named
-@code{sql-error-handler} if a @code{gsql-error} exception occurs.
-The @code{sql-error-handler} must be declared by the user.
+@noindent
+where:
+
+@table @var
+@item key
+The error key (@samp{sql-error}).
+
+@item func
+Name of the Scheme function that encountered the error.
+
+@item fmt
+Format string suitable for @code{format}.
+
+@item fmtargs
+Arguments to @var{fmt}.
+
+@item data
+Interface-specific error description. It is a list consisting of two
+elements. The first element is an integer code of the error, if
+supported by the underlying implementation, or @code{#f} if not.
+The second element is a textual description of the error obtained from
+the underlying implementation.
+@end table
+
+For example:
+
+@lisp
+@group
+(define (sql-error-handler key func fmt fmtargs data)
+ (apply format (current-error-port) fmt fmtargs))
+@end group
+@end lisp
+
@end deffn
@deffn {Scheme syntax} sql-ignore-failure (value) expr
diff --git a/src/gsql_conn.c b/src/gsql_conn.c
index a2fc93c..40fef2b 100644
--- a/src/gsql_conn.c
+++ b/src/gsql_conn.c
@@ -25,7 +25,7 @@
static int num_iface;
static struct sql_iface sql_iftab[MAX_IFACES];
-SCM_GLOBAL_SYMBOL (gsql_error, "gsql-error");
+SCM_GLOBAL_SYMBOL (gamma_sql_error, "sql-error");
static long sql_connect_tag = -1;
diff --git a/src/guile-sql.h b/src/guile-sql.h
index f6c775a..926aa74 100644
--- a/src/guile-sql.h
+++ b/src/guile-sql.h
@@ -45,7 +45,7 @@ struct sql_iface {
SCM (*query) (struct sql_connect *, const char *query);
};
-extern SCM gsql_error;
+extern SCM gamma_sql_error;
struct gamma_parmdcl {
const char *name;
diff --git a/src/mysql.c b/src/mysql.c
index dc8d463..4b4d0f2 100644
--- a/src/mysql.c
+++ b/src/mysql.c
@@ -72,9 +72,11 @@ s_mysql_connect (SCM parmlist, const char *func_name)
mysql = mysql_init(NULL);
if (!mysql)
- scm_throw(gsql_error,
- scm_list_2(scm_makfrom0str("mysql_init() failed"),
- scm_makfrom0str("")));
+ scm_error(gamma_sql_error,
+ func_name,
+ "~A",
+ scm_list_1(scm_from_locale_string("mysql_init() failed")),
+ SCM_BOOL_F);
if (hostname && hostname[0] == '/') {
socket_path = hostname;
@@ -101,18 +103,22 @@ s_mysql_connect (SCM parmlist, const char *func_name)
free(socket_path);
if (!mp) {
- SCM args;
+ SCM args, mdiag;
free(hostname);
free(user);
free(pass);
free(dbname);
- args = scm_list_2(scm_makfrom0str("Cannot connect to the database"),
- scm_makfrom0str(mysql_error(mysql)));
+ mdiag = scm_from_locale_string(mysql_error(mysql));
+ args = scm_list_2(scm_from_uint(mysql_errno(mysql)),
+ mdiag);
mysql_close(mysql);
- scm_throw(gsql_error, args);
+ scm_error(gamma_sql_error, func_name,
+ "~A: ~A",
+ scm_list_2(scm_from_locale_string("Cannot connect to the database"), mdiag),
+ args);
}
smob = sql_connect_create("mysql");
@@ -132,10 +138,17 @@ s_mysql_query(struct sql_connect *conn, const char *query)
MYSQL_RES *result;
SCM cell = SCM_EOL;
- if (mysql_query(mysql, query))
- scm_throw(gsql_error, scm_list_2(scm_makfrom0str("Error executing MySQL query"),
- scm_makfrom0str(mysql_error(mysql))));
-
+ if (mysql_query(mysql, query)) {
+ SCM mdiag = scm_from_locale_string(mysql_error(mysql));
+
+ scm_error(gamma_sql_error, "sql-query",
+ "~A: ~A",
+ scm_list_2(scm_from_locale_string("Error executing MySQL query"),
+ mdiag),
+ scm_list_2(scm_from_uint(mysql_errno(mysql)),
+ mdiag));
+ }
+
result = mysql_store_result(mysql);
if (result) {
@@ -174,9 +187,11 @@ s_mysql_query(struct sql_connect *conn, const char *query)
if (mysql_field_count(mysql) == 0) {
cell = scm_from_ulong(mysql_affected_rows(mysql));
} else { /* mysql_store_result() should have returned data */
- scm_throw(gsql_error,
- scm_list_2(scm_makfrom0str("Query should have returned data"),
- scm_makfrom0str(mysql_error(mysql))));
+ scm_error(gamma_sql_error, "sql-query",
+ "~A",
+ scm_list_1(scm_from_locale_string("Query should have returned data")),
+ scm_list_2(scm_from_uint(mysql_errno(mysql)),
+ scm_from_locale_string(mysql_error(mysql))));
}
}
return cell;
diff --git a/src/pgsql.c b/src/pgsql.c
index 2422551..759795e 100644
--- a/src/pgsql.c
+++ b/src/pgsql.c
@@ -64,17 +64,20 @@ s_pgsql_connect (SCM parmlist, const char *func_name)
pgconn = PQsetdbLogin(hostname, port, NULL, NULL, dbname, user, pass);
if (PQstatus(pgconn) == CONNECTION_BAD) {
- SCM args;
+ SCM args, pmsg;
free(hostname);
free(port);
free(user);
free(pass);
-
- args = scm_list_2(scm_makfrom0str("Cannot connect to the database"),
- scm_makfrom0str(PQerrorMessage(pgconn)));
+
+ pmsg = scm_makfrom0str(PQerrorMessage(pgconn));
+ args = scm_list_1(scm_makfrom0str("Cannot connect to the database"));
PQfinish(pgconn);
- scm_throw(gsql_error, args);
+ scm_error(gamma_sql_error, func_name,
+ "~A",
+ args,
+ scm_list_2(SCM_BOOL_F, pmsg));
}
smob = sql_connect_create("pgsql");
@@ -130,8 +133,10 @@ s_pgsql_query(struct sql_connect *conn, const char *query)
res = PQexec(pgconn, query);
if (!res)
- scm_throw(gsql_error,
- scm_list_2(scm_makfrom0str("Error executing PostgreSQL query"),
+ scm_error(gamma_sql_error, "sql-query",
+ "~A",
+ scm_list_1(scm_makfrom0str("Error executing PostgreSQL query")),
+ scm_list_2(SCM_BOOL_F,
scm_makfrom0str(PQerrorMessage(pgconn))));
stat = PQresultStatus(res);
@@ -147,8 +152,11 @@ s_pgsql_query(struct sql_connect *conn, const char *query)
PQclear(res);
break;
default:
- scm_throw(gsql_error, scm_list_2(scm_makfrom0str("PostgreSQL error"),
- scm_makfrom0str(PQresStatus(stat))));
+ scm_error(gamma_sql_error, "sql-query",
+ "~A",
+ scm_list_1(scm_makfrom0str("PostgreSQL error")),
+ scm_list_2(scm_from_uint(stat),
+ scm_from_locale_string(PQresStatus(stat))));
}
return cell;
diff --git a/src/sql.sci b/src/sql.sci
index 2437514..209116a 100644
--- a/src/sql.sci
+++ b/src/sql.sci
@@ -30,10 +30,10 @@ include(BUILDDIR/gsql_conn.inc)
(define-syntax sql-catch-failure
(syntax-rules ()
((sql-catch-failure (handler) expr)
- (catch 'gsql-error
+ (catch 'sql-error
(lambda () expr)
- (lambda (key err descr)
- (handler err descr))))
+ (lambda args
+ (apply handler args))))
((sql-catch-failure expr)
(sql-catch-failure (sql-error-handler) expr))))
@@ -41,9 +41,9 @@ include(BUILDDIR/gsql_conn.inc)
(define-syntax sql-ignore-failure
(syntax-rules ()
((sql-ignore-failure (value) expr)
- (catch 'gsql-error
+ (catch 'sql-error
(lambda () expr)
- (lambda (key err descr)
+ (lambda args
value)))
((sql-ignore-failure expr)
(sql-ignore-failure (#f) expr))))

Return to:

Send suggestions and report system problems to the System administrator.