|
|
@@ -0,0 +1,373 @@
|
|
|
+MODULE SQLiteCallback;
|
|
|
+(* Callback support:
|
|
|
+ sqlite3_exec row callbacks, scalar SQL functions and the
|
|
|
+ sqlite3_value_* / sqlite3_result_* families. *)
|
|
|
+
|
|
|
+FROM SYSTEM IMPORT ADDRESS, ADR;
|
|
|
+FROM CStr IMPORT CString, Copy;
|
|
|
+FROM SQLite IMPORT
|
|
|
+ SQLiteOk, SQLiteRow, SQLiteDone, SQLiteAbort,
|
|
|
+ SQLiteInteger, SQLiteFloat, SQLiteText, SQLiteBlob, SQLiteNull,
|
|
|
+ SQLiteUtf8, SQLiteDeterministic,
|
|
|
+ SQLiteOpenReadWrite, SQLiteOpenCreate, SQLiteOpenMemory,
|
|
|
+ sqlite3_open_v2, sqlite3_exec, sqlite3_close_v2,
|
|
|
+ sqlite3_prepare_v2, sqlite3_step,
|
|
|
+ sqlite3_column_int, sqlite3_column_int64, sqlite3_column_double,
|
|
|
+ sqlite3_column_text, sqlite3_finalize,
|
|
|
+ sqlite3_errmsg, sqlite3_free,
|
|
|
+ sqlite3_create_function_v2,
|
|
|
+ sqlite3_value_type, sqlite3_value_int, sqlite3_value_int64,
|
|
|
+ sqlite3_value_double, sqlite3_value_text, sqlite3_value_blob,
|
|
|
+ sqlite3_value_bytes,
|
|
|
+ sqlite3_result_null, sqlite3_result_int, sqlite3_result_int64,
|
|
|
+ sqlite3_result_double, sqlite3_result_text, sqlite3_result_blob,
|
|
|
+ sqlite3_result_error, sqlite3_result_error_code,
|
|
|
+ sqlite3_user_data, sqlite3_context_db_handle,
|
|
|
+ SQLiteArrayAt, SQLiteTransient;
|
|
|
+
|
|
|
+VAR
|
|
|
+ ExitCode : INTEGER;
|
|
|
+ db : ADDRESS;
|
|
|
+ cbRows, rc : INTEGER;
|
|
|
+ cbBad : BOOLEAN;
|
|
|
+ errmsg : ADDRESS;
|
|
|
+ ok : BOOLEAN;
|
|
|
+ bin : ARRAY [0..7] OF CHAR;
|
|
|
+
|
|
|
+PROCEDURE SameText (a, b : ARRAY OF CHAR) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ i : INTEGER;
|
|
|
+BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (a[i] # CHR(0)) AND (a[i] = b[i]) DO
|
|
|
+ i := i + 1
|
|
|
+ END;
|
|
|
+ RETURN (a[i] = CHR(0)) AND (b[i] = CHR(0))
|
|
|
+END SameText;
|
|
|
+
|
|
|
+(* sqlite3_exec row callback. *)
|
|
|
+PROCEDURE RowCb (arg : ADDRESS; argc : INTEGER;
|
|
|
+ argv, colNames : ADDRESS) : INTEGER;
|
|
|
+VAR
|
|
|
+ value, name : CString;
|
|
|
+ vbuf, nbuf : ARRAY [0..7] OF CHAR;
|
|
|
+BEGIN
|
|
|
+ IF (argc = 1) AND (arg = ADR(cbRows)) THEN
|
|
|
+ value := SQLiteArrayAt(argv, 0);
|
|
|
+ name := SQLiteArrayAt(colNames, 0);
|
|
|
+ IF (value # NIL) AND (name # NIL)
|
|
|
+ AND (Copy(value, vbuf) > 0) AND (Copy(name, nbuf) > 0) THEN
|
|
|
+ IF ((vbuf[0] = '1') OR (vbuf[0] = '2')) AND (nbuf[0] = 'n') THEN
|
|
|
+ cbRows := cbRows + 1
|
|
|
+ ELSE
|
|
|
+ cbBad := TRUE
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ cbBad := TRUE
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ cbBad := TRUE
|
|
|
+ END;
|
|
|
+ RETURN 0
|
|
|
+END RowCb;
|
|
|
+
|
|
|
+(* Scalar SQL function callbacks. *)
|
|
|
+PROCEDURE AddFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ IF argc = 2 THEN
|
|
|
+ sqlite3_result_int(ctx,
|
|
|
+ sqlite3_value_int(SQLiteArrayAt(argv, 0))
|
|
|
+ + sqlite3_value_int(SQLiteArrayAt(argv, 1)))
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_add expects 2 arguments", -1)
|
|
|
+ END
|
|
|
+END AddFn;
|
|
|
+
|
|
|
+PROCEDURE MixFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+VAR
|
|
|
+ v : ADDRESS;
|
|
|
+ s : CString;
|
|
|
+ buf : ARRAY [0..7] OF CHAR;
|
|
|
+ n : CARDINAL;
|
|
|
+ good : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ good := FALSE;
|
|
|
+ IF argc = 4 THEN
|
|
|
+ v := SQLiteArrayAt(argv, 0);
|
|
|
+ good := (sqlite3_value_type(v) = SQLiteInteger)
|
|
|
+ AND (sqlite3_value_int(v) = 7)
|
|
|
+ AND (sqlite3_value_int64(v) = 7);
|
|
|
+
|
|
|
+ v := SQLiteArrayAt(argv, 1);
|
|
|
+ good := good AND (sqlite3_value_type(v) = SQLiteFloat)
|
|
|
+ AND (sqlite3_value_double(v) = 8.5);
|
|
|
+
|
|
|
+ v := SQLiteArrayAt(argv, 2);
|
|
|
+ s := sqlite3_value_text(v);
|
|
|
+ n := Copy(s, buf);
|
|
|
+ good := good AND (sqlite3_value_type(v) = SQLiteText)
|
|
|
+ AND (sqlite3_value_bytes(v) = 2)
|
|
|
+ AND (n = 2) AND (buf[0] = 'h') AND (buf[1] = 'i');
|
|
|
+
|
|
|
+ v := SQLiteArrayAt(argv, 3);
|
|
|
+ good := good AND (sqlite3_value_type(v) = SQLiteNull)
|
|
|
+ END;
|
|
|
+ IF good THEN
|
|
|
+ sqlite3_result_int(ctx, 42)
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_mix bad arguments", -1)
|
|
|
+ END
|
|
|
+END MixFn;
|
|
|
+
|
|
|
+PROCEDURE EchoFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+VAR
|
|
|
+ v : ADDRESS;
|
|
|
+ s : CString;
|
|
|
+ buf : ARRAY [0..63] OF CHAR;
|
|
|
+ n : CARDINAL;
|
|
|
+BEGIN
|
|
|
+ IF argc = 1 THEN
|
|
|
+ v := SQLiteArrayAt(argv, 0);
|
|
|
+ IF sqlite3_value_type(v) = SQLiteText THEN
|
|
|
+ s := sqlite3_value_text(v);
|
|
|
+ n := Copy(s, buf);
|
|
|
+ sqlite3_result_text(ctx, buf, INTEGER(n), SQLiteTransient())
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_null(ctx)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_echo expects 1 argument", -1)
|
|
|
+ END
|
|
|
+END EchoFn;
|
|
|
+
|
|
|
+PROCEDURE NullFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ sqlite3_result_null(ctx)
|
|
|
+END NullFn;
|
|
|
+
|
|
|
+PROCEDURE Int64Fn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ IF argc = 1 THEN
|
|
|
+ sqlite3_result_int64(ctx,
|
|
|
+ sqlite3_value_int64(SQLiteArrayAt(argv, 0)))
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_int64 expects 1 argument", -1)
|
|
|
+ END
|
|
|
+END Int64Fn;
|
|
|
+
|
|
|
+PROCEDURE DoubleFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ IF argc = 1 THEN
|
|
|
+ sqlite3_result_double(ctx,
|
|
|
+ sqlite3_value_double(SQLiteArrayAt(argv, 0)))
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_double expects 1 argument", -1)
|
|
|
+ END
|
|
|
+END DoubleFn;
|
|
|
+
|
|
|
+PROCEDURE BlobFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ sqlite3_result_blob(ctx, ADR(bin[0]), 3, SQLiteTransient())
|
|
|
+END BlobFn;
|
|
|
+
|
|
|
+PROCEDURE BlobLenFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+VAR
|
|
|
+ v, p : ADDRESS;
|
|
|
+BEGIN
|
|
|
+ IF argc = 1 THEN
|
|
|
+ v := SQLiteArrayAt(argv, 0);
|
|
|
+ p := sqlite3_value_blob(v);
|
|
|
+ IF (sqlite3_value_type(v) = SQLiteBlob) AND (p # NIL) THEN
|
|
|
+ sqlite3_result_int(ctx, sqlite3_value_bytes(v))
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_blob_len expects a BLOB", -1)
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_error(ctx, "m2_blob_len expects 1 argument", -1)
|
|
|
+ END
|
|
|
+END BlobLenFn;
|
|
|
+
|
|
|
+PROCEDURE DataFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ IF (sqlite3_user_data(ctx) = ADR(db))
|
|
|
+ AND (sqlite3_context_db_handle(ctx) = db) THEN
|
|
|
+ sqlite3_result_int(ctx, 1)
|
|
|
+ ELSE
|
|
|
+ sqlite3_result_int(ctx, 0)
|
|
|
+ END
|
|
|
+END DataFn;
|
|
|
+
|
|
|
+PROCEDURE FailFn (ctx : ADDRESS; argc : INTEGER; argv : ADDRESS);
|
|
|
+BEGIN
|
|
|
+ sqlite3_result_error(ctx, "m2_fail", -1);
|
|
|
+ sqlite3_result_error_code(ctx, SQLiteAbort)
|
|
|
+END FailFn;
|
|
|
+
|
|
|
+PROCEDURE QueryInt (sql : ARRAY OF CHAR; want : INTEGER) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ stmt : ADDRESS;
|
|
|
+ rc, got : INTEGER;
|
|
|
+ ok : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ stmt := NIL; got := -777; ok := FALSE;
|
|
|
+ rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
|
|
|
+ IF (rc = SQLiteOk) AND (stmt # NIL) THEN
|
|
|
+ IF sqlite3_step(stmt) = SQLiteRow THEN
|
|
|
+ got := sqlite3_column_int(stmt, 0);
|
|
|
+ IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
|
|
|
+ END;
|
|
|
+ IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ RETURN ok AND (got = want)
|
|
|
+END QueryInt;
|
|
|
+
|
|
|
+PROCEDURE QueryInt64 (sql : ARRAY OF CHAR; want : LONGINT) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ stmt : ADDRESS;
|
|
|
+ rc : INTEGER;
|
|
|
+ got : LONGINT;
|
|
|
+ ok : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ stmt := NIL; got := -777; ok := FALSE;
|
|
|
+ rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
|
|
|
+ IF (rc = SQLiteOk) AND (stmt # NIL) THEN
|
|
|
+ IF sqlite3_step(stmt) = SQLiteRow THEN
|
|
|
+ got := sqlite3_column_int64(stmt, 0);
|
|
|
+ IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
|
|
|
+ END;
|
|
|
+ IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ RETURN ok AND (got = want)
|
|
|
+END QueryInt64;
|
|
|
+
|
|
|
+PROCEDURE QueryDouble (sql : ARRAY OF CHAR; want : REAL) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ stmt : ADDRESS;
|
|
|
+ rc : INTEGER;
|
|
|
+ got : REAL;
|
|
|
+ ok : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ stmt := NIL; got := -777.0; ok := FALSE;
|
|
|
+ rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
|
|
|
+ IF (rc = SQLiteOk) AND (stmt # NIL) THEN
|
|
|
+ IF sqlite3_step(stmt) = SQLiteRow THEN
|
|
|
+ got := sqlite3_column_double(stmt, 0);
|
|
|
+ IF sqlite3_step(stmt) = SQLiteDone THEN ok := TRUE END
|
|
|
+ END;
|
|
|
+ IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ RETURN ok AND (got = want)
|
|
|
+END QueryDouble;
|
|
|
+
|
|
|
+PROCEDURE QueryText (sql : ARRAY OF CHAR; want : ARRAY OF CHAR) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ stmt : ADDRESS;
|
|
|
+ rc : INTEGER;
|
|
|
+ s : CString;
|
|
|
+ buf : ARRAY [0..63] OF CHAR;
|
|
|
+ ok : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ stmt := NIL; ok := FALSE;
|
|
|
+ rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
|
|
|
+ IF (rc = SQLiteOk) AND (stmt # NIL) THEN
|
|
|
+ IF sqlite3_step(stmt) = SQLiteRow THEN
|
|
|
+ s := sqlite3_column_text(stmt, 0);
|
|
|
+ IF (s # NIL) AND (Copy(s, buf) > 0) THEN
|
|
|
+ ok := SameText(buf, want)
|
|
|
+ END;
|
|
|
+ IF sqlite3_step(stmt) # SQLiteDone THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ RETURN ok
|
|
|
+END QueryText;
|
|
|
+
|
|
|
+PROCEDURE QueryFails (sql : ARRAY OF CHAR) : BOOLEAN;
|
|
|
+VAR
|
|
|
+ stmt : ADDRESS;
|
|
|
+ rc : INTEGER;
|
|
|
+ s : CString;
|
|
|
+ buf : ARRAY [0..63] OF CHAR;
|
|
|
+ ok : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ stmt := NIL; ok := FALSE;
|
|
|
+ rc := sqlite3_prepare_v2(db, sql, -1, stmt, NIL);
|
|
|
+ IF (rc = SQLiteOk) AND (stmt # NIL) THEN
|
|
|
+ IF sqlite3_step(stmt) = SQLiteAbort THEN
|
|
|
+ s := sqlite3_errmsg(db);
|
|
|
+ IF (s # NIL) AND (Copy(s, buf) > 0)
|
|
|
+ AND SameText(buf, "m2_fail") THEN
|
|
|
+ ok := TRUE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ rc := sqlite3_finalize(stmt)
|
|
|
+ END;
|
|
|
+ RETURN ok
|
|
|
+END QueryFails;
|
|
|
+
|
|
|
+PROCEDURE Register (name : ARRAY OF CHAR;
|
|
|
+ nArgs : INTEGER;
|
|
|
+ userData, fn : ADDRESS) : BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ RETURN sqlite3_create_function_v2(db, name, nArgs,
|
|
|
+ SQLiteUtf8 + SQLiteDeterministic, userData, fn, NIL, NIL, NIL)
|
|
|
+ = SQLiteOk
|
|
|
+END Register;
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ ExitCode := 1;
|
|
|
+ db := NIL; cbRows := 0; cbBad := FALSE;
|
|
|
+ bin[0] := CHR(0); bin[1] := CHR(1); bin[2] := CHR(2);
|
|
|
+ bin[3] := CHR(0); bin[4] := CHR(255);
|
|
|
+
|
|
|
+ IF (sqlite3_open_v2(":memory:", db,
|
|
|
+ SQLiteOpenReadWrite + SQLiteOpenCreate + SQLiteOpenMemory,
|
|
|
+ NIL) = SQLiteOk) AND (db # NIL) THEN
|
|
|
+ IF Register("m2_add", 2, NIL, ADR(AddFn))
|
|
|
+ AND Register("m2_mix", 4, NIL, ADR(MixFn))
|
|
|
+ AND Register("m2_echo", 1, NIL, ADR(EchoFn))
|
|
|
+ AND Register("m2_null", 0, NIL, ADR(NullFn))
|
|
|
+ AND Register("m2_int64", 1, NIL, ADR(Int64Fn))
|
|
|
+ AND Register("m2_double", 1, NIL, ADR(DoubleFn))
|
|
|
+ AND Register("m2_blob", 0, NIL, ADR(BlobFn))
|
|
|
+ AND Register("m2_blob_len", 1, NIL, ADR(BlobLenFn))
|
|
|
+ AND Register("m2_hasdata", 0, ADR(db), ADR(DataFn))
|
|
|
+ AND Register("m2_fail", 0, NIL, ADR(FailFn)) THEN
|
|
|
+ ok := TRUE
|
|
|
+ ELSE
|
|
|
+ ok := FALSE
|
|
|
+ END
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF ok THEN ok := QueryInt("SELECT m2_add(20, 22);", 42) END;
|
|
|
+ IF ok THEN
|
|
|
+ ok := QueryInt("SELECT m2_mix(7, 8.5, 'hi', NULL);", 42)
|
|
|
+ END;
|
|
|
+ IF ok THEN ok := QueryText("SELECT m2_echo('hello');", "hello") END;
|
|
|
+ IF ok THEN ok := QueryInt("SELECT m2_echo(NULL) IS NULL;", 1) END;
|
|
|
+ IF ok THEN ok := QueryInt("SELECT m2_null() IS NULL;", 1) END;
|
|
|
+ IF ok THEN ok := QueryInt64("SELECT m2_int64(42);", 42) END;
|
|
|
+ IF ok THEN ok := QueryDouble("SELECT m2_double(3.5);", 3.5) END;
|
|
|
+ IF ok THEN ok := QueryText("SELECT hex(m2_blob());", "000102") END;
|
|
|
+ IF ok THEN
|
|
|
+ ok := QueryInt("SELECT m2_blob_len(zeroblob(3));", 3)
|
|
|
+ END;
|
|
|
+ IF ok THEN ok := QueryInt("SELECT m2_hasdata();", 1) END;
|
|
|
+ IF ok THEN ok := QueryFails("SELECT m2_fail();") END;
|
|
|
+
|
|
|
+ IF ok THEN
|
|
|
+ cbRows := 0; cbBad := FALSE; errmsg := NIL;
|
|
|
+ rc := sqlite3_exec(db, "SELECT 1 AS n UNION ALL SELECT 2;",
|
|
|
+ ADR(RowCb), ADR(cbRows), errmsg);
|
|
|
+ ok := (rc = SQLiteOk) AND (NOT cbBad) AND (cbRows = 2);
|
|
|
+ IF errmsg # NIL THEN
|
|
|
+ sqlite3_free(errmsg);
|
|
|
+ errmsg := NIL
|
|
|
+ END
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF db # NIL THEN
|
|
|
+ IF sqlite3_close_v2(db) # SQLiteOk THEN ok := FALSE END
|
|
|
+ END;
|
|
|
+ IF ok THEN ExitCode := 42 END
|
|
|
+END SQLiteCallback.
|