diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2010-03-15 22:07:36 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2010-03-15 22:07:36 +0200 |
commit | 7c6a94930dae634efd8af6db16578d8317153a9a (patch) | |
tree | 2d931e2e4595c88c4f704151dcc2316337d4dfa5 | |
parent | 04b9cd97aa9287668ce41e3db7e273324d3136bc (diff) | |
download | gamma-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.
-rw-r--r-- | doc/sql.texi | 48 | ||||
-rw-r--r-- | src/gsql_conn.c | 2 | ||||
-rw-r--r-- | src/guile-sql.h | 2 | ||||
-rw-r--r-- | src/mysql.c | 43 | ||||
-rw-r--r-- | src/pgsql.c | 26 | ||||
-rw-r--r-- | src/sql.sci | 10 |
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)))) |