M2compiler-V3/bindings/sqlite3/showcase/SQLiteFeatureShowcase.mod

MODULE SQLiteFeatureShowcase;
(* Broad V3 SQLite binding showcase:
   diagnostics, prepared statements, parameter metadata, row callbacks,
   scalar types, BLOB I/O, statement metadata, UDFs, hooks, backup,
   constraint errors and authorizer behavior. *)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM CStr IMPORT CString, Copy;
FROM SysIO IMPORT Write, WriteLn, WriteInt;
FROM SQLite IMPORT
  SQLiteOk, SQLiteRow, SQLiteDone, SQLiteBusy, SQLiteAuth, SQLiteBlob,
  SQLiteBlobReadWrite, SQLiteOpenReadWrite, SQLiteOpenCreate,
  SQLiteOpenMemory, SQLiteTraceStmt, SQLiteUtf8, SQLiteDeterministic,
  SQLiteAuthOk, SQLiteAuthDeny, SQLiteAuthDelete,
  SQLiteStmtStatusVmStep,
  sqlite3_open_v2, sqlite3_close, sqlite3_close_v2, sqlite3_exec,
  sqlite3_prepare_v2, sqlite3_step, sqlite3_reset,
  sqlite3_clear_bindings, sqlite3_finalize,
  sqlite3_bind_int, sqlite3_bind_null, sqlite3_bind_blob,
  sqlite3_bind_zeroblob,
  sqlite3_bind_text, sqlite3_bind_parameter_count,
  sqlite3_bind_parameter_name, sqlite3_bind_parameter_index,
  sqlite3_column_type, sqlite3_column_bytes, sqlite3_column_int,
  sqlite3_column_blob,
  sqlite3_changes, sqlite3_total_changes,
  sqlite3_sql, sqlite3_expanded_sql, sqlite3_stmt_readonly,
  sqlite3_stmt_busy, sqlite3_next_stmt, sqlite3_stmt_status,
  sqlite3_libversion, sqlite3_libversion_number, sqlite3_sourceid,
  sqlite3_threadsafe, sqlite3_get_autocommit, sqlite3_complete,
  sqlite3_blob_open, sqlite3_blob_close, sqlite3_blob_read,
  sqlite3_blob_write, sqlite3_blob_bytes,
  sqlite3_backup_init, sqlite3_backup_step, sqlite3_backup_finish,
  sqlite3_backup_remaining, sqlite3_backup_pagecount,
  sqlite3_create_function_v2, sqlite3_value_int,
  sqlite3_result_int, sqlite3_result_error,
  sqlite3_progress_handler, sqlite3_trace_v2,
  sqlite3_update_hook, sqlite3_commit_hook, sqlite3_rollback_hook,
  sqlite3_set_authorizer, sqlite3_extended_result_codes,
  sqlite3_extended_errcode, sqlite3_errmsg, sqlite3_free,
  SQLiteArrayAt, SQLiteTransient;

VAR
  ExitCode : INTEGER;
  db, dst, stmt, s1, s2, blob, bk, prev : ADDRESS;
  rc, pages, remaining, progressCalls, traceCalls : INTEGER;
  updateCalls, commitCalls, rollbackCalls, authCalls : INTEGER;
  ok : BOOLEAN;
  bin, out : ARRAY [0..7] OF CHAR;

PROCEDURE Say (s : ARRAY OF CHAR);
VAR
  buf : ARRAY [0..255] OF CHAR;
  i : INTEGER;
BEGIN
  i := 0;
  WHILE (i <= HIGH(buf)) AND (i <= HIGH(s)) AND (s[i] # CHR(0)) DO
    buf[i] := s[i];
    i := i + 1
  END;
  IF i <= HIGH(buf) THEN buf[i] := CHR(0) END;
  IF i > 0 THEN Write(buf) END
END Say;

PROCEDURE SayLn (s : ARRAY OF CHAR);
BEGIN
  Say(s); WriteLn
END SayLn;

PROCEDURE SayInt (n : INTEGER);
BEGIN
  WriteInt(n)
END SayInt;

PROCEDURE SayCS (s : CString);
VAR
  buf : ARRAY [0..255] OF CHAR;
BEGIN
  IF s = NIL THEN
    Say("NULL")
  ELSE
    IF Copy(s, buf) > 0 THEN Say(buf) END
  END
END SayCS;

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;

PROCEDURE SameBytes (a, b : ARRAY OF CHAR; n : INTEGER) : BOOLEAN;
VAR
  i : INTEGER;
BEGIN
  i := 0;
  WHILE (i < n) AND (a[i] = b[i]) DO i := i + 1 END;
  RETURN i = n
END SameBytes;

PROCEDURE OpenMemory (VAR h : ADDRESS) : BOOLEAN;
BEGIN
  h := NIL;
  RETURN sqlite3_open_v2(":memory:", h,
    SQLiteOpenReadWrite + SQLiteOpenCreate + SQLiteOpenMemory,
    NIL) = SQLiteOk
END OpenMemory;

PROCEDURE ExecSQL (sql : ARRAY OF CHAR) : BOOLEAN;
VAR
  errmsg : ADDRESS;
  good : BOOLEAN;
BEGIN
  errmsg := NIL;
  good := sqlite3_exec(db, sql, NIL, NIL, errmsg) = SQLiteOk;
  IF errmsg # NIL THEN sqlite3_free(errmsg) END;
  RETURN good
END ExecSQL;

PROCEDURE QueryInt (h : ADDRESS; sql : ARRAY OF CHAR; want : INTEGER) : BOOLEAN;
VAR
  s : ADDRESS;
  code, got : INTEGER;
  good : BOOLEAN;
BEGIN
  s := NIL; got := -777; good := FALSE;
  code := sqlite3_prepare_v2(h, sql, -1, s, NIL);
  IF (code = SQLiteOk) AND (s # NIL) THEN
    IF sqlite3_step(s) = SQLiteRow THEN
      got := sqlite3_column_int(s, 0);
      IF sqlite3_step(s) = SQLiteDone THEN good := TRUE END
    END;
    IF sqlite3_finalize(s) # SQLiteOk THEN good := FALSE END
  END;
  RETURN good AND (got = want)
END QueryInt;

PROCEDURE ExecCallback (sql : ARRAY OF CHAR; cb : ADDRESS) : BOOLEAN;
VAR
  errmsg : ADDRESS;
  good : BOOLEAN;
BEGIN
  errmsg := NIL;
  good := sqlite3_exec(db, sql, cb, NIL, errmsg) = SQLiteOk;
  IF errmsg # NIL THEN sqlite3_free(errmsg) END;
  RETURN good
END ExecCallback;

PROCEDURE Register (name : ARRAY OF CHAR; n : INTEGER;
                    user, fn : ADDRESS) : BOOLEAN;
BEGIN
  RETURN sqlite3_create_function_v2(db, name, n,
    SQLiteUtf8 + SQLiteDeterministic, user, fn, NIL, NIL, NIL)
    = SQLiteOk
END Register;

PROCEDURE RowPrinter (arg : ADDRESS; argc : INTEGER;
                      argv, colNames : ADDRESS) : INTEGER;
VAR
  i : INTEGER;
  s : CString;
  buf : ARRAY [0..127] OF CHAR;
BEGIN
  FOR i := 0 TO argc - 1 DO
    IF i > 0 THEN Say(" | ") END;
    s := SQLiteArrayAt(argv, i);
    IF s = NIL THEN
      Say("NULL")
    ELSIF Copy(s, buf) > 0 THEN
      Say(buf)
    END
  END;
  WriteLn;
  RETURN 0
END RowPrinter;

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 ProgressFn (arg : ADDRESS) : INTEGER;
BEGIN
  progressCalls := progressCalls + 1;
  RETURN 0
END ProgressFn;

PROCEDURE TraceFn (mask : CARDINAL; ctx, sql, expanded : ADDRESS) : INTEGER;
BEGIN
  traceCalls := traceCalls + 1;
  RETURN 0
END TraceFn;

PROCEDURE UpdateFn (arg : ADDRESS; op : INTEGER;
                    dbName, tableName : ADDRESS; rowid : LONGINT);
BEGIN
  updateCalls := updateCalls + 1
END UpdateFn;

PROCEDURE CommitFn (arg : ADDRESS) : INTEGER;
BEGIN
  commitCalls := commitCalls + 1;
  RETURN 0
END CommitFn;

PROCEDURE RollbackFn (arg : ADDRESS);
BEGIN
  rollbackCalls := rollbackCalls + 1
END RollbackFn;

PROCEDURE AuthFn (arg : ADDRESS; action : INTEGER;
                  dbName, tableName, colName, triggerName : ADDRESS) : INTEGER;
BEGIN
  authCalls := authCalls + 1;
  IF action = SQLiteAuthDelete THEN
    RETURN SQLiteAuthDeny
  ELSE
    RETURN SQLiteAuthOk
  END
END AuthFn;

BEGIN
  ExitCode := 1;
  db := NIL; dst := NIL; stmt := NIL; s1 := NIL; s2 := NIL;
  blob := NIL; bk := NIL; prev := NIL;
  progressCalls := 0; traceCalls := 0; updateCalls := 0;
  commitCalls := 0; rollbackCalls := 0; authCalls := 0;
  bin[0] := CHR(0); bin[1] := CHR(1); bin[2] := CHR(2);
  bin[3] := CHR(0); bin[4] := CHR(255);
  ok := FALSE;

  SayLn("SQLite V3 feature showcase");
  Say("libversion="); SayCS(sqlite3_libversion()); WriteLn;
  Say("version_number="); SayInt(sqlite3_libversion_number()); WriteLn;
  Say("threadsafe="); SayInt(sqlite3_threadsafe()); WriteLn;
  Say("complete="); SayInt(sqlite3_complete("SELECT 1;")); WriteLn;

  IF OpenMemory(db) THEN
    ok := sqlite3_extended_result_codes(db, 1) = SQLiteOk
  END;

  IF ok THEN
    ok := ExecSQL("CREATE TABLE people(id INTEGER, name TEXT, data BLOB);")
          AND ExecSQL("CREATE TABLE hook(id INTEGER PRIMARY KEY, v TEXT);")
  END;

  (* Prepared insert with named/anonymous parameter metadata. *)
  IF ok THEN
    stmt := NIL;
    rc := sqlite3_prepare_v2(db,
      "INSERT INTO people(name,data) VALUES(?,?);", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL)
          AND (sqlite3_bind_parameter_count(stmt) = 2)
          AND (sqlite3_bind_parameter_name(stmt, 1) = NIL)
          AND (sqlite3_bind_parameter_index(stmt, ":name") = 0);
    IF ok THEN
      Say("params="); SayInt(sqlite3_bind_parameter_count(stmt));
      Say(" index(:name)="); SayInt(sqlite3_bind_parameter_index(stmt, ":name"));
      WriteLn
    END;
    IF ok THEN
      ok := (sqlite3_bind_text(stmt, 1, "Ada", -1,
                               SQLiteTransient()) = SQLiteOk)
            AND (sqlite3_bind_blob(stmt, 2, ADR(bin[0]), 3,
                                   SQLiteTransient()) = SQLiteOk)
    END;
    IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
    IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
    IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;
    IF ok THEN
      ok := (sqlite3_bind_text(stmt, 1, "Grace", -1,
                               SQLiteTransient()) = SQLiteOk)
            AND (sqlite3_bind_null(stmt, 2) = SQLiteOk)
    END;
    IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
    IF ok THEN ok := sqlite3_reset(stmt) = SQLiteOk END;
    IF ok THEN ok := sqlite3_clear_bindings(stmt) = SQLiteOk END;
    IF ok THEN
      ok := (sqlite3_bind_text(stmt, 1, "Blob", -1,
                               SQLiteTransient()) = SQLiteOk)
            AND (sqlite3_bind_zeroblob(stmt, 2, 8) = SQLiteOk)
    END;
    IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
    IF ok THEN
      Say("rows inserted, changes="); SayInt(sqlite3_changes(db));
      Say(" total="); SayInt(sqlite3_total_changes(db)); WriteLn
    END;
    IF stmt # NIL THEN
      IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
      stmt := NIL
    END
  END;

  (* Row callback output. *)
  IF ok THEN
    SayLn("people:");
    ok := ExecCallback("SELECT rowid,name FROM people ORDER BY rowid;",
                       ADR(RowPrinter))
  END;

  (* User-defined scalar function. *)
  IF ok THEN
    ok := Register("m2_add", 2, NIL, ADR(AddFn))
          AND QueryInt(db, "SELECT m2_add(20,22);", 42);
    IF ok THEN
      Say("m2_add(20,22)=42"); WriteLn
    END
  END;

  (* Statement metadata and expanded SQL. *)
  IF ok THEN
    stmt := NIL;
    rc := sqlite3_prepare_v2(db, "SELECT ?;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL)
          AND (sqlite3_bind_int(stmt, 1, 42) = SQLiteOk);
    IF ok THEN
      Say("sql="); SayCS(sqlite3_sql(stmt));
      Say(" readonly="); SayInt(sqlite3_stmt_readonly(stmt));
      WriteLn;
      prev := sqlite3_expanded_sql(stmt);
      Say("expanded="); SayCS(prev); WriteLn;
      IF prev # NIL THEN sqlite3_free(prev); prev := NIL END
    END;
    IF ok THEN ok := sqlite3_step(stmt) = SQLiteRow END;
    IF ok THEN
      Say("busy_after_row="); SayInt(sqlite3_stmt_busy(stmt));
      Say(" vm_steps="); SayInt(sqlite3_stmt_status(stmt,
        SQLiteStmtStatusVmStep, 0)); WriteLn
    END;
    IF ok THEN ok := sqlite3_step(stmt) = SQLiteDone END;
    IF stmt # NIL THEN
      IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
      stmt := NIL
    END
  END;

  (* Statement iteration. *)
  IF ok THEN
    s1 := NIL; s2 := NIL;
    ok := (sqlite3_prepare_v2(db, "SELECT 1;", -1, s1, NIL) = SQLiteOk)
          AND (sqlite3_prepare_v2(db, "SELECT 2;", -1, s2, NIL) = SQLiteOk);
    IF ok THEN
      rc := 0;
      prev := sqlite3_next_stmt(db, NIL);
      WHILE prev # NIL DO
        rc := rc + 1;
        prev := sqlite3_next_stmt(db, prev)
      END;
      Say("open statements="); SayInt(rc); WriteLn;
      ok := rc = 2
    END;
    IF s1 # NIL THEN
      IF sqlite3_finalize(s1) # SQLiteOk THEN ok := FALSE END;
      s1 := NIL
    END;
    IF s2 # NIL THEN
      IF sqlite3_finalize(s2) # SQLiteOk THEN ok := FALSE END;
      s2 := NIL
    END
  END;

  (* Column BLOB metadata. *)
  IF ok THEN
    stmt := NIL;
    rc := sqlite3_prepare_v2(db,
      "SELECT data FROM people WHERE rowid=1;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL)
          AND (sqlite3_step(stmt) = SQLiteRow)
          AND (sqlite3_column_type(stmt, 0) = SQLiteBlob)
          AND (sqlite3_column_bytes(stmt, 0) = 3)
          AND (sqlite3_column_blob(stmt, 0) # NIL);
    IF ok THEN
      Say("column BLOB bytes=3"); WriteLn
    END;
    IF stmt # NIL THEN
      IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
      stmt := NIL
    END
  END;

  (* Incremental BLOB round trip. *)
  IF ok THEN
    blob := NIL;
    rc := sqlite3_blob_open(db, "main", "people", "data", 3,
                            SQLiteBlobReadWrite, blob);
    ok := (rc = SQLiteOk) AND (blob # NIL)
          AND (sqlite3_blob_bytes(blob) = 8)
          AND (sqlite3_blob_write(blob, ADR(bin[0]), 3, 0) = SQLiteOk)
          AND (sqlite3_blob_read(blob, ADR(out[0]), 3, 0) = SQLiteOk)
          AND SameBytes(bin, out, 3);
    IF ok THEN
      Say("incremental BLOB bytes=8 roundtrip=OK"); WriteLn
    END;
    IF blob # NIL THEN
      IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END;
      blob := NIL
    END
  END;

  (* Autocommit state. *)
  IF ok THEN
    Say("autocommit="); SayInt(sqlite3_get_autocommit(db));
    ok := ExecSQL("BEGIN;");
    IF ok THEN
      Say(" in_txn="); SayInt(sqlite3_get_autocommit(db));
      ok := ExecSQL("COMMIT;")
    END;
    IF ok THEN
      Say(" after_commit="); SayInt(sqlite3_get_autocommit(db)); WriteLn
    END
  END;

  (* Progress and trace hooks. *)
  IF ok THEN
    progressCalls := 0;
    sqlite3_progress_handler(db, 1, ADR(ProgressFn), NIL);
    ok := QueryInt(db, "SELECT count(*) FROM people;", 3)
          AND (progressCalls > 0);
    sqlite3_progress_handler(db, 0, NIL, NIL);
    Say("progress calls="); SayInt(progressCalls); WriteLn
  END;
  IF ok THEN
    traceCalls := 0;
    ok := sqlite3_trace_v2(db, SQLiteTraceStmt,
                           ADR(TraceFn), NIL) = SQLiteOk;
    IF ok THEN ok := QueryInt(db, "SELECT 1;", 1) AND (traceCalls > 0) END;
    IF ok THEN ok := sqlite3_trace_v2(db, 0, NIL, NIL) = SQLiteOk END;
    Say("trace calls="); SayInt(traceCalls); WriteLn
  END;

  (* Update / commit / rollback hooks. *)
  IF ok THEN
    updateCalls := 0;
    prev := sqlite3_update_hook(db, ADR(UpdateFn), NIL);
    ok := ExecSQL("INSERT INTO hook(v) VALUES('a');")
          AND ExecSQL("UPDATE hook SET v='b' WHERE id=1;")
          AND ExecSQL("DELETE FROM hook WHERE id=1;")
          AND (updateCalls = 3);
    prev := sqlite3_update_hook(db, NIL, NIL);
    Say("update events="); SayInt(updateCalls); WriteLn
  END;
  IF ok THEN
    commitCalls := 0; rollbackCalls := 0;
    prev := sqlite3_commit_hook(db, ADR(CommitFn), NIL);
    sqlite3_rollback_hook(db, ADR(RollbackFn), NIL);
    ok := ExecSQL("BEGIN; INSERT INTO hook(v) VALUES('c'); COMMIT;")
          AND (commitCalls = 1)
          AND ExecSQL("BEGIN; INSERT INTO hook(v) VALUES('d'); ROLLBACK;")
          AND (rollbackCalls = 1);
    prev := sqlite3_commit_hook(db, NIL, NIL);
    sqlite3_rollback_hook(db, NIL, NIL);
    Say("commit="); SayInt(commitCalls);
    Say(" rollback="); SayInt(rollbackCalls); WriteLn
  END;

  (* Authorizer denies DELETE. *)
  IF ok THEN
    authCalls := 0;
    ok := sqlite3_set_authorizer(db, ADR(AuthFn), NIL) = SQLiteOk;
    IF ok THEN
      prev := NIL;
      rc := sqlite3_exec(db, "DELETE FROM hook;", NIL, NIL, prev);
      IF prev # NIL THEN sqlite3_free(prev); prev := NIL END;
      ok := (rc = SQLiteAuth) AND (authCalls > 0);
      Say("authorizer delete rc="); SayInt(rc); WriteLn
    END;
    IF sqlite3_set_authorizer(db, NIL, NIL) # SQLiteOk THEN ok := FALSE END
  END;

  (* Constraint error and errmsg ownership. *)
  IF ok THEN
    ok := ExecSQL("CREATE TABLE u(v TEXT UNIQUE);")
          AND ExecSQL("INSERT INTO u VALUES('x');");
    IF ok THEN
      prev := NIL;
      rc := sqlite3_exec(db, "INSERT INTO u VALUES('x');", NIL, NIL, prev);
      ok := (rc # SQLiteOk) AND (sqlite3_extended_errcode(db) = 2067);
      Say("constraint rc="); SayInt(rc);
      Say(" msg="); SayCS(prev); WriteLn;
      IF prev # NIL THEN sqlite3_free(prev); prev := NIL END
    END
  END;

  (* Online backup. *)
  IF ok THEN
    ok := OpenMemory(dst);
    IF ok THEN
      bk := sqlite3_backup_init(dst, "main", db, "main");
      ok := bk # NIL;
      IF ok THEN
        ok := sqlite3_backup_step(bk, -1) = SQLiteDone;
        IF ok THEN
          pages := sqlite3_backup_pagecount(bk);
          remaining := sqlite3_backup_remaining(bk);
          ok := (pages > 0) AND (remaining = 0)
        END;
        IF sqlite3_backup_finish(bk) # SQLiteOk THEN ok := FALSE END;
        bk := NIL
      END
    END;
    IF ok THEN
      ok := QueryInt(dst, "SELECT count(*) FROM people;", 3);
      Say("backup pages="); SayInt(pages);
      Say(" remaining="); SayInt(remaining); WriteLn
    END
  END;

  (* Close status and cleanup. *)
  IF ok THEN
    stmt := NIL;
    rc := sqlite3_prepare_v2(db, "SELECT 1;", -1, stmt, NIL);
    ok := (rc = SQLiteOk) AND (stmt # NIL);
    IF ok THEN
      rc := sqlite3_close(db);
      Say("close with statement="); SayInt(rc); WriteLn;
      ok := rc = SQLiteBusy
    END;
    IF stmt # NIL THEN
      IF sqlite3_finalize(stmt) # SQLiteOk THEN ok := FALSE END;
      stmt := NIL
    END
  END;

  IF blob # NIL THEN
    IF sqlite3_blob_close(blob) # SQLiteOk THEN ok := FALSE END
  END;
  IF bk # NIL THEN
    IF sqlite3_backup_finish(bk) # SQLiteOk THEN ok := FALSE END
  END;
  IF dst # NIL THEN
    IF sqlite3_close_v2(dst) # SQLiteOk THEN ok := FALSE END
  END;
  IF db # NIL THEN
    IF sqlite3_close(db) # SQLiteOk THEN ok := FALSE END
  END;
  IF ok THEN
    SayLn("done");
    ExitCode := 42
  ELSE
    SayLn("FAIL")
  END
END SQLiteFeatureShowcase.