├── .clang-format ├── .editorconfig ├── .github ├── dependabot.yml └── workflows │ └── main.yml ├── .gitignore ├── .markdownlint.json ├── .ocamlformat ├── CHANGELOG.md ├── LICENSE.md ├── Makefile ├── README.md ├── TODO.md ├── dune ├── dune-project ├── lib ├── Makefile ├── config │ ├── Makefile │ ├── discover.ml │ └── dune ├── dune ├── sqlite3.ml ├── sqlite3.mli └── sqlite3_stubs.c ├── sqlite3.opam └── test ├── Makefile ├── dune ├── test_agg.ml ├── test_backup.ml ├── test_collation.ml ├── test_db.ml ├── test_error.ml ├── test_exec.ml ├── test_fun.ml ├── test_stmt.ml ├── test_values.ml └── test_win.ml /.clang-format: -------------------------------------------------------------------------------- 1 | BasedOnStyle: LLVM 2 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig: https://EditorConfig.org 2 | 3 | # Top-most EditorConfig file 4 | root = true 5 | 6 | # Default settings for all files 7 | [*] 8 | charset = utf-8 9 | end_of_line = lf 10 | insert_final_newline = true 11 | trim_trailing_whitespace = true 12 | indent_style = space 13 | indent_size = 2 14 | max_line_length = 80 15 | 16 | # Makefile 17 | [Makefile] 18 | # Makefiles require tabs instead of spaces 19 | indent_style = tab 20 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # To get started with Dependabot version updates, you'll need to specify which 2 | # package ecosystems to update and where the package manifests are located. 3 | # Please see the documentation for all configuration options: 4 | # https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file 5 | 6 | version: 2 7 | updates: 8 | - package-ecosystem: github-actions 9 | directory: "/" # Location of package manifests 10 | schedule: 11 | interval: "weekly" 12 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Builds, tests & co 2 | 3 | on: 4 | - pull_request 5 | - push 6 | - workflow_dispatch 7 | 8 | permissions: read-all 9 | 10 | jobs: 11 | build: 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | - macos-latest 18 | # - windows-latest 19 | 20 | runs-on: ${{ matrix.os }} 21 | 22 | steps: 23 | - name: Checkout tree 24 | uses: actions/checkout@v4 25 | 26 | - name: Set-up OCaml 27 | uses: ocaml/setup-ocaml@v3 28 | with: 29 | ocaml-compiler: 5 30 | 31 | - run: opam install . --deps-only --with-test 32 | 33 | - run: opam exec -- dune build 34 | 35 | - run: opam exec -- dune runtest 36 | 37 | lint-doc: 38 | runs-on: ubuntu-latest 39 | steps: 40 | - name: Checkout tree 41 | uses: actions/checkout@v4 42 | - name: Set-up OCaml 43 | uses: ocaml/setup-ocaml@v3 44 | with: 45 | ocaml-compiler: 5 46 | - uses: ocaml/setup-ocaml/lint-doc@v3 47 | 48 | lint-fmt: 49 | runs-on: ubuntu-latest 50 | steps: 51 | - name: Checkout tree 52 | uses: actions/checkout@v4 53 | - name: Set-up OCaml 54 | uses: ocaml/setup-ocaml@v3 55 | with: 56 | ocaml-compiler: 5 57 | - uses: ocaml/setup-ocaml/lint-fmt@v3 58 | 59 | lint-opam: 60 | runs-on: ubuntu-latest 61 | steps: 62 | - name: Checkout tree 63 | uses: actions/checkout@v4 64 | - name: Set-up OCaml 65 | uses: ocaml/setup-ocaml@v3 66 | with: 67 | ocaml-compiler: 5 68 | - uses: ocaml/setup-ocaml/lint-opam@v3 69 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .*.swp 2 | .merlin 3 | *.install 4 | _build 5 | -------------------------------------------------------------------------------- /.markdownlint.json: -------------------------------------------------------------------------------- 1 | { 2 | "no-duplicate-heading": { 3 | "siblings_only": true 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.27.0 2 | profile = conventional 3 | 4 | # Default overrides 5 | wrap-comments = true 6 | parse-docstrings = true 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## [5.3.1] - 2025-03-07 4 | 5 | - Made reference counting of database handles atomic for thread-safety. Thanks 6 | to Christoph Wintersteiger for the suggestion, and to `o3-mini-high` for 7 | finding a reference counting bug when handling exceptions. 8 | - Fixed collation link freeing bug. Thanks to `o3-mini-high` for suggesting the 9 | fix without even being prompted (minus-shot). 10 | - Removed obsolete compiler flags. OCaml already passes optimization flags, and 11 | flags for position-independent code should not be necessary. Thanks to Jonah 12 | Beckford for the contribution. 13 | 14 | ## [5.3.0] - 2025-01-20 15 | 16 | ### Added 17 | 18 | - Collation support. Thanks to Gusted. 19 | 20 | ### Changed 21 | 22 | - Builds now respect `$PKG_CONFIG`. Thanks to Antonio Nuno Monteiro. 23 | 24 | ## [5.2.0] - 2024-08-01 25 | 26 | ### Added 27 | 28 | - Support for MSVC compiler. Thanks to Jonah Beckford. 29 | - `extended_errcode_int` function. Thanks to Petter A. Urkedal. 30 | - GitHub CI. Thanks to Yilin Wei. 31 | - `.editorconfig`. 32 | 33 | ### Fixed 34 | 35 | - Memory allocation in `caml_sqlite3_backup_init()`. Thanks to Mark Elvers, 36 | Pierre Boutillier, and Benjamin Canou. 37 | - Shadowing of `agg_ctx` when using `sizeof`. 38 | - Switch syntax error flagged by cppcheck. 39 | 40 | ### Changed 41 | 42 | - Detect pkgconf on Windows/mingw. Thanks to Mark Elvers, reviewed by Shon 43 | Feder. 44 | - Formatted sources using `ocamlformat` and `clang-format`. 45 | - Improved API documentation formatting. 46 | - Enhanced README, license file, copyright notices, and changelog format. 47 | - Removed superfluous macro conditions. 48 | 49 | ## [5.1.0] - 2021-09-22 50 | 51 | ### Added 52 | 53 | - `let&`-operator for implicit closing of an opened database. Thanks to Yawar 54 | Amin . 55 | 56 | ## [5.0.3] - 2021-03-18 57 | 58 | ### Fixed 59 | 60 | - Missing GC registration of init values in aggregate functions. 61 | - Call to final aggregate function when not calling step function. 62 | - Incorrect required OCaml version (now 4.12). 63 | 64 | ## [5.0.2] - 2020-07-30 65 | 66 | ### Added 67 | 68 | - Missing `dune-configurator` dependency. 69 | - Support for const char strings in stubs due to stricter handling in newer 70 | OCaml runtimes, eliminating C-compiler warnings. 71 | 72 | ### Changed 73 | 74 | - Removed redundant build dependencies. 75 | - Use `caml_alloc_initialized_string` wherever possible. 76 | - Fixed documentation typos and wording. 77 | 78 | ## [5.0.1] - 2019-12-01 79 | 80 | ### Added 81 | 82 | - Missing :with-test declaration in Dune project file. 83 | 84 | ### Improved 85 | 86 | - Portability to older SQLite3 versions. 87 | 88 | ## [5.0.0] - 2019-12-01 89 | 90 | ### Breaking 91 | 92 | - `Data.to_string` is now `Data.to_string_coerce`. 93 | 94 | ### Added 95 | 96 | - Support for SQLite3 window functions. 97 | - `Sqlite3.Rc.check` and `Sqlite3.Rc.is_success` for easier return code 98 | checking. 99 | - `Sqlite3.prepare_or_reset` for reusing prepared statements in loops. 100 | - `Sqlite3.iter` and `Sqlite3.fold` for more convenient handling of row data. 101 | - More data conversion and binding functions. 102 | 103 | ### Improved 104 | 105 | - Closing behavior of database using new SQLite3 API. 106 | - Testing framework using `ppx_inline_test`. 107 | - Each test case now has its own database for parallel testing. 108 | - Compatibility with older OCaml versions. Thanks to Simon Cruanes. 109 | 110 | ### Changed 111 | 112 | - Switched from `caml_alloc_custom` to `caml_alloc_custom_mem`. 113 | - Switched to OPAM file generation via `dune-project`. 114 | 115 | Thanks to Shawn and Ted Spence . 116 | 117 | ## [4.4.1] - 2018-10-25 118 | 119 | ### Changed 120 | 121 | - Switched to dune, dune-release, and OPAM 2.0. 122 | 123 | ## [4.4.0] - 2018-04-26 124 | 125 | ### Added 126 | 127 | - Support for new open flags: `uri` and `memory`. Thanks to Raman Varabets. 128 | 129 | ### Fixed 130 | 131 | - Warnings and errors in configuration code due to upstream changes. 132 | 133 | ## [4.3.2] - 2017-11-27 134 | 135 | ### Added 136 | 137 | - Missing -lpthread linking flag. 138 | 139 | ## [4.3.1] - 2017-11-22 140 | 141 | ### Improved 142 | 143 | - Finalization of databases and statements for better performance. 144 | 145 | ## [4.3.0] - 2017-10-10 146 | 147 | ### Improved 148 | 149 | - Compatibility with MSVC. 150 | 151 | ### Changed 152 | 153 | - Used untagging and unboxing attributes on external functions. 154 | 155 | ## [4.2.0] - 2017-08-03 156 | 157 | ### Added 158 | 159 | - Backup functionality. Thanks to Markus W. Weissmann 160 | . 161 | 162 | ### Changed 163 | 164 | - Switched to jbuilder and topkg. 165 | 166 | ## Changes Before Version 4.2.0 167 | 168 | ```text 169 | 2017-06-11: Fixed return value bug in enable_load_extension. The result 170 | was the opposite of what the API documentation says. 171 | 172 | 2017-01-04: Added external dependency to OPAM spec for openSUSE support. 173 | 174 | 2017-01-03: Fixed incorrect LGPL license reference in Oasis specification. 175 | The software is actually distributed under the Expat-license. 176 | 177 | 2016-12-15: Added new functions for more efficient and convenient blob access: 178 | 179 | * column_blob 180 | * row_blobs 181 | 182 | Thanks to Nicolas Ojeda Bar 183 | for this patch. 184 | 185 | 2016-10-07: Some portability improvements and Travis integration 186 | 187 | Thanks to Leonid Rozenberg for his Travis work. 188 | 189 | 2016-06-14: Changed default configuration setting for loadable extensions 190 | on Mac OS X. Due to frequent installation issues the default 191 | setting is now to turn off loadable extensions on that platform. 192 | You will have to explicitly turn them on if you need them. 193 | 194 | 2016-05-24: Fixed a bug finalizing user-defined functions for a database. 195 | 196 | Thanks to Mark Bradley for this patch. 197 | 198 | 2015-11-18: More build process improvements for Homebrew users. 199 | 200 | Thanks to Leonid Rozenberg for this patch. 201 | 202 | 2015-11-05: Improved build process for Homebrew users. 203 | 204 | Thanks to Leonid Rozenberg for this patch. 205 | 206 | 2015-09-02: Major API change that is compatible with major release series 2: 207 | 208 | We can now return errors from user-defined SQL-functions by raising 209 | (arbitrary) exceptions. This somewhat tricky internal change 210 | eliminates the need for Data.ERROR and reestablishes compatibility 211 | with major release series 2. 212 | 213 | Sorry for the churn, but the more elegant solution was not obvious. 214 | 215 | 2015-08-29: Added user function error handling (major API change). 216 | 217 | Thanks to Joseph Young for this patch. 218 | 219 | 2015-01-29: Fixed a build problem due to Oasis/ocamlbuild inconsistency. 220 | 221 | Thanks to Leonid Rozenberg for this patch. 222 | 223 | 2014-10-08: Fixed a callback locking bug when encountering rows containing 224 | unexpected NULLs. 225 | 226 | Thanks to for this patch. 227 | 228 | 2014-07-04: Moved to GitHub. 229 | 230 | 2012-12-02: Added new functions 231 | 232 | * sleep 233 | * clear_bindings 234 | 235 | Old operating system distributions may have had problems linking 236 | these functions, but reasonably recent ones support them. 237 | 238 | 2012-11-19: Added missing .mldylib file for shared library support. 239 | 240 | Thanks to Hugo Heuzard for the bug report. 241 | 242 | 2012-07-20: Downgraded findlib version constraint to support the Debian 243 | testing branch. 244 | 245 | 2012-07-16: Replaced String.trim function in myocamlbuild.ml to allow 246 | compiling with OCaml 3.12.1. 247 | 248 | 2012-07-15: New major release version 2.0.0: 249 | 250 | * Upgraded to OCaml 4.00 251 | * Switched to Oasis for packaging 252 | * Switched to OCamlBuild for the build process 253 | * Rewrote README in Markdown 254 | * Added stricter compilation flags 255 | 256 | 2012-05-19: Fixed cpp warnings and removed superfluous check for dynamic 257 | linking library. The latter improves portability to FreeBSD. 258 | 259 | Thanks to Stéphane Legrand for the bug report. 260 | 261 | 2011-03-10: Added sqlite3_open_v2 functionality. 262 | 263 | Thanks to Mike Lin for the initial patch. 264 | 265 | 2010-12-20: Fixed linking problem with loadable module support. 266 | 267 | Thanks to Adrien Nader for the patch. 268 | 269 | 2010-09-18: Fixed segfault related to incorrect handling of exceptions raised 270 | from user callbacks. 271 | 272 | Thanks to William Le Ferrand for the bug 273 | report. 274 | 275 | 2009-12-15: Fixed segfault related to exceptions raised from C. 276 | 277 | Thanks to Gareth Smith for the 278 | bug report. 279 | 280 | 2009-09-14: Fixed build problem. 281 | 282 | 2009-09-13: Removed deprecated functions and improved build process. 283 | 284 | 2009-09-08: Added "changes" function. 285 | 286 | Thanks to for this patch. 287 | 288 | 2009-08-22: enable_load_extension now raises an exception if unsupported. 289 | 290 | 2009-07-28: Added better support for compiling with MSVC and ocamlbuild. 291 | 292 | Thanks to for this patch. 293 | 294 | 2009-05-23: Fixed example to be consistent with new API. 295 | 296 | 2009-05-16: Fixed mishandling of OCaml-runtime lock when callbacks raise 297 | exceptions, and handle NULL-pointer results when getting column 298 | type declarations. 299 | 300 | Thanks to Bruno Daniel for this patch. 301 | 302 | Changed API to expose optional results. 303 | 304 | 2009-03-09: Fixed potential build problem. 305 | 306 | 2009-03-01: Added support for user-defined aggregate functions. 307 | 308 | Thanks to Anil Madhavapeddy for the initial 309 | version of the patch. 310 | 311 | 2009-02-21: Added new function: 312 | 313 | * busy_timeout 314 | 315 | Thanks to Paolo Donadeo for the patch. 316 | 317 | 2009-01-05: Switched to generational global root registration of 318 | callbacks for better performance. 319 | 320 | Requires OCaml 3.11 or higher. 321 | 322 | 2008-12-02: Added function enable_load_extension if available. 323 | 324 | Thanks to Pietro Abate for 325 | the patch. 326 | 327 | 2008-05-11: Added function column_count, used it internally in place of 328 | data_count, and improved documentation of associated 329 | functions. 330 | 331 | Thanks to James Cheney for the patch. 332 | 333 | 2008-05-07: Renamed Data.to_string to Data.to_string_debug for converting 334 | fields to strings with their data constructor. Replaced the 335 | previous function with one that behaves more like users 336 | would expect. Thanks to Stefano Zacchiroli 337 | for the suggestion. 338 | 339 | 2008-04-18: Improved backwards compatibility to older versions of SQLite. 340 | 341 | 2008-04-04: Fixed a build problem on Mac OS X. 342 | 343 | 2008-03-27: Fixed a build problem on FreeBSD. 344 | 345 | Thanks to Jaap Boender for 346 | the patch. 347 | 348 | 2008-03-14: Synced with Jane Street tree. 349 | 350 | 2008-03-05: Added a patch to improve Windows support. Thanks to Alain 351 | Frisch for the patch. 352 | 353 | 2007-09-04: Fixed a minor bug converting status codes. 354 | 355 | 2007-08-20: Fixed a GC-bug related to user-defined SQL-functions. 356 | 357 | Thanks to Enrico Tassi for the 358 | test case to replicate this problem. 359 | 360 | 2007-06-17: Added support for user-defined scalar functions. Thanks to 361 | Enrico Tassi for the patch. 362 | 363 | Switched to sqlite3_prepare_v2 internally to avoid the older, 364 | deprecated sqlite3_prepare-function. Thanks to Gabriel 365 | Kerneis for the hint. 366 | 367 | Removed exec_sql-function, which was buggy in the last 368 | release anyway (thanks to Paul Stodghill 369 | for pointing this out). Its interface hides too much 370 | important information from the user (e.g. BUSY-steps, etc.). 371 | It did not seem possible to design a function that made 372 | it as simple as exec_sql to run an SQL-statement without 373 | inviting the user to write buggy/incomplete code, or that 374 | wouldn't make the interface almost as complicated as 375 | writing the correct code that handles all cases by oneself. 376 | 377 | 2007-05-07: Further GC-bug fixes. There was a design bug in the library 378 | that was causing all these GC issues (C-structs allocated in the 379 | OCaml-heap). This seemed safe (and more efficient) to the initial 380 | author, but after extensive checking it became obvious that this 381 | does not work if C-structs reference each other, because the GC 382 | might move these memory regions. Allocations of C-structs and 383 | using indirections to access them seems safer with "malloc". 384 | 385 | 2007-05-04: Fixed GC-bugs, and improved thread interaction. 386 | 387 | 2007-04-23: callback_exn -> caml_callback_exn. 388 | 389 | 2007-03-30: Fixed a GC-bug. 390 | 391 | 2007-03-19: Fixed an installation problem on Cygwin. 392 | 393 | Thanks to James Cheney for the hint. 394 | 395 | 2007-02-27: Small API-change: the callback for exec is now an optional 396 | argument. 397 | 398 | Added three more "exec"-functions, which do or do not take 399 | headers or handle NULL-values. 400 | 401 | Improved quality of C-code (removed warnings). 402 | 403 | 2007-02-23: Fixed a bug in the "db_close"-function. Improved documentation. 404 | 405 | 2007-02-19: Added check for out of memory after malloc. 406 | 407 | 2007-01-31: Fixed build problem on x86_64: added -fPIC flag to compilation 408 | of C-stubs. 409 | 410 | 2007-01-17: Complete rewrite by Markus Mottl . 411 | 412 | 2005-04-xx: Initial coding (0.1) by 413 | Christian Szegedy . 414 | ``` 415 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # The MIT License (MIT) 2 | 3 | © 2010 Markus Mottl 4 | © 2007 Jane Street Holding, LLC 5 | © 2007 Enrico Tassi 6 | © 2005 Christian Szegedy 7 | 8 | Permission is hereby granted, free of charge, to any person 9 | obtaining a copy of this software and associated documentation 10 | files (the "Software"), to deal in the Software without 11 | restriction, including without limitation the rights to use, 12 | copy, modify, merge, publish, distribute, sublicense, and/or sell 13 | copies of the Software, and to permit persons to whom the 14 | Software is furnished to do so, subject to the following 15 | conditions: 16 | 17 | The above copyright notice and this permission notice shall be 18 | included in all copies or substantial portions of the Software. 19 | 20 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 21 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 22 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 23 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 24 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 25 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 26 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 27 | OTHER DEALINGS IN THE SOFTWARE. 28 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean doc 2 | 3 | all: 4 | dune build @install 5 | 6 | clean: 7 | dune clean 8 | 9 | doc: 10 | dune build @doc 11 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SQLite3-OCaml - SQLite3 Bindings for OCaml 2 | 3 | ## What is SQLite3-OCaml? 4 | 5 | SQLite3-OCaml is an [OCaml](http://www.ocaml.org) library with bindings to the 6 | [SQLite3](http://www.sqlite.org) client API. Sqlite3 is a self-contained, 7 | serverless, zero-configuration, transactional SQL database engine with 8 | outstanding performance. 9 | 10 | The design of these bindings allows for a friendly coexistence with the old 11 | (version 2) SQLite and its OCaml wrapper `ocaml-sqlite`. 12 | 13 | ## Usage 14 | 15 | The API documentation is in file `src/sqlite3.mli` and also here: 16 | [online](http://mmottl.github.io/sqlite3-ocaml/api/sqlite3). 17 | 18 | SQLite3 has its own [online documentation](http://www.sqlite.org/docs.html). 19 | 20 | ### Examples 21 | 22 | The `test`-directory in this distribution contains simple examples for 23 | testing features of this library. You can execute the tests by running: 24 | `dune runtest`. 25 | 26 | ### Build issues 27 | 28 | SQLite3-OCaml depends on `pkg-config` to locate and compile against an 29 | [SQLite3](http://www.sqlite.org) library. 30 | 31 | If the SQLite3 version is greater than or equal to 3.3.7, the assumption is that 32 | it supports [Run-Time Loadable Extensions](http://www.sqlite.org/loadext.html). 33 | If this feature has been explicitly disabled in the library, building 34 | applications will fail with something like: 35 | 36 | ```text 37 | Undefined symbols for architecture …: 38 | "_sqlite3_enable_load_extension", referenced from: 39 | _caml_sqlite3_enable_load_extension in libsqlite3_stubs.a(sqlite3_stubs.o) 40 | ``` 41 | 42 | - You can check if your library is missing loadable extensions by searching 43 | it for the string `OMIT_LOAD_EXTENSION`. 44 | 45 | - If you need to change where `pkg-config` will look for the SQLite3 46 | library, set the `PKG_CONFIG_PATH` environment variable to the new 47 | directory. Setting the `SQLITE3_OCAML_BREWCHECK` environment variable 48 | automates this. This will instruct the build to check for the installation 49 | of a _brewed_ version of SQLite and route `pkg-config` appropriately. 50 | 51 | - You can explicitly disable run-time loadable extensions by calling 52 | `configure` with the flag `--disable-loadable-extensions` or by setting 53 | the environment variable `SQLITE3_DISABLE_LOADABLE_EXTENSIONS` if linking 54 | problems persist. 55 | 56 | - Due to frequent installation issues with loadable extensions on Mac OS X, 57 | the default there is to disable them. You will have to explicitly enable 58 | them on that platform. 59 | 60 | ## Credits 61 | 62 | - Mikhail Fedotov wrote ocaml-sqlite for SQLite version 2. His bindings 63 | served as a reference for this wrapper, but SQLite3 is a complete rewrite. 64 | 65 | - Christian Szegedy wrote the initial release for SQLite version 3. 66 | 67 | - Markus Mottl rewrote Christian's bindings for Jane Street Holding, LLC to 68 | clean up some issues and to make it perform better in multi-threaded 69 | environments. 70 | 71 | - Enrico Tassi contributed support for user-defined scalar functions. 72 | 73 | - Markus W. Weissmann contributed backup functionality. 74 | 75 | ## Contact Information and Contributing 76 | 77 | Please submit bugs reports, feature requests, contributions to the 78 | [GitHub issue tracker](https://github.com/mmottl/sqlite3-ocaml/issues). 79 | 80 | Up-to-date information is available at: 81 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # TODO 2 | 3 | - More testing 4 | 5 | - An even higher level function for execution of queries in a more 6 | convenient way. It should handle busy queries and expired statements 7 | automatically. 8 | 9 | - Add the following wrappers: 10 | 11 | - Better SQL Function support (aggregating ones) 12 | - Authorization support 13 | - Trace/profile support 14 | - progress handler support 15 | - commit hook support 16 | - global_recover, get_autocommit, db_handle, temp_directory 17 | - encryption support (not in SQLite anyway) 18 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -w -9 -principal)) 5 | (c_flags 6 | (:standard -Wall -pedantic -Wextra -Wunused))) 7 | (release 8 | (ocamlopt_flags 9 | (:standard -O3)))) 10 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | (name sqlite3) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github mmottl/sqlite3-ocaml)) 9 | 10 | (license MIT) 11 | 12 | (homepage "https://mmottl.github.io/sqlite3-ocaml") 13 | 14 | (documentation "https://mmottl.github.io/sqlite3-ocaml/api") 15 | 16 | (maintainers "Markus Mottl ") 17 | 18 | (authors "Markus Mottl " 19 | "Christian Szegedy ") 20 | 21 | (package 22 | (name sqlite3) 23 | (synopsis "SQLite3 bindings for OCaml") 24 | (description 25 | "sqlite3-ocaml is an OCaml library with bindings to the SQLite3 client API.\nSqlite3 is a self-contained, serverless, zero-configuration, transactional SQL\ndatabase engine with outstanding performance for many use cases.") 26 | (depends 27 | (ocaml 28 | (>= 4.12)) 29 | dune-configurator 30 | (conf-sqlite3 :build) 31 | (ppx_inline_test :with-test)) 32 | (tags 33 | (clib:sqlite3 clib:pthread))) 34 | -------------------------------------------------------------------------------- /lib/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = sqlite3.cma libsqlite3_stubs.a 2 | 3 | .PHONY: all clean 4 | 5 | all: 6 | @dune build $(TARGETS) 7 | 8 | clean: 9 | @dune clean 10 | -------------------------------------------------------------------------------- /lib/config/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = discover.bc 2 | 3 | .PHONY: all clean 4 | 5 | all: 6 | @dune build $(TARGETS) 7 | 8 | clean: 9 | @dune clean 10 | -------------------------------------------------------------------------------- /lib/config/discover.ml: -------------------------------------------------------------------------------- 1 | exception Finally_raised of exn 2 | 3 | let protect ~(finally : unit -> unit) work = 4 | let finally_no_exn () = 5 | try finally () 6 | with e -> 7 | let bt = Printexc.get_raw_backtrace () in 8 | Printexc.raise_with_backtrace (Finally_raised e) bt 9 | in 10 | match work () with 11 | | result -> 12 | finally_no_exn (); 13 | result 14 | | exception work_exn -> 15 | let work_bt = Printexc.get_raw_backtrace () in 16 | finally_no_exn (); 17 | Printexc.raise_with_backtrace work_exn work_bt 18 | 19 | let read_lines_from_cmd ~max_lines cmd = 20 | let ic = 21 | try Unix.open_process_in cmd 22 | with exc -> 23 | Printf.eprintf "read_lines_from_cmd: could not open cmd: '%s'" cmd; 24 | raise exc 25 | in 26 | protect 27 | ~finally:(fun () -> close_in_noerr ic) 28 | (fun () -> 29 | let rec loop n lines = 30 | if n <= 0 then List.rev lines 31 | else 32 | match input_line ic with 33 | | line -> loop (n - 1) (line :: lines) 34 | | exception _ -> 35 | Printf.eprintf 36 | "read_lines_from_cmd: failed reading line %d, cmd: '%s'" 37 | (max_lines - n + 1) 38 | cmd; 39 | raise End_of_file 40 | in 41 | loop max_lines []) 42 | 43 | let opt_map ~default ~f = function Some y -> f y | None -> default 44 | let opt_is_some = function Some _ -> true | _ -> false 45 | let getenv_opt s = try Some (Sys.getenv s) with _ -> None 46 | 47 | let pkg_export = 48 | let has_brewcheck = opt_is_some (getenv_opt "SQLITE3_OCAML_BREWCHECK") in 49 | if not has_brewcheck then "" 50 | else 51 | let cmd = "brew ls sqlite | grep pkgconfig" in 52 | match read_lines_from_cmd ~max_lines:1 cmd with 53 | | [ fullpath ] when not (String.equal fullpath "") -> 54 | let path = Filename.dirname fullpath in 55 | Printf.sprintf "PKG_CONFIG_PATH=%s" path 56 | | _ -> "" 57 | 58 | let split_ws str = 59 | let lst = ref [] in 60 | let i = ref 0 in 61 | let len = String.length str in 62 | while !i < len do 63 | let j = try String.index_from str !i ' ' with Not_found -> len in 64 | if !i = j then incr i 65 | else ( 66 | lst := String.sub str !i (j - !i) :: !lst; 67 | i := j + 1) 68 | done; 69 | List.rev !lst 70 | 71 | let () = 72 | let module C = Configurator.V1 in 73 | C.main ~name:"sqlite3" (fun c -> 74 | let is_macosx = 75 | opt_map (C.ocaml_config_var c "system") ~default:false ~f:(function 76 | | "macosx" -> true 77 | | _ -> false) 78 | in 79 | let is_mingw = 80 | opt_map (C.ocaml_config_var c "system") ~default:false ~f:(function 81 | | "mingw" | "mingw64" -> true 82 | | _ -> false) 83 | in 84 | let personality = 85 | opt_map (C.ocaml_config_var c "target") ~default:"" ~f:(fun target -> 86 | "--personality=" ^ target) 87 | in 88 | let pkg_config = 89 | let pkg_config = 90 | match Sys.getenv "PKG_CONFIG" with 91 | | s -> s 92 | | exception Not_found -> "pkg-config" 93 | in 94 | pkg_export 95 | ^ if is_mingw then " pkgconf " ^ personality else " " ^ pkg_config 96 | in 97 | let cflags = 98 | let cmd = pkg_config ^ " --cflags sqlite3" in 99 | match read_lines_from_cmd ~max_lines:1 cmd with 100 | | [ cflags ] -> 101 | let cflags = split_ws cflags in 102 | if 103 | is_macosx 104 | || opt_is_some (getenv_opt "SQLITE3_DISABLE_LOADABLE_EXTENSIONS") 105 | then "-DSQLITE3_DISABLE_LOADABLE_EXTENSIONS" :: cflags 106 | else cflags 107 | | _ -> failwith "pkg-config failed to return cflags" 108 | in 109 | let libs = 110 | let cmd = pkg_config ^ " --libs sqlite3" in 111 | match read_lines_from_cmd ~max_lines:1 cmd with 112 | | [ libs ] -> split_ws libs 113 | | _ -> failwith "pkg-config failed to return libs" 114 | in 115 | C.Flags.write_sexp "c_flags.sexp" cflags; 116 | C.Flags.write_sexp "c_library_flags.sexp" libs) 117 | -------------------------------------------------------------------------------- /lib/config/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names discover) 3 | (libraries dune.configurator) 4 | (modes byte exe)) 5 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name sqlite3) 3 | (foreign_stubs 4 | (language c) 5 | (names sqlite3_stubs) 6 | (flags 7 | (:standard) 8 | (:include c_flags.sexp))) 9 | (c_library_flags 10 | (:include c_library_flags.sexp))) 11 | 12 | (rule 13 | (targets c_flags.sexp c_library_flags.sexp) 14 | (action 15 | (run ./config/discover.exe))) 16 | -------------------------------------------------------------------------------- /lib/sqlite3.ml: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* Copyright © 2010- Markus Mottl *) 3 | (* Copyright © 2007-2010 Jane Street Holding, LLC *) 4 | (* Copyright © 2005-2007 Christian Szegedy *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person *) 7 | (* obtaining a copy of this software and associated documentation files *) 8 | (* (the "Software"), to deal in the Software without restriction, *) 9 | (* including without limitation the rights to use, copy, modify, merge, *) 10 | (* publish, distribute, sublicense, and/or sell copies of the Software, *) 11 | (* and to permit persons to whom the Software is furnished to do so, *) 12 | (* subject to the following conditions: *) 13 | (* *) 14 | (* The above copyright notice and this permission notice shall be *) 15 | (* included in all copies or substantial portions of the Software. *) 16 | (* *) 17 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 18 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *) 19 | (* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 20 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS *) 21 | (* BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN *) 22 | (* ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN *) 23 | (* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE *) 24 | (* SOFTWARE. *) 25 | (**************************************************************************) 26 | 27 | open Printf 28 | 29 | exception InternalError of string 30 | exception Error of string 31 | exception RangeError of int * int 32 | exception DataTypeError of string 33 | exception SqliteError of string 34 | 35 | type db 36 | type stmt 37 | 38 | module Rc = struct 39 | type unknown 40 | 41 | external int_of_unknown : unknown -> int = "%identity" 42 | 43 | type t = 44 | | OK 45 | | ERROR 46 | | INTERNAL 47 | | PERM 48 | | ABORT 49 | | BUSY 50 | | LOCKED 51 | | NOMEM 52 | | READONLY 53 | | INTERRUPT 54 | | IOERR 55 | | CORRUPT 56 | | NOTFOUND 57 | | FULL 58 | | CANTOPEN 59 | | PROTOCOL 60 | | EMPTY 61 | | SCHEMA 62 | | TOOBIG 63 | | CONSTRAINT 64 | | MISMATCH 65 | | MISUSE 66 | | NOFLS 67 | | AUTH 68 | | FORMAT 69 | | RANGE 70 | | NOTADB 71 | | ROW 72 | | DONE 73 | | UNKNOWN of unknown 74 | 75 | let to_string = function 76 | | OK -> "OK" 77 | | ERROR -> "ERROR" 78 | | INTERNAL -> "INTERNAL" 79 | | PERM -> "PERM" 80 | | ABORT -> "ABORT" 81 | | BUSY -> "BUSY" 82 | | LOCKED -> "LOCKED" 83 | | NOMEM -> "NOMEM" 84 | | READONLY -> "READONLY" 85 | | INTERRUPT -> "INTERRUPT" 86 | | IOERR -> "IOERR" 87 | | CORRUPT -> "CORRUPT" 88 | | NOTFOUND -> "NOTFOUND" 89 | | FULL -> "FULL" 90 | | CANTOPEN -> "CANTOPEN" 91 | | PROTOCOL -> "PROTOCOL" 92 | | EMPTY -> "EMPTY" 93 | | SCHEMA -> "SCHEMA" 94 | | TOOBIG -> "TOOBIG" 95 | | CONSTRAINT -> "CONSTRAINT" 96 | | MISMATCH -> "MISMATCH" 97 | | MISUSE -> "MISUSE" 98 | | NOFLS -> "NOLFS" 99 | | AUTH -> "AUTH" 100 | | FORMAT -> "FORMAT" 101 | | RANGE -> "RANGE" 102 | | NOTADB -> "NOTADB" 103 | | ROW -> "ROW" 104 | | DONE -> "DONE" 105 | | UNKNOWN n -> sprintf "UNKNOWN %d" (int_of_unknown n) 106 | 107 | let is_success = function OK | DONE -> true | _ -> false 108 | let check rc = if not (is_success rc) then raise (SqliteError (to_string rc)) 109 | end 110 | 111 | module Data = struct 112 | type t = 113 | | NONE 114 | | NULL 115 | | INT of int64 116 | | FLOAT of float 117 | | TEXT of string 118 | | BLOB of string 119 | 120 | let opt_text = function Some s -> TEXT s | None -> NULL 121 | let opt_int = function Some n -> INT (Int64.of_int n) | None -> NULL 122 | 123 | let opt_nativeint = function 124 | | Some n -> INT (Int64.of_nativeint n) 125 | | None -> NULL 126 | 127 | let opt_int32 = function Some n -> INT (Int64.of_int32 n) | None -> NULL 128 | let opt_int64 = function Some n -> INT n | None -> NULL 129 | let opt_float = function Some n -> FLOAT n | None -> NULL 130 | 131 | let opt_bool = function 132 | | Some false -> INT Int64.zero 133 | | Some true -> INT Int64.one 134 | | None -> NULL 135 | 136 | (* Exception-based type conversion *) 137 | 138 | let to_string_debug = function 139 | | NONE -> "NONE" 140 | | NULL -> "NULL" 141 | | INT i -> sprintf "INT <%Ld>" i 142 | | FLOAT f -> sprintf "FLOAT <%f>" f 143 | | TEXT t -> sprintf "TEXT <%S>" t 144 | | BLOB b -> sprintf "BLOB <%d>" (String.length b) 145 | 146 | let data_type_error tp data = 147 | let got = to_string_debug data in 148 | raise (DataTypeError (Printf.sprintf "Expected %s but got %s" tp got)) 149 | 150 | let to_string_exn = function 151 | | TEXT s | BLOB s -> s 152 | | data -> data_type_error "TEXT or BLOB" data 153 | 154 | let min_int_as_int64 = Int64.of_int min_int 155 | let max_int_as_int64 = Int64.of_int max_int 156 | let min_nativeint_as_int64 = Int64.of_nativeint Nativeint.min_int 157 | let max_nativeint_as_int64 = Int64.of_nativeint Nativeint.max_int 158 | let min_int32_as_int64 = Int64.of_int32 Int32.min_int 159 | let max_int32_as_int64 = Int64.of_int32 Int32.max_int 160 | 161 | let safe_get_int n = 162 | if n > max_int_as_int64 then 163 | failwith (Printf.sprintf "Sqlite3.Data.safe_get_int: overflow: %Ld" n) 164 | else if n < min_int_as_int64 then 165 | failwith (Printf.sprintf "Sqlite3.Data.safe_get_int: underflow: %Ld" n) 166 | else Int64.to_int n 167 | 168 | let safe_get_nativeint n = 169 | if n > max_nativeint_as_int64 then 170 | failwith 171 | (Printf.sprintf "Sqlite3.Data.safe_get_nativeint: overflow: %Ld" n) 172 | else if n < min_nativeint_as_int64 then 173 | failwith 174 | (Printf.sprintf "Sqlite3.Data.safe_get_nativeint: underflow: %Ld" n) 175 | else Int64.to_nativeint n 176 | 177 | let safe_get_int32 n = 178 | if n > max_int32_as_int64 then 179 | failwith (Printf.sprintf "Sqlite3.Data.safe_get_int32: overflow: %Ld" n) 180 | else if n < min_int32_as_int64 then 181 | failwith (Printf.sprintf "Sqlite3.Data.safe_get_int32: underflow: %Ld" n) 182 | else Int64.to_int32 n 183 | 184 | let to_int_exn = function 185 | | INT n -> safe_get_int n 186 | | data -> data_type_error "INT" data 187 | 188 | let to_nativeint_exn = function 189 | | INT n -> safe_get_nativeint n 190 | | data -> data_type_error "INT" data 191 | 192 | let to_int32_exn = function 193 | | INT n -> safe_get_int32 n 194 | | data -> data_type_error "INT" data 195 | 196 | let to_int64_exn = function INT n -> n | data -> data_type_error "INT" data 197 | 198 | let to_float_exn = function 199 | | FLOAT n -> n 200 | | data -> data_type_error "FLOAT" data 201 | 202 | let bool_of_int64 = function 203 | | 0L -> false 204 | | 1L -> true 205 | | n -> failwith (Printf.sprintf "Sqlite3.Data.bool_of_native_int: %Ld" n) 206 | 207 | let int64_of_bool = function false -> 0L | true -> 1L 208 | 209 | let to_bool_exn = function 210 | | INT n -> bool_of_int64 n 211 | | data -> data_type_error "INT 0L/1L" data 212 | 213 | (* Option-based type conversion *) 214 | 215 | let to_string = function TEXT s | BLOB s -> Some s | _ -> None 216 | let to_int = function INT n -> Some (safe_get_int n) | _ -> None 217 | let to_nativeint = function INT n -> Some (safe_get_nativeint n) | _ -> None 218 | let to_int32 = function INT n -> Some (safe_get_int32 n) | _ -> None 219 | let to_int64 = function INT n -> Some n | _ -> None 220 | let to_float = function FLOAT n -> Some n | _ -> None 221 | 222 | let to_bool = function 223 | | INT 0L -> Some false 224 | | INT 1L -> Some true 225 | | _ -> None 226 | 227 | (* Simplified string coercion *) 228 | let to_string_coerce = function 229 | | NONE | NULL -> "" 230 | | INT n -> Int64.to_string n 231 | | FLOAT n -> string_of_float n 232 | | TEXT t | BLOB t -> t 233 | end 234 | 235 | type header = string 236 | type headers = header array 237 | type row = string option array 238 | type row_not_null = string array 239 | 240 | module Mode = struct 241 | type t = Read_write_create | Read_write | Read_only 242 | 243 | let lift = function 244 | | None -> Read_write_create 245 | | Some `READONLY -> Read_only 246 | | Some `NO_CREATE -> Read_write 247 | end 248 | 249 | module Mut = struct 250 | type t = NOTHING | NO | FULL 251 | 252 | let lift = function None -> NOTHING | Some `NO -> NO | Some `FULL -> FULL 253 | end 254 | 255 | module Cache = struct 256 | type t = NOTHING | SHARED | PRIVATE 257 | 258 | let lift = function 259 | | None -> NOTHING 260 | | Some `SHARED -> SHARED 261 | | Some `PRIVATE -> PRIVATE 262 | end 263 | 264 | external sqlite_version : unit -> int = "caml_sqlite3_version" 265 | external sqlite_version_info : unit -> string = "caml_sqlite3_version_info" 266 | 267 | external db_open : 268 | mode:Mode.t -> 269 | uri:bool -> 270 | memory:bool -> 271 | mutex:Mut.t -> 272 | cache:Cache.t -> 273 | ?vfs:string -> 274 | string -> 275 | db = "caml_sqlite3_open_bc" "caml_sqlite3_open" 276 | 277 | let db_open ?mode ?(uri = false) ?(memory = false) ?mutex ?cache ?vfs name = 278 | let mode = Mode.lift mode in 279 | let mutex = Mut.lift mutex in 280 | let cache = Cache.lift cache in 281 | db_open ~mode ~uri ~memory ~mutex ~cache ?vfs name 282 | 283 | external db_close : db -> bool = "caml_sqlite3_close" 284 | 285 | let ( let& ) db f = 286 | let close_or_exn () = 287 | if not (db_close db) then 288 | failwith "Sqlite3.( let& ): could not close database" 289 | in 290 | Fun.protect ~finally:close_or_exn (fun () -> f db) 291 | 292 | external errcode : db -> Rc.t = "caml_sqlite3_errcode" 293 | external errmsg : db -> string = "caml_sqlite3_errmsg" 294 | external extended_errcode_int : db -> int = "caml_sqlite3_extended_errcode_int" 295 | 296 | external last_insert_rowid : db -> (int64[@unboxed]) 297 | = "caml_sqlite3_last_insert_rowid_bc" "caml_sqlite3_last_insert_rowid" 298 | [@@noalloc] 299 | 300 | external exec : 301 | db -> ?cb:(string option array -> headers -> unit) -> string -> Rc.t 302 | = "caml_sqlite3_exec" 303 | 304 | external exec_no_headers : 305 | db -> cb:(string option array -> unit) -> string -> Rc.t 306 | = "caml_sqlite3_exec_no_headers" 307 | 308 | external exec_not_null : 309 | db -> cb:(string array -> headers -> unit) -> string -> Rc.t 310 | = "caml_sqlite3_exec_not_null" 311 | 312 | external exec_not_null_no_headers : 313 | db -> cb:(string array -> unit) -> string -> Rc.t 314 | = "caml_sqlite3_exec_not_null_no_headers" 315 | 316 | external changes : db -> (int[@untagged]) 317 | = "caml_sqlite3_changes_bc" "caml_sqlite3_changes" 318 | 319 | external prepare : db -> string -> stmt = "caml_sqlite3_prepare" 320 | external prepare_tail : stmt -> stmt option = "caml_sqlite3_prepare_tail" 321 | external recompile : stmt -> unit = "caml_sqlite3_recompile" 322 | external step : stmt -> Rc.t = "caml_sqlite3_step" 323 | external reset : stmt -> Rc.t = "caml_sqlite3_stmt_reset" 324 | 325 | let prepare_or_reset db opt_stmt_ref sql = 326 | match !opt_stmt_ref with 327 | | Some stmt -> 328 | reset stmt |> Rc.check; 329 | stmt 330 | | None -> 331 | let stmt = prepare db sql in 332 | opt_stmt_ref := Some stmt; 333 | stmt 334 | 335 | external sleep : (int[@untagged]) -> (int[@untagged]) 336 | = "caml_sqlite3_sleep_bc" "caml_sqlite3_sleep" 337 | 338 | external finalize : stmt -> Rc.t = "caml_sqlite3_stmt_finalize" 339 | 340 | external data_count : stmt -> (int[@untagged]) 341 | = "caml_sqlite3_data_count_bc" "caml_sqlite3_data_count" 342 | 343 | external column_count : stmt -> (int[@untagged]) 344 | = "caml_sqlite3_column_count_bc" "caml_sqlite3_column_count" 345 | 346 | external column_blob : stmt -> (int[@untagged]) -> string 347 | = "caml_sqlite3_column_blob_bc" "caml_sqlite3_column_blob" 348 | 349 | external column_double : stmt -> (int[@untagged]) -> (float[@unboxed]) 350 | = "caml_sqlite3_column_double_bc" "caml_sqlite3_column_double" 351 | 352 | external column_int32 : stmt -> (int[@untagged]) -> (int32[@unboxed]) 353 | = "caml_sqlite3_column_int32_bc" "caml_sqlite3_column_int32" 354 | 355 | external column_int64 : stmt -> (int[@untagged]) -> (int64[@unboxed]) 356 | = "caml_sqlite3_column_int64_bc" "caml_sqlite3_column_int64" 357 | 358 | let column_int stmt pos = Data.safe_get_int (column_int64 stmt pos) 359 | let column_nativeint stmt pos = Data.safe_get_nativeint (column_int64 stmt pos) 360 | 361 | external column_text : stmt -> (int[@untagged]) -> string 362 | = "caml_sqlite3_column_text_bc" "caml_sqlite3_column_text" 363 | 364 | let column_bool stmt pos = Data.bool_of_int64 (column_int64 stmt pos) 365 | 366 | external column : stmt -> (int[@untagged]) -> Data.t 367 | = "caml_sqlite3_column_bc" "caml_sqlite3_column" 368 | 369 | external column_name : stmt -> (int[@untagged]) -> string 370 | = "caml_sqlite3_column_name_bc" "caml_sqlite3_column_name" 371 | 372 | external column_decltype : stmt -> (int[@untagged]) -> string option 373 | = "caml_sqlite3_column_decltype_bc" "caml_sqlite3_column_decltype" 374 | 375 | external bind : stmt -> (int[@untagged]) -> Data.t -> Rc.t 376 | = "caml_sqlite3_bind_bc" "caml_sqlite3_bind" 377 | 378 | external bind_parameter_count : stmt -> (int[@untagged]) 379 | = "caml_sqlite3_bind_parameter_count_bc" "caml_sqlite3_bind_parameter_count" 380 | 381 | external bind_parameter_name : stmt -> (int[@untagged]) -> string option 382 | = "caml_sqlite3_bind_parameter_name_bc" "caml_sqlite3_bind_parameter_name" 383 | 384 | external bind_parameter_index : stmt -> string -> (int[@untagged]) 385 | = "caml_sqlite3_bind_parameter_index_bc" "caml_sqlite3_bind_parameter_index" 386 | 387 | external bind_blob : stmt -> (int[@untagged]) -> string -> Rc.t 388 | = "caml_sqlite3_bind_blob_bc" "caml_sqlite3_bind_blob" 389 | 390 | external bind_double : stmt -> (int[@untagged]) -> (float[@unboxed]) -> Rc.t 391 | = "caml_sqlite3_bind_double_bc" "caml_sqlite3_bind_double" 392 | 393 | external bind_int32 : stmt -> (int[@untagged]) -> (int32[@unboxed]) -> Rc.t 394 | = "caml_sqlite3_bind_int32_bc" "caml_sqlite3_bind_int32" 395 | 396 | external bind_int64 : stmt -> (int[@untagged]) -> (int64[@unboxed]) -> Rc.t 397 | = "caml_sqlite3_bind_int64_bc" "caml_sqlite3_bind_int64" 398 | 399 | let bind_int stmt pos n = bind_int64 stmt pos (Int64.of_int n) 400 | let bind_nativeint stmt pos n = bind_int64 stmt pos (Int64.of_nativeint n) 401 | let bind_bool stmt pos b = bind_int64 stmt pos (Data.int64_of_bool b) 402 | 403 | external bind_text : stmt -> (int[@untagged]) -> string -> Rc.t 404 | = "caml_sqlite3_bind_text_bc" "caml_sqlite3_bind_text" 405 | 406 | let bind_name stmt name data = bind stmt (bind_parameter_index stmt name) data 407 | 408 | let bind_names stmt lst = 409 | let rec loop = function 410 | | [] -> Rc.OK 411 | | (name, data) :: rest -> 412 | let rc = bind_name stmt name data in 413 | if rc = Rc.OK then loop rest else rc 414 | in 415 | loop lst 416 | 417 | let bind_values stmt lst = 418 | let rec loop i = function 419 | | [] -> Rc.OK 420 | | data :: rest -> 421 | let rc = bind stmt i data in 422 | if rc = Rc.OK then loop (i + 1) rest else rc 423 | in 424 | loop 1 lst 425 | 426 | external clear_bindings : stmt -> Rc.t = "caml_sqlite3_clear_bindings" 427 | 428 | external busy_timeout : db -> (int[@untagged]) -> unit 429 | = "caml_sqlite3_busy_timeout_bc" "caml_sqlite3_busy_timeout" 430 | 431 | external enable_load_extension : db -> bool -> bool 432 | = "caml_sqlite3_enable_load_extension" 433 | 434 | let row_blobs stmt = Array.init (data_count stmt) (column_blob stmt) 435 | let row_data stmt = Array.init (data_count stmt) (column stmt) 436 | let row_names stmt = Array.init (data_count stmt) (column_name stmt) 437 | let row_decltypes stmt = Array.init (data_count stmt) (column_decltype stmt) 438 | 439 | let attempt_reset stmt rc = 440 | match reset stmt with Rc.OK -> rc | reset_rc -> reset_rc 441 | 442 | let iter stmt ~f = 443 | let rec loop () = 444 | match step stmt with 445 | | Rc.ROW -> 446 | f (row_data stmt); 447 | loop () 448 | | rc -> attempt_reset stmt rc 449 | in 450 | loop () 451 | 452 | let fold stmt ~f ~init = 453 | let rec loop acc = 454 | match step stmt with 455 | | Rc.ROW -> loop (f acc (row_data stmt)) 456 | | rc -> (attempt_reset stmt rc, acc) 457 | in 458 | loop init 459 | 460 | (* Function registration *) 461 | 462 | external create_function : 463 | db -> string -> (int[@untagged]) -> (Data.t array -> Data.t) -> unit 464 | = "caml_sqlite3_create_function_bc" "caml_sqlite3_create_function" 465 | 466 | let create_funN db name f = create_function db name (-1) f 467 | let create_fun0 db name f = create_function db name 0 (fun _ -> f ()) 468 | let create_fun1 db name f = create_function db name 1 (fun args -> f args.(0)) 469 | 470 | let create_fun2 db name f = 471 | create_function db name 2 (fun args -> f args.(0) args.(1)) 472 | 473 | let create_fun3 db name f = 474 | create_function db name 3 (fun args -> f args.(0) args.(1) args.(2)) 475 | 476 | external delete_function : db -> string -> unit = "caml_sqlite3_delete_function" 477 | 478 | module Aggregate = struct 479 | external create_function : 480 | db -> 481 | string -> 482 | (int[@untagged]) -> 483 | 'a -> 484 | ('a -> Data.t array -> 'a) -> 485 | ('a -> Data.t array -> 'a) option -> 486 | ('a -> Data.t) option -> 487 | ('a -> Data.t) -> 488 | unit 489 | = "caml_sqlite3_create_aggregate_function_bc" 490 | "caml_sqlite3_create_aggregate_function" 491 | 492 | let create_funN ?inverse ?value db name ~init ~step ~final = 493 | create_function db name (-1) init step inverse value final 494 | 495 | let create_fun0 ?inverse ?value db name ~init ~step ~final = 496 | create_function db name 0 init 497 | (fun acc _ -> step acc) 498 | (match inverse with 499 | | Some inv -> Some (fun acc _ -> inv acc) 500 | | None -> None) 501 | value final 502 | 503 | let create_fun1 ?inverse ?value db name ~init ~step ~final = 504 | create_function db name 1 init 505 | (fun acc args -> step acc args.(0)) 506 | (match inverse with 507 | | Some inv -> Some (fun acc args -> inv acc args.(0)) 508 | | None -> None) 509 | value final 510 | 511 | let create_fun2 ?inverse ?value db name ~init ~step ~final = 512 | create_function db name 2 init 513 | (fun acc args -> step acc args.(0) args.(1)) 514 | (match inverse with 515 | | Some inv -> Some (fun acc args -> inv acc args.(0) args.(1)) 516 | | None -> None) 517 | value final 518 | 519 | let create_fun3 ?inverse ?value db name ~init ~step ~final = 520 | create_function db name 3 init 521 | (fun acc args -> step acc args.(0) args.(1) args.(2)) 522 | (match inverse with 523 | | Some inv -> Some (fun acc args -> inv acc args.(0) args.(1) args.(2)) 524 | | None -> None) 525 | value final 526 | end 527 | 528 | (* Collation registration *) 529 | 530 | external create_collation : db -> string -> (string -> string -> int) -> unit 531 | = "caml_sqlite3_create_collation" 532 | 533 | external delete_collation : db -> string -> unit 534 | = "caml_sqlite3_delete_collation" 535 | 536 | module Backup = struct 537 | module Raw = struct 538 | type t 539 | 540 | external init : dst:db -> dst_name:string -> src:db -> src_name:string -> t 541 | = "caml_sqlite3_backup_init" 542 | 543 | external step : t -> (int[@untagged]) -> Rc.t 544 | = "caml_sqlite3_backup_step_bc" "caml_sqlite3_backup_step" 545 | 546 | external finish : t -> Rc.t = "caml_sqlite3_backup_finish" 547 | 548 | external remaining : t -> (int[@untagged]) 549 | = "caml_sqlite3_backup_remaining_bc" "caml_sqlite3_backup_remaining" 550 | [@@noalloc] 551 | 552 | external pagecount : t -> (int[@untagged]) 553 | = "caml_sqlite3_backup_pagecount_bc" "caml_sqlite3_backup_pagecount" 554 | [@@noalloc] 555 | end 556 | 557 | type t = Raw.t * db * db 558 | (* Databases must not be garbage-collected before backup objects (which have 559 | references to them) so we bind their lifetime together. *) 560 | 561 | let init ~dst ~dst_name ~src ~src_name = 562 | (Raw.init ~dst ~dst_name ~src ~src_name, dst, src) 563 | 564 | let step (b, _, _) i = Raw.step b i 565 | let finish (b, _, _) = Raw.finish b 566 | let remaining (b, _, _) = Raw.remaining b 567 | let pagecount (b, _, _) = Raw.pagecount b 568 | end 569 | 570 | (* Initialisation *) 571 | 572 | external init : unit -> unit = "caml_sqlite3_init" 573 | external cleanup : unit -> unit = "caml_sqlite3_cleanup" 574 | 575 | let () = 576 | Callback.register_exception "Sqlite3.InternalError" (InternalError ""); 577 | Callback.register_exception "Sqlite3.Error" (Error ""); 578 | Callback.register_exception "Sqlite3.RangeError" (RangeError (0, 0)); 579 | at_exit cleanup; 580 | init () 581 | -------------------------------------------------------------------------------- /lib/sqlite3.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* Copyright © 2010- Markus Mottl *) 3 | (* Copyright © 2007-2010 Jane Street Holding, LLC *) 4 | (* Copyright © 2005-2007 Christian Szegedy *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person *) 7 | (* obtaining a copy of this software and associated documentation files *) 8 | (* (the "Software"), to deal in the Software without restriction, *) 9 | (* including without limitation the rights to use, copy, modify, merge, *) 10 | (* publish, distribute, sublicense, and/or sell copies of the Software, *) 11 | (* and to permit persons to whom the Software is furnished to do so, *) 12 | (* subject to the following conditions: *) 13 | (* *) 14 | (* The above copyright notice and this permission notice shall be *) 15 | (* included in all copies or substantial portions of the Software. *) 16 | (* *) 17 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *) 18 | (* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *) 19 | (* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *) 20 | (* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS *) 21 | (* BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN *) 22 | (* ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN *) 23 | (* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE *) 24 | (* SOFTWARE. *) 25 | (**************************************************************************) 26 | 27 | (** API for Sqlite 3.* databases *) 28 | 29 | (** {2 Exceptions} *) 30 | 31 | exception InternalError of string 32 | (** [InternalError reason] is raised when the bindings detect an 33 | unknown/unsupported situation. *) 34 | 35 | exception Error of string 36 | (** [Error reason] is raised when some SQL operation is called on a nonexistent 37 | handle and the functions does not return a return code, or if there is no 38 | error code corresponding to this error. Functions returning return codes 39 | communicate errors by returning the specific error code. *) 40 | 41 | exception RangeError of int * int 42 | (** [RangeError (index, maximum)] is raised if some column or bind operation 43 | refers to a nonexistent column or binding. The first entry of the returned 44 | tuple is the specified index, the second is the limit which was violated. *) 45 | 46 | exception DataTypeError of string 47 | (** [DataTypeError msg] is raised when you attempt to convert a [Data.t] 48 | structure to an object via an invalid conversion. *) 49 | 50 | exception SqliteError of string 51 | (** [SqliteError err_msg] is raised after calling [Rc.check] on a return code 52 | that does not indicate success. *) 53 | 54 | (** {2 Library Information} *) 55 | 56 | val sqlite_version : unit -> int 57 | (** [sqlite_version ()] 58 | @return 59 | the version of the SQLite3 library being used, in format [3XXXYYY] where 60 | [XXX] is the minor version and [YYY] is the patch level. For example, 61 | [3030001] for 3.30.1. *) 62 | 63 | val sqlite_version_info : unit -> string 64 | (** [sqlite_version_info ()] 65 | @return 66 | the version of the SQLite3 library being used in a human-readable string. 67 | *) 68 | 69 | (** {2 Types} *) 70 | 71 | type db 72 | (** Database handle. Used to store information regarding open databases and the 73 | error code from the last operation if the function implementing that 74 | operation takes a database handle as a parameter. 75 | 76 | NOTE: database handles are closed (see {!db_close}) automatically when they 77 | are reclaimed by the GC unless they have already been closed earlier by the 78 | user. It is good practice to manually close database handles to free 79 | resources as quickly as possible. 80 | 81 | @see 82 | about thread safety when accessing database handles and also consider 83 | using the [mutex] flag with {!db_open} if necessary. *) 84 | 85 | type stmt 86 | (** Compiled statement handle. Stores information about compiled statements 87 | created by the [prepare] or [prepare_tail] functions. 88 | 89 | @see 90 | about thread safety when accessing statement handles. *) 91 | 92 | type header = string 93 | (** Type of name of a column returned by queries. *) 94 | 95 | type headers = header array 96 | (** Type of names of columns returned by queries. *) 97 | 98 | type row = string option array 99 | (** Type of row data (with potential NULL-values) *) 100 | 101 | type row_not_null = string array 102 | (** Type of row data (without NULL-values) *) 103 | 104 | (** {2 Return codes} *) 105 | 106 | module Rc : sig 107 | type unknown 108 | (** Type of unknown return codes *) 109 | 110 | val int_of_unknown : unknown -> int 111 | (** [int_of_unknown n] converts unknown return code [rc] to an integer. *) 112 | 113 | (** Type of return codes from failed or successful operations. *) 114 | type t = 115 | | OK 116 | | ERROR 117 | | INTERNAL 118 | | PERM 119 | | ABORT 120 | | BUSY 121 | | LOCKED 122 | | NOMEM 123 | | READONLY 124 | | INTERRUPT 125 | | IOERR 126 | | CORRUPT 127 | | NOTFOUND 128 | | FULL 129 | | CANTOPEN 130 | | PROTOCOL 131 | | EMPTY 132 | | SCHEMA 133 | | TOOBIG 134 | | CONSTRAINT 135 | | MISMATCH 136 | | MISUSE 137 | | NOFLS 138 | | AUTH 139 | | FORMAT 140 | | RANGE 141 | | NOTADB 142 | | ROW 143 | | DONE 144 | | UNKNOWN of unknown 145 | 146 | val to_string : t -> string 147 | (** [to_string rc] converts return code [rc] to a string. *) 148 | 149 | val check : t -> unit 150 | (** [check rc] raises an exception if [rc] does not correspond to a return 151 | code indicating success. *) 152 | 153 | val is_success : t -> bool 154 | (** [is_success rc] 155 | @return 156 | [true] if [rc] indicates success ([OK] or [DONE]), [false] otherwise. *) 157 | end 158 | 159 | (** {2 Column data types} *) 160 | 161 | module Data : sig 162 | (** Type of columns *) 163 | type t = 164 | | NONE 165 | | NULL 166 | | INT of int64 167 | | FLOAT of float 168 | | TEXT of string 169 | | BLOB of string 170 | 171 | val opt_text : string option -> t 172 | (** [opt_text value] converts [value] to a [Data.t] [TEXT] value, converting 173 | [None] to SQLite [NULL]. *) 174 | 175 | val opt_int : int option -> t 176 | (** [opt_int value] converts [value] to a [Data.t] [INT] value, converting 177 | [None] to SQLite [NULL]. *) 178 | 179 | val opt_nativeint : nativeint option -> t 180 | (** [opt_nativeint value] converts [value] to a [Data.t] [INT] value, 181 | converting [None] to SQLite [NULL]. *) 182 | 183 | val opt_int32 : int32 option -> t 184 | (** [opt_int32 value] converts [value] to a [Data.t] [INT] value, converting 185 | [None] to SQLite [NULL]. *) 186 | 187 | val opt_int64 : int64 option -> t 188 | (** [opt_int64 value] converts [value] to a [Data.t] [INT] value, converting 189 | [None] to SQLite [NULL]. *) 190 | 191 | val opt_float : float option -> t 192 | (** [opt_float value] converts [value] to a [Data.t] [FLOAT] value, converting 193 | [None] to SQLite [NULL]. *) 194 | 195 | val opt_bool : bool option -> t 196 | (** [opt_bool value] converts [value] to a [Data.t] [INT] value, converting 197 | [None] to SQLite [NULL]. *) 198 | 199 | val to_string_exn : t -> string 200 | (** [to_string_exn data] converts [TEXT] and [BLOB] [data] to a string. 201 | 202 | @raise DataTypeError if [data] is invalid. *) 203 | 204 | val to_int_exn : t -> int 205 | (** [to_int_exn data] converts [INT] [data] to an int. 206 | 207 | @raise DataTypeError if [data] is invalid. 208 | @raise Failure if the integer conversion over- or underflows. *) 209 | 210 | val to_nativeint_exn : t -> nativeint 211 | (** [to_nativeint_exn data] converts [INT] [data] to a nativeint. 212 | 213 | @raise DataTypeError if [data] is invalid. 214 | @raise Failure if the integer conversion over- or underflows. *) 215 | 216 | val to_int32_exn : t -> int32 217 | (** [to_int32_exn data] converts [INT] [data] to an int32. 218 | 219 | @raise DataTypeError if [data] is invalid. 220 | @raise Failure if the integer conversion over- or underflows. *) 221 | 222 | val to_int64_exn : t -> int64 223 | (** [to_int64_exn data] converts [INT] [data] to an int64. 224 | 225 | @raise DataTypeError if [data] is invalid. *) 226 | 227 | val to_float_exn : t -> float 228 | (** [to_float_exn data] converts [FLOAT] [data] to a float. 229 | 230 | @raise DataTypeError if [data] is invalid. *) 231 | 232 | val to_bool_exn : t -> bool 233 | (** [to_bool_exn data] converts [INT] [data] to a bool. 234 | 235 | @raise DataTypeError if [data] is invalid. *) 236 | 237 | val to_string : t -> string option 238 | (** [to_string data] converts [data] to [Some string] or [None] if it is not a 239 | valid conversion. This method also converts data of type BLOB to a string. 240 | *) 241 | 242 | val to_int : t -> int option 243 | (** [to_int data] converts [data] to [Some int] or [None] if it is not a valid 244 | conversion. 245 | 246 | @raise Failure if the integer conversion over- or underflows. *) 247 | 248 | val to_nativeint : t -> nativeint option 249 | (** [to_nativeint data] converts [data] to [Some nativeint] or [None] if it is 250 | not a valid conversion. 251 | 252 | @raise Failure if the integer conversion over- or underflows. *) 253 | 254 | val to_int32 : t -> int32 option 255 | (** [to_int32 data] converts [data] to [Some int32] or [None] if it is not a 256 | valid conversion. 257 | 258 | @raise Failure if the integer conversion over- or underflows. *) 259 | 260 | val to_int64 : t -> int64 option 261 | (** [to_int64 data] converts [data] to [Some int64] or [None] if it is not a 262 | valid conversion. *) 263 | 264 | val to_float : t -> float option 265 | (** [to_float data] converts [data] to [Some float] or [None] if it is not a 266 | valid conversion. *) 267 | 268 | val to_bool : t -> bool option 269 | (** [to_bool data] converts [data] to [Some bool] or [None] if it is not a 270 | valid conversion. *) 271 | 272 | val to_string_coerce : t -> string 273 | (** [to_string_coerce data] coerces [data] to a string, using coercion on 274 | ints, NULLs, floats, and other data types. *) 275 | 276 | val to_string_debug : t -> string 277 | (** [to_string_debug data] converts [data] to a string including the data 278 | constructor. The contents of blobs will not be printed, only its length. 279 | Useful for debugging. *) 280 | end 281 | 282 | (** {2 General database operations} *) 283 | 284 | val db_open : 285 | ?mode:[ `READONLY | `NO_CREATE ] -> 286 | ?uri:bool -> 287 | ?memory:bool -> 288 | ?mutex:[ `NO | `FULL ] -> 289 | ?cache:[ `SHARED | `PRIVATE ] -> 290 | ?vfs:string -> 291 | string -> 292 | db 293 | (** [db_open ?mode ?uri ?memory ?mutex ?cache ?vfs filename] opens the database 294 | file [filename], and returns a database handle. 295 | 296 | Special filenames: ":memory:" and "" open an in-memory or temporary database 297 | respectively. Behaviour explained here: 298 | https://www.sqlite.org/inmemorydb.html 299 | 300 | The optional arguments [mode], [uri], [memory] and [mutex] are only 301 | meaningful with SQLite versions >= 3.5, [cache] only for versions >= 3.6.18. 302 | For older versions an exception will be raised if any of them is set to a 303 | non-default value. The database is opened read-only if [`READONLY] is passed 304 | as mode. The database file will not be created if it is missing and 305 | [`NO_CREATE] is set. The [uri] parameter enables URI filename interpretation 306 | and corresponds to [SQLITE_OPEN_URI] in the SQLite3 API. The [memory] 307 | parameter opens an in-memory database and corresponds to 308 | [SQLITE_OPEN_MEMORY] in the SQLite3 API. [mutex] determines how the database 309 | is accessed. The mutex parameters [`NO] and [`FULL] correspond to 310 | [SQLITE_OPEN_NOMUTEX] and [SQLITE_OPEN_FULLMUTEX] in the SQLite3 API 311 | respectively. The cache parameters [`SHARED] and [`PRIVATE] correspond to 312 | [SQLITE_OPEN_SHAREDCACHE] and [SQLITE_OPEN_PRIVATECACHE] in the SQLite3 API 313 | respectively. 314 | 315 | @param mode default = read-write, create 316 | @param uri default = false 317 | @param memory default = false 318 | @param mutex default = nothing 319 | @param cache default = nothing 320 | @param vfs default = nothing *) 321 | 322 | val db_close : db -> bool 323 | (** [db_close db] closes database [db] and invalidates the handle. 324 | @return 325 | [false] if database was busy (database not closed in this case!), [true] 326 | otherwise. 327 | 328 | @raise SqliteError if an invalid database handle is passed. *) 329 | 330 | val ( let& ) : db -> (db -> 'a) -> 'a 331 | (** [let& db = db_open "..." in ...scope that uses db...] ensures that the 332 | database [db] is safely closed at the end of the scope, even if there is an 333 | exception somewhere in the scope. 334 | 335 | @raise Fun.Finally_raised if the database could not be closed successfully. 336 | *) 337 | 338 | val enable_load_extension : db -> bool -> bool 339 | (** [enable_load_extension db onoff] enable/disable the SQLite3 load extension. 340 | @return [false] if the operation fails, [true] otherwise. *) 341 | 342 | val errcode : db -> Rc.t 343 | (** [errcode db] 344 | @return the error code of the last operation on database [db]. 345 | 346 | @raise SqliteError if an invalid database handle is passed. *) 347 | 348 | val errmsg : db -> string 349 | (** [errmsg db] 350 | @return the error message of the last operation on database [db]. 351 | 352 | @raise SqliteError if an invalid database handle is passed. *) 353 | 354 | val extended_errcode_int : db -> int 355 | (** [extended_errcode_int db] 356 | @return 357 | the extended error code of the last operation on the database [db] as an 358 | integer. 359 | 360 | @raise SqliteError if an invalid database handle is passed. *) 361 | 362 | val last_insert_rowid : db -> int64 363 | (** [last_insert_rowid db] 364 | @return 365 | the index of the row inserted by the last operation on database [db]. 366 | 367 | @raise SqliteError if an invalid database handle is passed. *) 368 | 369 | val exec : db -> ?cb:(row -> headers -> unit) -> string -> Rc.t 370 | (** [exec db ?cb sql] performs SQL-operation [sql] on database [db]. If the 371 | operation contains query statements, then the callback function [cb] will be 372 | called for each matching row. The first parameter of the callback contains 373 | the contents of the row, the second parameter contains the headers of the 374 | columns associated with the row. Exceptions raised within the callback will 375 | abort the execution and escape {!exec}. 376 | 377 | @return the return code of the operation. 378 | 379 | @param cb default = no callback 380 | 381 | @raise SqliteError if an invalid database handle is passed. *) 382 | 383 | val exec_no_headers : db -> cb:(row -> unit) -> string -> Rc.t 384 | (** [exec_no_headers db ?cb sql] performs SQL-operation [sql] on database [db]. 385 | If the operation contains query statements, then the callback function [cb] 386 | will be called for each matching row. The parameter of the callback is the 387 | contents of the row. Exceptions raised within the callback will abort the 388 | execution and escape {!exec_no_headers}. 389 | 390 | @return the return code of the operation. 391 | 392 | @raise SqliteError if an invalid database handle is passed. *) 393 | 394 | val exec_not_null : db -> cb:(row_not_null -> headers -> unit) -> string -> Rc.t 395 | (** [exec_not_null db ~cb sql] performs SQL-operation [sql] on database [db]. If 396 | the operation contains query statements, then the callback function [cb] 397 | will be called for each matching row. The first parameter of the callback is 398 | the contents of the row, which must not contain NULL-values, the second 399 | paramater are the headers of the columns associated with the row. Exceptions 400 | raised within the callback will abort the execution and escape 401 | {!exec_not_null}. 402 | 403 | @return the return code of the operation. 404 | 405 | @raise SqliteError if an invalid database handle is passed. 406 | @raise SqliteError if a row contains NULL. *) 407 | 408 | val exec_not_null_no_headers : db -> cb:(row_not_null -> unit) -> string -> Rc.t 409 | (** [exec_not_null_no_headers db ~cb sql] performs SQL-operation [sql] on 410 | database [db]. If the operation contains query statements, then the callback 411 | function [cb] will be called for each matching row. The parameter of the 412 | callback is the contents of the row, which must not contain NULL-values. 413 | Exceptions raised within the callback will abort the execution and escape 414 | {!exec_not_null_no_headers}. 415 | 416 | @return the return code of the operation. 417 | 418 | @raise SqliteError if an invalid database handle is passed. 419 | @raise SqliteError if a row contains NULL. *) 420 | 421 | val changes : db -> int 422 | (** [changes db] 423 | @return 424 | the number of rows that were changed or inserted or deleted by the most 425 | recently completed SQL statement on database [db]. *) 426 | 427 | (** {2 Prepared Statements} *) 428 | 429 | val prepare : db -> string -> stmt 430 | (** [prepare db sql] compile SQL-statement [sql] for database [db] into 431 | bytecode. The statement may be only partially compiled. In this case 432 | {!prepare_tail} can be called on the returned statement to compile the 433 | remaining part of the SQL-statement. 434 | 435 | NOTE: this really uses the C-function [sqlite3_prepare_v2], i.e. avoids the 436 | older, deprecated [sqlite3_prepare]-function. 437 | 438 | @raise SqliteError if an invalid database handle is passed. 439 | @raise SqliteError if the statement could not be prepared. *) 440 | 441 | val prepare_or_reset : db -> stmt option ref -> string -> stmt 442 | (** [prepare_or_reset db opt_stmt_ref sql] if [opt_stmt_ref] contains 443 | [Some stmt], then [stmt] will be reset and returned. Otherwise fresh 444 | statement [stmt] will be prepared, stored as [Some stmt] in [opt_stmt_ref] 445 | and then returned. This is useful for executing multiple identical commands 446 | in a loop, because we can more efficiently reuse the statement from previous 447 | iterations. 448 | 449 | @raise SqliteError if the statement could not be prepared or reset. *) 450 | 451 | val prepare_tail : stmt -> stmt option 452 | (** [prepare_tail stmt] compile the remaining part of the SQL-statement [stmt] 453 | to bytecode. 454 | 455 | NOTE: this really uses the C-function [sqlite3_prepare_v2], i.e. avoids the 456 | older, deprecated [sqlite3_prepare]-function. 457 | 458 | @return 459 | [None] if there was no remaining part, or [Some remaining_part] otherwise. 460 | 461 | @raise SqliteError if the statement could not be prepared. *) 462 | 463 | val recompile : stmt -> unit 464 | (** [recompile stmt] recompiles the SQL-statement associated with [stmt] to 465 | bytecode. The statement may be only partially compiled. In this case 466 | {!prepare_tail} can be called on the statement to compile the remaining part 467 | of the SQL-statement. Call this function if the statement expires due to 468 | some schema change. 469 | 470 | @raise SqliteError if the statement could not be recompiled. *) 471 | 472 | val finalize : stmt -> Rc.t 473 | (** [finalize stmt] finalizes the statement [stmt]. After finalization, the only 474 | valid usage of the statement is to use it in {!prepare_tail}, or to 475 | {!recompile} it. 476 | 477 | @return the return code of this operation. 478 | 479 | @raise SqliteError if the statement could not be finalized. *) 480 | 481 | (** {3 Data query} *) 482 | 483 | val data_count : stmt -> int 484 | (** [data_count stmt] 485 | @return 486 | the number of columns in the result of the last step of statement [stmt]. 487 | 488 | @raise SqliteError if the statement is invalid. *) 489 | 490 | val column_count : stmt -> int 491 | (** [column_count stmt] 492 | @return 493 | the number of columns that would be returned by executing statement 494 | [stmt]. 495 | 496 | @raise SqliteError if the statement is invalid. *) 497 | 498 | val column : stmt -> int -> Data.t 499 | (** [column stmt n] 500 | @return 501 | the data in column [n] of the result of the last step of statement [stmt]. 502 | 503 | @raise RangeError if [n] is out of range. 504 | @raise SqliteError if the statement is invalid. *) 505 | 506 | val column_bool : stmt -> int -> bool 507 | (** [column_bool stmt n] 508 | @return 509 | the data in column [n] of the result of the last step of statement [stmt] 510 | as a [bool]. 511 | 512 | @raise RangeError if [n] is out of range. 513 | @raise SqliteError if the statement is invalid. *) 514 | 515 | val column_text : stmt -> int -> string 516 | (** [column_text stmt n] 517 | @return 518 | the data in column [n] of the result of the last step of statement [stmt] 519 | as text (a [string]). 520 | 521 | @raise RangeError if [n] is out of range. 522 | @raise SqliteError if the statement is invalid. *) 523 | 524 | val column_int : stmt -> int -> int 525 | (** [column_int stmt n] 526 | @return 527 | the data in column [n] of the result of the last step of statement [stmt] 528 | as an [int]. 529 | 530 | @raise RangeError if [n] is out of range. 531 | @raise Failure if the integer conversion over- or underflows. 532 | @raise SqliteError if the statement is invalid. *) 533 | 534 | val column_nativeint : stmt -> int -> nativeint 535 | (** [column_nativeint stmt n] 536 | @return 537 | the data in column [n] of the result of the last step of statement [stmt] 538 | as a [nativeint]. 539 | 540 | @raise RangeError if [n] is out of range. 541 | @raise Failure if the integer conversion over- or underflows. 542 | @raise SqliteError if the statement is invalid. *) 543 | 544 | val column_int32 : stmt -> int -> int32 545 | (** [column_int32 stmt n] 546 | @return 547 | the data in column [n] of the result of the last step of statement [stmt] 548 | as an [int32]. Note that this function exactly corresponds to the 549 | C-library function [sqlite3_column_int] and does not check for over- or 550 | underflow during integer conversions. 551 | 552 | @raise RangeError if [n] is out of range. 553 | @raise SqliteError if the statement is invalid. *) 554 | 555 | val column_int64 : stmt -> int -> int64 556 | (** [column_int64 stmt n] 557 | @return 558 | the data in column [n] of the result of the last step of statement [stmt] 559 | as an [int64]. Note that this function exactly corresponds to the 560 | C-library function [sqlite3_column_int64] and does not check for over- or 561 | underflow during integer conversions. 562 | 563 | @raise RangeError if [n] is out of range. 564 | @raise SqliteError if the statement is invalid. *) 565 | 566 | val column_double : stmt -> int -> float 567 | (** [column_double stmt n] 568 | @return 569 | the data in column [n] of the result of the last step of statement [stmt] 570 | as a double [float]. 571 | 572 | @raise RangeError if [n] is out of range. 573 | @raise SqliteError if the statement is invalid. *) 574 | 575 | val column_blob : stmt -> int -> string 576 | (** [column_blob stmt n] 577 | @return 578 | the blob string in column [n] of the result of the last step of statement 579 | [stmt] as a [string]. 580 | 581 | @raise RangeError if [n] is out of range. 582 | @raise SqliteError if the statement is invalid. *) 583 | 584 | val column_name : stmt -> int -> header 585 | (** [column_name stmt n] 586 | @return the header of column [n] in the result set of statement [stmt]. 587 | 588 | @raise RangeError if [n] is out of range. 589 | @raise SqliteError if the statement is invalid. *) 590 | 591 | val column_decltype : stmt -> int -> string option 592 | (** [column_decltype stmt n] 593 | @return 594 | the declared type of the specified column in the result set of statement 595 | [stmt] as [Some str] if available, or as [None] otherwise. 596 | 597 | @raise RangeError if [n] is out of range. 598 | @raise SqliteError if the statement is invalid. *) 599 | 600 | (** {3 Binding data to statements} *) 601 | 602 | val bind : stmt -> int -> Data.t -> Rc.t 603 | (** [bind stmt pos data] binds the value [data] to the free variable at position 604 | [pos] of statement [stmt]. NOTE: the first variable has index [1]! 605 | 606 | @return the return code of this operation. 607 | 608 | @raise RangeError if [pos] is out of range. 609 | @raise SqliteError if the statement is invalid. *) 610 | 611 | val bind_text : stmt -> int -> string -> Rc.t 612 | (** [bind_text stmt pos str] binds the string [str] to the parameter at position 613 | [pos] of the statement [stmt] as text. 614 | 615 | @return the return code of this operation. 616 | 617 | @raise RangeError if [pos] is out of range. 618 | @raise SqliteError if the statement is invalid. *) 619 | 620 | val bind_bool : stmt -> int -> bool -> Rc.t 621 | (** [bind_bool stmt pos b] binds the boolean [b] to the parameter at position 622 | [pos] of the statement [stmt] without having to manually convert it to an 623 | [int64] for use with [Data.INT]. [true] is turned into 1, [false] into 0. 624 | 625 | @return the return code of this operation. 626 | 627 | @raise RangeError if [pos] is out of range. 628 | @raise SqliteError if the statement is invalid. *) 629 | 630 | val bind_int : stmt -> int -> int -> Rc.t 631 | (** [bind_int stmt pos n] binds the integer [n] to the parameter at position 632 | [pos] of the statement [stmt] without having to manually convert it to an 633 | [int64] for use with [Data.INT]. 634 | 635 | @return the return code of this operation. 636 | 637 | @raise RangeError if [pos] is out of range. 638 | @raise SqliteError if the statement is invalid. *) 639 | 640 | val bind_nativeint : stmt -> int -> nativeint -> Rc.t 641 | (** [bind_nativeint stmt pos n] binds the integer [n] to the parameter at 642 | position [pos] of the statement [stmt] without having to manually convert it 643 | to an [int64] for use with [Data.INT]. 644 | 645 | @return the return code of this operation. 646 | 647 | @raise RangeError if [pos] is out of range. 648 | @raise SqliteError if the statement is invalid. *) 649 | 650 | val bind_int32 : stmt -> int -> int32 -> Rc.t 651 | (** [bind_int32 stmt pos n] binds the 32-bit integer [n] to the parameter at 652 | position [pos] of the statement [stmt] without having to manually convert it 653 | to an [int64] for use with [Data.INT]. 654 | 655 | @return the return code of this operation. 656 | 657 | @raise RangeError if [pos] is out of range. 658 | @raise SqliteError if the statement is invalid. *) 659 | 660 | val bind_int64 : stmt -> int -> int64 -> Rc.t 661 | (** [bind_int64 stmt pos n] binds the 64-bit integer [n] to the parameter at 662 | position [pos] of the statement [stmt]. 663 | 664 | @return the return code of this operation. 665 | 666 | @raise RangeError if [pos] is out of range. 667 | @raise SqliteError if the statement is invalid. *) 668 | 669 | val bind_double : stmt -> int -> float -> Rc.t 670 | (** [bind_double stmt pos n] binds the float [n] to the parameter at position 671 | [pos] of the statement [stmt]. 672 | 673 | @return the return code of this operation. 674 | 675 | @raise RangeError if [pos] is out of range. 676 | @raise SqliteError if the statement is invalid. *) 677 | 678 | val bind_blob : stmt -> int -> string -> Rc.t 679 | (** [bind_blob stmt pos str] binds the string [str] to the parameter at position 680 | [pos] of the statement [stmt] as a blob. 681 | 682 | @return the return code of this operation. 683 | 684 | @raise RangeError if [pos] is out of range. 685 | @raise SqliteError if the statement is invalid. *) 686 | 687 | val bind_values : stmt -> Data.t list -> Rc.t 688 | (** [bind_values stmt lst] binds the Nth element of [lst] to the Nth parameter 689 | of the statement. 690 | 691 | @return the return code of the first binding that fails, or [Rc.OK]. 692 | 693 | @raise RangeError 694 | if there aren't at least as many parameters as there are elements of the 695 | list. 696 | @raise SqliteError if the statement is invalid. *) 697 | 698 | val bind_name : stmt -> string -> Data.t -> Rc.t 699 | (** [bind_name stmt name data] binds the value [data] to the named parameter 700 | [name] of statement [stmt]. 701 | 702 | @return the return code of this operation. 703 | 704 | @raise Not_found if [name] does not exist. 705 | @raise SqliteError if the statement is invalid. *) 706 | 707 | val bind_names : stmt -> (string * Data.t) list -> Rc.t 708 | (** [bind_names stmt lst] binds the [(name, data)] pairs in [lst] to the 709 | parameters of statement [stmt]. 710 | 711 | @return the return code of the first binding that fails, or [Rc.OK]. 712 | 713 | @raise Not_found if a [name] does not exist. 714 | @raise SqliteError if the statement is invalid. *) 715 | 716 | val bind_parameter_count : stmt -> int 717 | (** [bind_parameter_count stmt] 718 | @return the number of free variables in statement [stmt]. 719 | 720 | @raise SqliteError if the statement is invalid. *) 721 | 722 | val bind_parameter_name : stmt -> int -> string option 723 | (** [bind_parameter_name stmt pos] 724 | @return 725 | [Some parameter_name] of the free variable at position [pos] of statement 726 | [stmt], or [None] if it is ordinary ("?"). 727 | 728 | @raise RangeError if [pos] is out of range. 729 | @raise SqliteError if the statement is invalid. *) 730 | 731 | val bind_parameter_index : stmt -> string -> int 732 | (** [bind_parameter_index stmt name] 733 | @return 734 | the position of the free variable with name [name] in statement [stmt]. 735 | 736 | @raise Not_found if [name] was not found. 737 | @raise SqliteError if the statement is invalid. *) 738 | 739 | val clear_bindings : stmt -> Rc.t 740 | (** [clear_bindings stmt] resets all bindings associated with prepared statement 741 | [stmt]. 742 | 743 | @return the return code of this operation. 744 | 745 | @raise SqliteError if the statement is invalid. *) 746 | 747 | (** {3 Executing statements} *) 748 | 749 | val step : stmt -> Rc.t 750 | (** [step stmt] performs one step of the query associated with SQL-statement 751 | [stmt]. 752 | 753 | @return the return code of this operation. 754 | 755 | @raise SqliteError if the step could not be executed. *) 756 | 757 | val reset : stmt -> Rc.t 758 | (** [reset stmt] resets the statement [stmt], e.g. to restart the query, perhaps 759 | with different bindings. 760 | 761 | @return the return code of this operation. 762 | 763 | @raise SqliteError if the statement could not be reset. *) 764 | 765 | val iter : stmt -> f:(Data.t array -> unit) -> Rc.t 766 | (** [iter stmt ~f] will call [f] once per row returned by stepping through 767 | [stmt]. The statement is automatically reset afterwards. 768 | 769 | @return [Rc.DONE] on success or another return code on error. 770 | 771 | @raise SqliteError if the statement is invalid. *) 772 | 773 | val fold : stmt -> f:('a -> Data.t array -> 'a) -> init:'a -> Rc.t * 'a 774 | (** [fold stmt ~f ~init] folds over the rows returned by [stmt] with function 775 | [f] and initial value [init]. The statement is automatically reset 776 | afterwards. 777 | 778 | @return 779 | [(rc, acc)] where [acc] is the last accumulated value returned by [f] 780 | after being called on a row. [rc] is [Rc.DONE] if all rows were processed 781 | and if the statement could be reset, otherwise an error code. 782 | 783 | @raise SqliteError if the statement is invalid. *) 784 | 785 | (** {3 Stepwise query convenience functions} *) 786 | 787 | val row_blobs : stmt -> string array 788 | (** [row_blobs stmt] 789 | @return 790 | the blobs returned by the last query step performed with statement [stmt] 791 | (array of blobs). 792 | 793 | @raise SqliteError if the statement is invalid. *) 794 | 795 | val row_data : stmt -> Data.t array 796 | (** [row_data stmt] 797 | @return 798 | all data values in the row returned by the last query step performed with 799 | statement [stmt]. 800 | 801 | @raise SqliteError if the statement is invalid. *) 802 | 803 | val row_names : stmt -> headers 804 | (** [row_names stmt] 805 | @return 806 | all column headers of the row returned by the last query step performed 807 | with statement [stmt]. 808 | 809 | @raise SqliteError if the statement is invalid. *) 810 | 811 | val row_decltypes : stmt -> string option array 812 | (** [row_decltypes stmt] 813 | @return 814 | all column type declarations of the row returned by the last query step 815 | performed with statement [stmt]. 816 | 817 | @raise SqliteError if the statement is invalid. *) 818 | 819 | (** {2 User-defined functions} *) 820 | 821 | val create_funN : db -> string -> (Data.t array -> Data.t) -> unit 822 | (** [create_funN db name f] registers function [f] under name [name] with 823 | database handle [db]. The function has arity [N]. 824 | 825 | @raise SqliteError if an invalid database handle is passed. *) 826 | 827 | val create_fun0 : db -> string -> (unit -> Data.t) -> unit 828 | (** [create_funN db name f] registers function [f] under name [name] with 829 | database handle [db]. The function has arity [0]. 830 | 831 | @raise SqliteError if an invalid database handle is passed. *) 832 | 833 | val create_fun1 : db -> string -> (Data.t -> Data.t) -> unit 834 | (** [create_fun1 db name f] registers function [f] under name [name] with 835 | database handle [db]. The function has arity [1]. 836 | 837 | @raise SqliteError if an invalid database handle is passed. *) 838 | 839 | val create_fun2 : db -> string -> (Data.t -> Data.t -> Data.t) -> unit 840 | (** [create_fun2 db name f] registers function [f] under name [name] with 841 | database handle [db]. The function has arity [2]. 842 | 843 | @raise SqliteError if an invalid database handle is passed. *) 844 | 845 | val create_fun3 : db -> string -> (Data.t -> Data.t -> Data.t -> Data.t) -> unit 846 | (** [create_fun3 db name f] registers function [f] under name [name] with 847 | database handle [db]. The function has arity [3]. 848 | 849 | @raise SqliteError if an invalid database handle is passed. *) 850 | 851 | val delete_function : db -> string -> unit 852 | (** [delete_function db name] deletes function with name [name] from database 853 | handle [db]. 854 | 855 | @raise SqliteError if an invalid database handle is passed. *) 856 | 857 | module Aggregate : sig 858 | (** Create user-defined aggregate and window functions. 859 | 860 | Aggregate functions provide the [step] function, which is called once per 861 | value being added to the aggregate, and the [final] function is called 862 | once to return the final value. 863 | 864 | To make a window function (requires SQLite3 3.25 or newer; on older 865 | versions a normal aggregate function is created), the additional [inverse] 866 | function, which removes a value from the window, and [value], which can be 867 | called many times and returns the current computed value of the window, 868 | must both be included. *) 869 | 870 | val create_fun0 : 871 | ?inverse:('a -> 'a) -> 872 | ?value:('a -> Data.t) -> 873 | db -> 874 | string -> 875 | init:'a -> 876 | step:('a -> 'a) -> 877 | final:('a -> Data.t) -> 878 | unit 879 | (** [create_fun0 ?inverse ?value db name ~init ~step ~final] registers the 880 | step and finalizer functions and optional inverse and value functions 881 | under name [name] with database handle [db]. This function has arity [0]. 882 | 883 | @raise SqliteError if an invalid database handle is passed. *) 884 | 885 | val create_fun1 : 886 | ?inverse:('a -> Data.t -> 'a) -> 887 | ?value:('a -> Data.t) -> 888 | db -> 889 | string -> 890 | init:'a -> 891 | step:('a -> Data.t -> 'a) -> 892 | final:('a -> Data.t) -> 893 | unit 894 | (** [create_fun1 ?inverse ?value db name ~init ~step ~final] registers the 895 | step and finalizer functions and optional inverse and value functions 896 | under name [name] with database handle [db]. This function has arity [1]. 897 | 898 | @raise SqliteError if an invalid database handle is passed. *) 899 | 900 | val create_fun2 : 901 | ?inverse:('a -> Data.t -> Data.t -> 'a) -> 902 | ?value:('a -> Data.t) -> 903 | db -> 904 | string -> 905 | init:'a -> 906 | step:('a -> Data.t -> Data.t -> 'a) -> 907 | final:('a -> Data.t) -> 908 | unit 909 | (** [create_fun2 ?inverse ?value db name ~init ~step ~final] registers the 910 | step and finalizer functions and optional inverse and value functions 911 | under name [name] with database handle [db]. This function has arity [2]. 912 | 913 | @raise SqliteError if an invalid database handle is passed. *) 914 | 915 | val create_fun3 : 916 | ?inverse:('a -> Data.t -> Data.t -> Data.t -> 'a) -> 917 | ?value:('a -> Data.t) -> 918 | db -> 919 | string -> 920 | init:'a -> 921 | step:('a -> Data.t -> Data.t -> Data.t -> 'a) -> 922 | final:('a -> Data.t) -> 923 | unit 924 | (** [create_fun3 ?inverse ?value db name ~init ~step ~final] registers the 925 | step and finalizer functions and optional inverse and value functions 926 | under name [name] with database handle [db]. This function has arity [3]. 927 | 928 | @raise SqliteError if an invalid database handle is passed. *) 929 | 930 | val create_funN : 931 | ?inverse:('a -> Data.t array -> 'a) -> 932 | ?value:('a -> Data.t) -> 933 | db -> 934 | string -> 935 | init:'a -> 936 | step:('a -> Data.t array -> 'a) -> 937 | final:('a -> Data.t) -> 938 | unit 939 | (** [create_funN ?inverse ?value db name ~init ~step ~final] registers the 940 | step and finalizer functions and optional inverse and value functions 941 | under name [name] with database handle [db]. This function has arity [N]. 942 | 943 | @raise SqliteError if an invalid database handle is passed. *) 944 | end 945 | 946 | val create_collation : db -> string -> (string -> string -> int) -> unit 947 | (** [create_collation db name func] creates a collation with [name] in database 948 | handle [db]. [func] is called when the collation is needed, it must return 949 | an integer that is negative, zero, or positive if the first string is less 950 | than, equal to, or greater than the second, respectively 951 | 952 | @raise SqliteError if an invalid database handle is passed. *) 953 | 954 | val delete_collation : db -> string -> unit 955 | (** [delete_collation db name] deletes collation with name [name] from database 956 | handle [db]. 957 | 958 | @raise SqliteError if an invalid database handle is passed. *) 959 | 960 | module Backup : sig 961 | type t 962 | (** Type of a backup between two databases *) 963 | 964 | val init : dst:db -> dst_name:string -> src:db -> src_name:string -> t 965 | (** [init ~dst ~dst_name ~src ~src_name] initializes a backup from the 966 | database [src]/[src_name] to the database [dst]/[dst_name]. 967 | 968 | @raise SqliteError 969 | if there is already a read or read-write transaction open on the 970 | destination database *) 971 | 972 | val step : t -> int -> Rc.t 973 | (** [step backup pagecount] will copy up to [pagecount] pages between the 974 | associated databases of [backup]. *) 975 | 976 | val finish : t -> Rc.t 977 | (** [finish backup] destroys the association [backup]; this is to be called 978 | after [step] returns [SQLITE_DONE]. *) 979 | 980 | val remaining : t -> int 981 | (** [remaining backup] returns the number of pages still to be backed up in 982 | [backup]. *) 983 | 984 | val pagecount : t -> int 985 | (** [pagecount backup] returns the total number of pages in the source 986 | database of [backup]. *) 987 | end 988 | 989 | (** {2 Utility functions} *) 990 | 991 | val busy_timeout : db -> int -> unit 992 | (** [busy_timeout db ms] sets a busy handler that sleeps for a specified amount 993 | of time when a table is locked. The handler will sleep multiple times until 994 | at least [ms] milliseconds of sleeping have accumulated. 995 | 996 | @raise SqliteError if an invalid database handle is passed. *) 997 | 998 | val sleep : int -> int 999 | (** [sleep ms] sleeps at least [ms] milliseconds. 1000 | @return 1001 | the number of milliseconds of sleep actually requested from the operating 1002 | system. *) 1003 | -------------------------------------------------------------------------------- /lib/sqlite3_stubs.c: -------------------------------------------------------------------------------- 1 | /**************************************************************************/ 2 | /* Copyright © 2010- Markus Mottl */ 3 | /* Copyright © 2007-2010 Jane Street Holding, LLC */ 4 | /* Copyright © 2005-2007 Christian Szegedy */ 5 | /* */ 6 | /* Permission is hereby granted, free of charge, to any person */ 7 | /* obtaining a copy of this software and associated documentation files */ 8 | /* (the "Software"), to deal in the Software without restriction, */ 9 | /* including without limitation the rights to use, copy, modify, merge, */ 10 | /* publish, distribute, sublicense, and/or sell copies of the Software, */ 11 | /* and to permit persons to whom the Software is furnished to do so, */ 12 | /* subject to the following conditions: */ 13 | /* */ 14 | /* The above copyright notice and this permission notice shall be */ 15 | /* included in all copies or substantial portions of the Software. */ 16 | /* */ 17 | /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, */ 18 | /* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES */ 19 | /* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND */ 20 | /* NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS */ 21 | /* BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN */ 22 | /* ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN */ 23 | /* CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE */ 24 | /* SOFTWARE. */ 25 | /**************************************************************************/ 26 | 27 | #include 28 | #include 29 | 30 | #include 31 | 32 | #include 33 | #include 34 | #include 35 | #include 36 | #include 37 | #include 38 | #include 39 | #include 40 | 41 | #include 42 | 43 | #if __GNUC__ >= 3 44 | #if !defined(__FreeBSD__) && !defined(__NetBSD__) && !defined(__DragonFly) && \ 45 | !__APPLE__ 46 | #define __unused __attribute__((unused)) 47 | #endif 48 | #else 49 | #define __unused 50 | #endif 51 | 52 | #if SQLITE_VERSION_NUMBER >= 3003007 && !SQLITE3_DISABLE_LOADABLE_EXTENSIONS 53 | #define SQLITE_HAS_ENABLE_LOAD_EXTENSION 54 | #endif 55 | 56 | #if SQLITE_VERSION_NUMBER >= 3003009 57 | #define my_sqlite3_prepare sqlite3_prepare_v2 58 | #else 59 | #define my_sqlite3_prepare sqlite3_prepare 60 | #endif 61 | 62 | #if SQLITE_VERSION_NUMBER >= 3005000 63 | #define SQLITE_HAS_OPEN_V2 64 | #endif 65 | 66 | #if SQLITE_VERSION_NUMBER >= 3007014 67 | #define my_sqlite3_close sqlite3_close_v2 68 | #else 69 | #define my_sqlite3_close sqlite3_close 70 | #endif 71 | 72 | #if SQLITE_VERSION_NUMBER >= 3006000 73 | #define SQLITE_HAS_OPEN_MUTEX_PARAMS 74 | #endif 75 | 76 | #if SQLITE_VERSION_NUMBER >= 3006018 77 | #define SQLITE_HAS_OPEN_CACHE_PARAMS 78 | #endif 79 | 80 | #ifndef _WIN32 81 | #include 82 | #else 83 | #include 84 | typedef DWORD pthread_key_t; 85 | 86 | static void destroy_user_exception(void *user_exc_); 87 | 88 | static int pthread_key_create(pthread_key_t *key, void (*destructor)(void *)) { 89 | CAMLassert(destructor == &destroy_user_exception); 90 | *key = TlsAlloc(); 91 | if (*key == TLS_OUT_OF_INDEXES) 92 | return GetLastError(); 93 | else 94 | return 0; 95 | } 96 | 97 | static inline void *pthread_getspecific(pthread_key_t key) { 98 | return TlsGetValue(key); 99 | } 100 | 101 | static int pthread_setspecific(pthread_key_t key, void *value) { 102 | void *old = TlsGetValue(key); 103 | if (old) 104 | destroy_user_exception(old); 105 | return TlsSetValue(key, value); 106 | } 107 | #endif 108 | 109 | /* Utility definitions */ 110 | 111 | static inline value Val_string_option(const char *str) { 112 | return (str == NULL) ? Val_none : caml_alloc_some(caml_copy_string(str)); 113 | } 114 | 115 | /* Type definitions */ 116 | 117 | typedef struct user_function { 118 | value v_fun; 119 | struct user_function *next; 120 | } user_function; 121 | 122 | typedef struct user_collation { 123 | value v_fun; 124 | struct user_collation *next; 125 | } user_collation; 126 | 127 | typedef struct db_wrap { 128 | sqlite3 *db; 129 | int rc; 130 | _Atomic(int) ref_count; 131 | user_function *user_functions; 132 | user_collation *user_collations; 133 | } db_wrap; 134 | 135 | typedef struct stmt_wrap { 136 | sqlite3_stmt *stmt; 137 | char *sql; 138 | int sql_len; 139 | char *tail; 140 | db_wrap *db_wrap; 141 | } stmt_wrap; 142 | 143 | /* Handling of exceptions in user-defined SQL-functions */ 144 | 145 | /* For propagating exceptions from user-defined SQL-functions */ 146 | static pthread_key_t user_exception_key; 147 | 148 | typedef struct user_exception { 149 | value exn; 150 | } user_exception; 151 | 152 | static inline void create_user_exception(value v_exn) { 153 | user_exception *user_exn = caml_stat_alloc(sizeof(user_exception)); 154 | user_exn->exn = v_exn; 155 | caml_register_global_root(&user_exn->exn); 156 | pthread_setspecific(user_exception_key, user_exn); 157 | } 158 | 159 | static inline void destroy_user_exception(void *user_exc_) { 160 | user_exception *user_exn = user_exc_; 161 | caml_remove_global_root(&user_exn->exn); 162 | caml_stat_free(user_exn); 163 | } 164 | 165 | static inline void maybe_raise_user_exception(int rc) { 166 | if (rc == SQLITE_ERROR) { 167 | user_exception *user_exn = pthread_getspecific(user_exception_key); 168 | 169 | if (user_exn != NULL) { 170 | CAMLparam0(); 171 | CAMLlocal1(v_exn); 172 | v_exn = user_exn->exn; 173 | destroy_user_exception(user_exn); 174 | pthread_setspecific(user_exception_key, NULL); 175 | caml_raise(v_exn); 176 | CAMLnoreturn; 177 | } 178 | } 179 | } 180 | 181 | /* Macros to access the wrapper structures stored in the custom blocks */ 182 | 183 | #define Sqlite3_val(x) (*((db_wrap **)Data_custom_val(x))) 184 | #define Sqlite3_stmtw_val(x) (*((stmt_wrap **)Data_custom_val(x))) 185 | 186 | /* Exceptions */ 187 | 188 | static const value *caml_sqlite3_InternalError = NULL; 189 | static const value *caml_sqlite3_Error = NULL; 190 | static const value *caml_sqlite3_RangeError = NULL; 191 | 192 | static inline void raise_with_two_args(value v_tag, value v_arg1, 193 | value v_arg2) { 194 | CAMLparam3(v_tag, v_arg1, v_arg2); 195 | value v_exn = caml_alloc_small(3, 0); 196 | Field(v_exn, 0) = v_tag; 197 | Field(v_exn, 1) = v_arg1; 198 | Field(v_exn, 2) = v_arg2; 199 | caml_raise(v_exn); 200 | CAMLnoreturn; 201 | } 202 | 203 | CAMLnoreturn_start static inline void 204 | raise_sqlite3_InternalError(char *msg) CAMLnoreturn_end; 205 | 206 | static inline void raise_sqlite3_InternalError(char *msg) { 207 | caml_raise_with_string(*caml_sqlite3_InternalError, msg); 208 | } 209 | 210 | static inline void range_check(int v, int max) { 211 | if (v < 0 || v >= max) 212 | raise_with_two_args(*caml_sqlite3_RangeError, Val_int(v), Val_int(max)); 213 | } 214 | 215 | CAMLnoreturn_start static void raise_sqlite3_Error(const char *fmt, 216 | ...) CAMLnoreturn_end; 217 | 218 | static void raise_sqlite3_Error(const char *fmt, ...) { 219 | char buf[1024]; 220 | va_list args; 221 | 222 | va_start(args, fmt); 223 | vsnprintf(buf, sizeof buf, fmt, args); 224 | va_end(args); 225 | 226 | caml_raise_with_string(*caml_sqlite3_Error, buf); 227 | } 228 | 229 | static void raise_sqlite3_misuse_db(db_wrap *dbw, const char *fmt, ...) { 230 | char buf[1024]; 231 | va_list args; 232 | 233 | dbw->rc = SQLITE_MISUSE; 234 | 235 | va_start(args, fmt); 236 | vsnprintf(buf, sizeof buf, fmt, args); 237 | va_end(args); 238 | 239 | raise_sqlite3_Error("%s", buf); 240 | } 241 | 242 | static inline void raise_sqlite3_current(sqlite3 *db, const char *loc) { 243 | const char *what = sqlite3_errmsg(db); 244 | if (!what) 245 | what = ""; 246 | raise_sqlite3_Error("Sqlite3.%s: %s", loc, what); 247 | } 248 | 249 | static inline void check_db(db_wrap *dbw, const char *loc) { 250 | if (!dbw->db) 251 | raise_sqlite3_misuse_db(dbw, "Sqlite3.%s called with closed database", loc); 252 | } 253 | 254 | static void raise_sqlite3_misuse_stmt(const char *fmt, ...) { 255 | char buf[1024]; 256 | va_list args; 257 | 258 | va_start(args, fmt); 259 | vsnprintf(buf, sizeof buf, fmt, args); 260 | va_end(args); 261 | 262 | caml_raise_with_string(*caml_sqlite3_Error, buf); 263 | } 264 | 265 | static inline void check_stmt(stmt_wrap *stw, char *loc) { 266 | if (stw->stmt == NULL) 267 | raise_sqlite3_misuse_stmt("Sqlite3.%s called with finalized stmt", loc); 268 | } 269 | 270 | static inline stmt_wrap *safe_get_stmtw(char *loc, value v_stmt) { 271 | stmt_wrap *stmtw = Sqlite3_stmtw_val(v_stmt); 272 | check_stmt(stmtw, loc); 273 | return stmtw; 274 | } 275 | 276 | /* Initialisation */ 277 | 278 | CAMLprim value caml_sqlite3_init(value __unused v_unit) { 279 | caml_sqlite3_InternalError = caml_named_value("Sqlite3.InternalError"); 280 | caml_sqlite3_Error = caml_named_value("Sqlite3.Error"); 281 | caml_sqlite3_RangeError = caml_named_value("Sqlite3.RangeError"); 282 | pthread_key_create(&user_exception_key, destroy_user_exception); 283 | return Val_unit; 284 | } 285 | 286 | CAMLprim value caml_sqlite3_cleanup(value __unused v_unit) { 287 | pthread_setspecific(user_exception_key, NULL); 288 | return Val_unit; 289 | } 290 | 291 | /* Conversion from return values */ 292 | 293 | static inline value Val_rc(int rc) { 294 | value v_res; 295 | if (rc >= 0) { 296 | if (rc <= 26) 297 | return Val_int(rc); 298 | if (rc == 100 || rc == 101) 299 | return Val_int(rc - 73); 300 | } 301 | v_res = caml_alloc_small(1, 0); 302 | Field(v_res, 0) = Val_int(rc); 303 | return v_res; 304 | } 305 | 306 | /* Copying rows */ 307 | 308 | static inline value copy_string_option_array(const char **strs, int len) { 309 | if (!len) 310 | return Atom(0); 311 | else { 312 | CAMLparam0(); 313 | CAMLlocal2(v_str, v_res); 314 | int i; 315 | 316 | v_res = caml_alloc(len, 0); 317 | 318 | for (i = 0; i < len; ++i) { 319 | const char *str = strs[i]; 320 | if (str == NULL) 321 | Field(v_res, i) = Val_none; 322 | else 323 | Store_field(v_res, i, caml_alloc_some(caml_copy_string(str))); 324 | } 325 | 326 | CAMLreturn(v_res); 327 | } 328 | } 329 | 330 | static inline value copy_not_null_string_array(const char **strs, int len) { 331 | if (!len) 332 | return Atom(0); 333 | else { 334 | CAMLparam0(); 335 | CAMLlocal1(v_res); 336 | int i; 337 | 338 | v_res = caml_alloc(len, 0); 339 | 340 | for (i = 0; i < len; ++i) { 341 | const char *str = strs[i]; 342 | if (str == NULL) { 343 | v_res = (value)NULL; 344 | break; 345 | } else 346 | Store_field(v_res, i, caml_copy_string(str)); 347 | } 348 | 349 | CAMLreturn(v_res); 350 | } 351 | } 352 | 353 | static inline value safe_copy_header_strings(const char **strs, int len) { 354 | value v_res = copy_not_null_string_array(strs, len); 355 | if (v_res == (value)NULL) 356 | raise_sqlite3_Error("Null element in header"); 357 | return v_res; 358 | } 359 | 360 | /* Databases */ 361 | 362 | static inline void ref_count_finalize_dbw(db_wrap *dbw) { 363 | if (atomic_fetch_sub(&dbw->ref_count, 1) == 1) { 364 | user_function *link, *next; 365 | for (link = dbw->user_functions; link != NULL; link = next) { 366 | caml_remove_generational_global_root(&link->v_fun); 367 | next = link->next; 368 | caml_stat_free(link); 369 | } 370 | dbw->user_functions = NULL; 371 | user_collation *link_c, *next_c; 372 | for (link_c = dbw->user_collations; link_c != NULL; link_c = next_c) { 373 | caml_remove_generational_global_root(&link_c->v_fun); 374 | next_c = link_c->next; 375 | caml_stat_free(link_c); 376 | } 377 | dbw->user_collations = NULL; 378 | my_sqlite3_close(dbw->db); 379 | caml_stat_free(dbw); 380 | } 381 | } 382 | 383 | static inline void db_wrap_finalize_gc(value v_dbw) { 384 | db_wrap *dbw = Sqlite3_val(v_dbw); 385 | if (dbw->db) 386 | ref_count_finalize_dbw(dbw); 387 | } 388 | 389 | static struct custom_operations db_wrap_ops = { 390 | "sqlite3_ocaml_db_wrap", db_wrap_finalize_gc, 391 | custom_compare_default, custom_hash_default, 392 | custom_serialize_default, custom_deserialize_default, 393 | custom_compare_ext_default, custom_fixed_length_default, 394 | }; 395 | 396 | #ifdef SQLITE_HAS_OPEN_V2 397 | static inline int get_open_flags(value v_mode, value v_uri, value v_memory, 398 | value v_mutex, value v_cache) { 399 | int flags; 400 | switch (Int_val(v_mode)) { 401 | case 0: 402 | flags = (SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE); 403 | break; 404 | case 1: 405 | flags = SQLITE_OPEN_READWRITE; 406 | break; 407 | default: 408 | flags = SQLITE_OPEN_READONLY; 409 | break; 410 | } 411 | if (Bool_val(v_uri)) 412 | flags |= SQLITE_OPEN_URI; 413 | if (Bool_val(v_memory)) 414 | flags |= SQLITE_OPEN_MEMORY; 415 | switch (Int_val(v_mutex)) { 416 | case 0: 417 | break; 418 | #ifdef SQLITE_HAS_OPEN_MUTEX_PARAMS 419 | case 1: 420 | flags |= SQLITE_OPEN_NOMUTEX; 421 | break; 422 | default: 423 | flags |= SQLITE_OPEN_FULLMUTEX; 424 | break; 425 | #else 426 | default: 427 | caml_failwith( 428 | "SQLite3 version < 3.6.0 does not support mutex parameters for open"); 429 | #endif 430 | } 431 | switch (Int_val(v_cache)) { 432 | case 0: 433 | break; 434 | #ifdef SQLITE_HAS_OPEN_CACHE_PARAMS 435 | case 1: 436 | flags |= SQLITE_OPEN_SHAREDCACHE; 437 | break; 438 | default: 439 | flags |= SQLITE_OPEN_PRIVATECACHE; 440 | break; 441 | #else 442 | default: 443 | caml_failwith( 444 | "SQLite3 version < 3.6.18 does not support cache parameters for open"); 445 | #endif 446 | } 447 | return flags; 448 | } 449 | #endif 450 | 451 | CAMLprim value caml_sqlite3_version(value __unused v_dummy) { 452 | return Val_int(sqlite3_libversion_number()); 453 | } 454 | 455 | CAMLprim value caml_sqlite3_version_info(value __unused v_dummy) { 456 | return caml_copy_string(sqlite3_libversion()); 457 | } 458 | 459 | CAMLprim value caml_sqlite3_open(value v_mode, value v_uri, value v_memory, 460 | value v_mutex, value v_cache, value v_vfs_opt, 461 | value v_file) { 462 | sqlite3 *db; 463 | int res; 464 | #ifdef SQLITE_HAS_OPEN_V2 465 | int flags = get_open_flags(v_mode, v_uri, v_memory, v_mutex, v_cache); 466 | char *vfs; 467 | #endif 468 | int file_len = caml_string_length(v_file) + 1; 469 | char *file; 470 | 471 | #ifdef SQLITE_HAS_OPEN_V2 472 | if (Is_none(v_vfs_opt)) 473 | vfs = NULL; 474 | else { 475 | value v_vfs = Field(v_vfs_opt, 0); 476 | int vfs_len = caml_string_length(v_vfs) + 1; 477 | vfs = caml_stat_alloc(vfs_len); 478 | memcpy(vfs, String_val(v_vfs), vfs_len); 479 | } 480 | #else 481 | if (Int_val(v_mode) || Bool_val(v_uri) || Bool_val(v_memory) || 482 | Int_val(v_mutex) || Int_val(v_cache)) 483 | caml_failwith("SQLite3 version < 3.5 does not support open flags"); 484 | if (Is_some(v_vfs_opt)) 485 | caml_failwith("SQLite3 version < 3.5 does not support VFS modules"); 486 | #endif 487 | 488 | file = caml_stat_alloc(file_len); 489 | memcpy(file, String_val(v_file), file_len); 490 | 491 | caml_enter_blocking_section(); 492 | #ifdef SQLITE_HAS_OPEN_V2 493 | res = sqlite3_open_v2(file, &db, flags, vfs); 494 | caml_stat_free(vfs); 495 | #else 496 | res = sqlite3_open(file, &db); 497 | #endif 498 | caml_stat_free(file); 499 | caml_leave_blocking_section(); 500 | 501 | if (res) { 502 | char msg[1024]; 503 | if (db) { 504 | /* Can't use sqlite3_errmsg()'s return value after closing the 505 | database. */ 506 | snprintf(msg, sizeof msg, "%s", sqlite3_errmsg(db)); 507 | my_sqlite3_close(db); 508 | } else { 509 | strcpy(msg, ""); 510 | } 511 | raise_sqlite3_Error("error opening database: %s", msg); 512 | } else if (db == NULL) 513 | raise_sqlite3_InternalError( 514 | "open returned neither a database nor an error"); 515 | /* "open" succeded */ 516 | { 517 | size_t db_wrap_size = sizeof(db_wrap); 518 | db_wrap *dbw = caml_stat_alloc(db_wrap_size); 519 | value v_res; 520 | #if SQLITE_DBSTATUS_CACHE_USED 521 | int mem, hiwtr; 522 | int rc = sqlite3_db_status(db, SQLITE_DBSTATUS_CACHE_USED, &mem, &hiwtr, 0); 523 | mem = db_wrap_size + (rc ? 8192 : mem); 524 | v_res = caml_alloc_custom_mem(&db_wrap_ops, sizeof(db_wrap *), mem); 525 | #else 526 | v_res = caml_alloc_custom(&db_wrap_ops, sizeof(db_wrap *), 1, 1000); 527 | #endif 528 | dbw->db = db; 529 | dbw->rc = SQLITE_OK; 530 | dbw->ref_count = 1; 531 | dbw->user_functions = NULL; 532 | dbw->user_collations = NULL; 533 | Sqlite3_val(v_res) = dbw; 534 | return v_res; 535 | } 536 | } 537 | 538 | CAMLprim value caml_sqlite3_open_bc(value *argv, int __unused argn) { 539 | return caml_sqlite3_open(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], 540 | argv[6]); 541 | } 542 | 543 | CAMLprim value caml_sqlite3_close(value v_db) { 544 | int ret, not_busy; 545 | db_wrap *dbw = Sqlite3_val(v_db); 546 | check_db(dbw, "close"); 547 | ret = my_sqlite3_close(dbw->db); 548 | not_busy = ret != SQLITE_BUSY; 549 | if (not_busy) 550 | dbw->db = NULL; 551 | return Val_bool(not_busy); 552 | } 553 | 554 | #ifdef SQLITE_HAS_ENABLE_LOAD_EXTENSION 555 | CAMLprim value caml_sqlite3_enable_load_extension(value v_db, value v_onoff) { 556 | int ret; 557 | db_wrap *dbw = Sqlite3_val(v_db); 558 | ret = sqlite3_enable_load_extension(dbw->db, Bool_val(v_onoff)); 559 | return Val_bool(ret == SQLITE_OK); 560 | } 561 | #else 562 | CAMLprim value caml_sqlite3_enable_load_extension(value __unused v_db, 563 | value __unused v_onoff) { 564 | caml_failwith("enable_load_extension: unsupported"); 565 | } 566 | #endif 567 | 568 | /* Informational functions */ 569 | 570 | CAMLprim value caml_sqlite3_errcode(value v_db) { 571 | db_wrap *dbw = Sqlite3_val(v_db); 572 | check_db(dbw, "errcode"); 573 | return Val_rc(sqlite3_errcode(dbw->db)); 574 | } 575 | 576 | CAMLprim value caml_sqlite3_extended_errcode_int(value v_db) { 577 | db_wrap *dbw = Sqlite3_val(v_db); 578 | check_db(dbw, "extended_errcode"); 579 | return Val_int(sqlite3_extended_errcode(dbw->db)); 580 | } 581 | 582 | CAMLprim value caml_sqlite3_errmsg(value v_db) { 583 | db_wrap *dbw = Sqlite3_val(v_db); 584 | check_db(dbw, "errmsg"); 585 | return caml_copy_string(sqlite3_errmsg(dbw->db)); 586 | } 587 | 588 | CAMLprim int64_t caml_sqlite3_last_insert_rowid(value v_db) { 589 | db_wrap *dbw = Sqlite3_val(v_db); 590 | check_db(dbw, "last_insert_rowid"); 591 | return sqlite3_last_insert_rowid(dbw->db); 592 | } 593 | 594 | CAMLprim value caml_sqlite3_last_insert_rowid_bc(value v_db) { 595 | return caml_copy_int64(caml_sqlite3_last_insert_rowid(v_db)); 596 | } 597 | 598 | /* Execution and callbacks */ 599 | 600 | typedef struct callback_with_exn { 601 | value *cbp; 602 | value *exn; 603 | } callback_with_exn; 604 | 605 | static inline int exec_callback(void *cbx_, int num_columns, char **row, 606 | char **header) { 607 | callback_with_exn *cbx = cbx_; 608 | value v_row, v_header, v_ret; 609 | 610 | caml_leave_blocking_section(); 611 | 612 | v_row = copy_string_option_array((const char **)row, num_columns); 613 | 614 | Begin_roots1(v_row); 615 | v_header = safe_copy_header_strings((const char **)header, num_columns); 616 | End_roots(); 617 | 618 | v_ret = caml_callback2_exn(*cbx->cbp, v_row, v_header); 619 | 620 | if (Is_exception_result(v_ret)) { 621 | *cbx->exn = Extract_exception(v_ret); 622 | caml_enter_blocking_section(); 623 | return 1; 624 | } 625 | 626 | caml_enter_blocking_section(); 627 | 628 | return 0; 629 | } 630 | 631 | CAMLprim value caml_sqlite3_exec(value v_db, value v_maybe_cb, value v_sql) { 632 | CAMLparam1(v_db); 633 | CAMLlocal2(v_cb, v_exn); 634 | callback_with_exn cbx; 635 | db_wrap *dbw = Sqlite3_val(v_db); 636 | int len = caml_string_length(v_sql) + 1; 637 | char *sql; 638 | int rc; 639 | sqlite3_callback cb = NULL; 640 | 641 | check_db(dbw, "exec"); 642 | sql = caml_stat_alloc(len); 643 | memcpy(sql, String_val(v_sql), len); 644 | cbx.cbp = &v_cb; 645 | cbx.exn = &v_exn; 646 | 647 | if (Is_some(v_maybe_cb)) { 648 | v_cb = Field(v_maybe_cb, 0); 649 | cb = exec_callback; 650 | } 651 | 652 | caml_enter_blocking_section(); 653 | rc = sqlite3_exec(dbw->db, sql, cb, (void *)&cbx, NULL); 654 | caml_stat_free(sql); 655 | caml_leave_blocking_section(); 656 | 657 | if (rc == SQLITE_ABORT) 658 | caml_raise(*cbx.exn); 659 | maybe_raise_user_exception(rc); 660 | 661 | CAMLreturn(Val_rc(rc)); 662 | } 663 | 664 | static inline int exec_callback_no_headers(void *cbx_, int num_columns, 665 | char **row, char __unused **header) { 666 | callback_with_exn *cbx = cbx_; 667 | value v_row, v_ret; 668 | 669 | caml_leave_blocking_section(); 670 | 671 | v_row = copy_string_option_array((const char **)row, num_columns); 672 | v_ret = caml_callback_exn(*cbx->cbp, v_row); 673 | 674 | if (Is_exception_result(v_ret)) { 675 | *cbx->exn = Extract_exception(v_ret); 676 | caml_enter_blocking_section(); 677 | return 1; 678 | } 679 | 680 | caml_enter_blocking_section(); 681 | 682 | return 0; 683 | } 684 | 685 | CAMLprim value caml_sqlite3_exec_no_headers(value v_db, value v_cb, 686 | value v_sql) { 687 | CAMLparam2(v_db, v_cb); 688 | CAMLlocal1(v_exn); 689 | callback_with_exn cbx; 690 | db_wrap *dbw = Sqlite3_val(v_db); 691 | int len = caml_string_length(v_sql) + 1; 692 | char *sql; 693 | int rc; 694 | 695 | check_db(dbw, "exec_no_headers"); 696 | sql = caml_stat_alloc(len); 697 | memcpy(sql, String_val(v_sql), len); 698 | cbx.cbp = &v_cb; 699 | cbx.exn = &v_exn; 700 | 701 | caml_enter_blocking_section(); 702 | rc = sqlite3_exec(dbw->db, sql, exec_callback_no_headers, (void *)&cbx, NULL); 703 | caml_stat_free(sql); 704 | caml_leave_blocking_section(); 705 | 706 | if (rc == SQLITE_ABORT) 707 | caml_raise(*cbx.exn); 708 | maybe_raise_user_exception(rc); 709 | 710 | CAMLreturn(Val_rc(rc)); 711 | } 712 | 713 | static inline int exec_not_null_callback(void *cbx_, int num_columns, 714 | char **row, char **header) { 715 | callback_with_exn *cbx = cbx_; 716 | value v_row, v_header, v_ret; 717 | 718 | caml_leave_blocking_section(); 719 | 720 | v_row = copy_not_null_string_array((const char **)row, num_columns); 721 | 722 | if (v_row == (value)NULL) { 723 | caml_enter_blocking_section(); 724 | return 1; 725 | } 726 | 727 | Begin_roots1(v_row); 728 | v_header = safe_copy_header_strings((const char **)header, num_columns); 729 | End_roots(); 730 | 731 | v_ret = caml_callback2_exn(*cbx->cbp, v_row, v_header); 732 | 733 | if (Is_exception_result(v_ret)) { 734 | *cbx->exn = Extract_exception(v_ret); 735 | caml_enter_blocking_section(); 736 | return 1; 737 | } 738 | 739 | caml_enter_blocking_section(); 740 | 741 | return 0; 742 | } 743 | 744 | CAMLprim value caml_sqlite3_exec_not_null(value v_db, value v_cb, value v_sql) { 745 | CAMLparam2(v_db, v_cb); 746 | CAMLlocal1(v_exn); 747 | callback_with_exn cbx; 748 | db_wrap *dbw = Sqlite3_val(v_db); 749 | int len = caml_string_length(v_sql) + 1; 750 | char *sql; 751 | int rc; 752 | 753 | check_db(dbw, "exec_not_null"); 754 | sql = caml_stat_alloc(len); 755 | memcpy(sql, String_val(v_sql), len); 756 | cbx.cbp = &v_cb; 757 | cbx.exn = &v_exn; 758 | 759 | caml_enter_blocking_section(); 760 | rc = sqlite3_exec(dbw->db, sql, exec_not_null_callback, (void *)&cbx, NULL); 761 | caml_stat_free(sql); 762 | caml_leave_blocking_section(); 763 | 764 | if (rc == SQLITE_ABORT) { 765 | if (*cbx.exn != 0) 766 | caml_raise(*cbx.exn); 767 | else 768 | raise_sqlite3_Error("Null element in row"); 769 | } 770 | maybe_raise_user_exception(rc); 771 | 772 | CAMLreturn(Val_rc(rc)); 773 | } 774 | 775 | static inline int exec_not_null_no_headers_callback(void *cbx_, int num_columns, 776 | char **row, 777 | char __unused **header) { 778 | callback_with_exn *cbx = cbx_; 779 | value v_row, v_ret; 780 | 781 | caml_leave_blocking_section(); 782 | 783 | v_row = copy_not_null_string_array((const char **)row, num_columns); 784 | if (v_row == (value)NULL) { 785 | caml_enter_blocking_section(); 786 | return 1; 787 | } 788 | 789 | v_ret = caml_callback_exn(*cbx->cbp, v_row); 790 | 791 | if (Is_exception_result(v_ret)) { 792 | *cbx->exn = Extract_exception(v_ret); 793 | caml_enter_blocking_section(); 794 | return 1; 795 | } 796 | 797 | caml_enter_blocking_section(); 798 | 799 | return 0; 800 | } 801 | 802 | CAMLprim value caml_sqlite3_exec_not_null_no_headers(value v_db, value v_cb, 803 | value v_sql) { 804 | CAMLparam2(v_db, v_cb); 805 | CAMLlocal1(v_exn); 806 | callback_with_exn cbx; 807 | db_wrap *dbw = Sqlite3_val(v_db); 808 | int len = caml_string_length(v_sql) + 1; 809 | char *sql; 810 | int rc; 811 | 812 | check_db(dbw, "exec_not_null_no_headers"); 813 | sql = caml_stat_alloc(len); 814 | memcpy(sql, String_val(v_sql), len); 815 | cbx.cbp = &v_cb; 816 | cbx.exn = &v_exn; 817 | 818 | caml_enter_blocking_section(); 819 | rc = sqlite3_exec(dbw->db, sql, exec_not_null_no_headers_callback, 820 | (void *)&cbx, NULL); 821 | caml_stat_free(sql); 822 | caml_leave_blocking_section(); 823 | 824 | if (rc == SQLITE_ABORT) { 825 | if (*cbx.exn != 0) 826 | caml_raise(*cbx.exn); 827 | else 828 | raise_sqlite3_Error("Null element in row"); 829 | } 830 | maybe_raise_user_exception(rc); 831 | 832 | CAMLreturn(Val_rc(rc)); 833 | } 834 | 835 | /* Statements */ 836 | 837 | static inline void stmt_wrap_finalize_gc(value v_stmt) { 838 | stmt_wrap *stmtw = Sqlite3_stmtw_val(v_stmt); 839 | sqlite3_stmt *stmt = stmtw->stmt; 840 | if (stmt) 841 | sqlite3_finalize(stmt); 842 | if (stmtw->sql) 843 | caml_stat_free(stmtw->sql); 844 | ref_count_finalize_dbw(stmtw->db_wrap); 845 | caml_stat_free(stmtw); 846 | } 847 | 848 | static struct custom_operations stmt_wrap_ops = { 849 | "sqlite3_ocaml_stmt_wrap", stmt_wrap_finalize_gc, 850 | custom_compare_default, custom_hash_default, 851 | custom_serialize_default, custom_deserialize_default, 852 | custom_compare_ext_default, custom_fixed_length_default}; 853 | 854 | static inline value prepare_it(db_wrap *dbw, const char *sql, int sql_len, 855 | const char *loc) { 856 | int rc; 857 | stmt_wrap *stmtw = caml_stat_alloc(sizeof(stmt_wrap)); 858 | stmtw->db_wrap = dbw; 859 | stmtw->sql = caml_stat_alloc(sql_len + 1); 860 | memcpy(stmtw->sql, sql, sql_len); 861 | stmtw->sql[sql_len] = '\0'; 862 | stmtw->sql_len = sql_len; 863 | rc = my_sqlite3_prepare(dbw->db, stmtw->sql, sql_len, &(stmtw->stmt), 864 | (const char **)&(stmtw->tail)); 865 | if (rc != SQLITE_OK || !stmtw->stmt) { 866 | caml_stat_free(stmtw->sql); 867 | caml_stat_free(stmtw); 868 | if (rc != SQLITE_OK) 869 | raise_sqlite3_current(dbw->db, loc); 870 | raise_sqlite3_Error("No code compiled from %s", sql); 871 | } 872 | atomic_fetch_add(&dbw->ref_count, 1); 873 | #if SQLITE_STMTSTATUS_MEMUSED 874 | size_t mem = sizeof(stmt_wrap) + sql_len + 1 + 875 | sqlite3_stmt_status(stmtw->stmt, SQLITE_STMTSTATUS_MEMUSED, 0); 876 | value v_stmt = 877 | caml_alloc_custom_mem(&stmt_wrap_ops, sizeof(stmt_wrap *), mem); 878 | #else 879 | value v_stmt = 880 | caml_alloc_custom(&stmt_wrap_ops, sizeof(stmt_wrap *), 1, 1000); 881 | #endif 882 | Sqlite3_stmtw_val(v_stmt) = stmtw; 883 | return v_stmt; 884 | } 885 | 886 | CAMLprim value caml_sqlite3_stmt_finalize(value v_stmt) { 887 | stmt_wrap *stmtw = safe_get_stmtw("finalize", v_stmt); 888 | int rc = sqlite3_finalize(stmtw->stmt); 889 | stmtw->stmt = NULL; 890 | return Val_rc(rc); 891 | } 892 | 893 | CAMLprim value caml_sqlite3_stmt_reset(value v_stmt) { 894 | sqlite3_stmt *stmt = safe_get_stmtw("reset", v_stmt)->stmt; 895 | return Val_rc(sqlite3_reset(stmt)); 896 | } 897 | 898 | CAMLprim value caml_sqlite3_prepare(value v_db, value v_sql) { 899 | CAMLparam1(v_db); 900 | const char *loc = "prepare", *sql = String_val(v_sql); 901 | db_wrap *dbw = Sqlite3_val(v_db); 902 | check_db(dbw, loc); 903 | CAMLreturn(prepare_it(dbw, sql, caml_string_length(v_sql), loc)); 904 | } 905 | 906 | CAMLprim value caml_sqlite3_prepare_tail(value v_stmt) { 907 | CAMLparam1(v_stmt); 908 | char *loc = "prepare_tail"; 909 | stmt_wrap *stmtw = Sqlite3_stmtw_val(v_stmt); 910 | if (stmtw->sql && stmtw->tail && *(stmtw->tail)) { 911 | db_wrap *dbw = stmtw->db_wrap; 912 | int tail_len = stmtw->sql_len - (stmtw->tail - stmtw->sql); 913 | CAMLreturn(caml_alloc_some(prepare_it(dbw, stmtw->tail, tail_len, loc))); 914 | } else 915 | CAMLreturn(Val_none); 916 | } 917 | 918 | CAMLprim value caml_sqlite3_recompile(value v_stmt) { 919 | CAMLparam1(v_stmt); 920 | stmt_wrap *stmtw = Sqlite3_stmtw_val(v_stmt); 921 | sqlite3_stmt *stmt = stmtw->stmt; 922 | int rc; 923 | if (stmt) { 924 | sqlite3_finalize(stmt); 925 | stmtw->stmt = NULL; 926 | } 927 | rc = my_sqlite3_prepare(stmtw->db_wrap->db, stmtw->sql, stmtw->sql_len, 928 | &(stmtw->stmt), (const char **)&(stmtw->tail)); 929 | if (rc != SQLITE_OK) 930 | raise_sqlite3_current(stmtw->db_wrap->db, "recompile"); 931 | else if (!stmtw->stmt) 932 | raise_sqlite3_Error("No code recompiled from %s", stmtw->sql); 933 | CAMLreturn(Val_unit); 934 | } 935 | 936 | /* bind_parameter_count */ 937 | 938 | CAMLprim intnat caml_sqlite3_bind_parameter_count(value v_stmt) { 939 | sqlite3_stmt *stmt = safe_get_stmtw("bind_parameter_count", v_stmt)->stmt; 940 | return sqlite3_bind_parameter_count(stmt); 941 | } 942 | 943 | CAMLprim value caml_sqlite3_bind_parameter_count_bc(value v_stmt) { 944 | return Val_int(caml_sqlite3_bind_parameter_count(v_stmt)); 945 | } 946 | 947 | /* bind_parameter_name */ 948 | 949 | CAMLprim value caml_sqlite3_bind_parameter_name(value v_stmt, intnat pos) { 950 | CAMLparam1(v_stmt); 951 | sqlite3_stmt *stmt = safe_get_stmtw("bind_parameter_name", v_stmt)->stmt; 952 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 953 | CAMLreturn(Val_string_option(sqlite3_bind_parameter_name(stmt, pos))); 954 | } 955 | 956 | CAMLprim value caml_sqlite3_bind_parameter_name_bc(value v_stmt, value v_pos) { 957 | return caml_sqlite3_bind_parameter_name(v_stmt, Int_val(v_pos)); 958 | } 959 | 960 | /* bind_parameter_index */ 961 | 962 | CAMLprim intnat caml_sqlite3_bind_parameter_index(value v_stmt, value v_name) { 963 | sqlite3_stmt *stmt = safe_get_stmtw("bind_parameter_index", v_stmt)->stmt; 964 | const char *parm_name = String_val(v_name); 965 | int index = sqlite3_bind_parameter_index(stmt, parm_name); 966 | if (!index) 967 | caml_raise_not_found(); 968 | return index; 969 | } 970 | 971 | CAMLprim value caml_sqlite3_bind_parameter_index_bc(value v_stmt, 972 | value v_name) { 973 | return Val_int(caml_sqlite3_bind_parameter_index(v_stmt, v_name)); 974 | } 975 | 976 | /* bind_blob */ 977 | 978 | CAMLprim value caml_sqlite3_bind_blob(value v_stmt, intnat pos, value v_str) { 979 | sqlite3_stmt *stmt = safe_get_stmtw("bind_blob", v_stmt)->stmt; 980 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 981 | return Val_rc(sqlite3_bind_blob(stmt, pos, String_val(v_str), 982 | caml_string_length(v_str), SQLITE_TRANSIENT)); 983 | } 984 | 985 | CAMLprim value caml_sqlite3_bind_blob_bc(value v_stmt, value v_pos, 986 | value v_str) { 987 | return caml_sqlite3_bind_blob(v_stmt, Int_val(v_pos), v_str); 988 | } 989 | 990 | /* bind_double */ 991 | 992 | CAMLprim value caml_sqlite3_bind_double(value v_stmt, intnat pos, double n) { 993 | sqlite3_stmt *stmt = safe_get_stmtw("bind_double", v_stmt)->stmt; 994 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 995 | return Val_rc(sqlite3_bind_double(stmt, pos, n)); 996 | } 997 | 998 | CAMLprim value caml_sqlite3_bind_double_bc(value v_stmt, value v_pos, 999 | value v_n) { 1000 | return caml_sqlite3_bind_double(v_stmt, Int_val(v_pos), Double_val(v_n)); 1001 | } 1002 | 1003 | /* bind_int32 */ 1004 | 1005 | CAMLprim value caml_sqlite3_bind_int32(value v_stmt, intnat pos, int32_t n) { 1006 | sqlite3_stmt *stmt = safe_get_stmtw("bind_int32", v_stmt)->stmt; 1007 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 1008 | return Val_rc(sqlite3_bind_int(stmt, pos, n)); 1009 | } 1010 | 1011 | CAMLprim value caml_sqlite3_bind_int32_bc(value v_stmt, value v_pos, 1012 | value v_n) { 1013 | return caml_sqlite3_bind_int32(v_stmt, Int_val(v_pos), Int32_val(v_n)); 1014 | } 1015 | 1016 | /* bind_int64 */ 1017 | 1018 | CAMLprim value caml_sqlite3_bind_int64(value v_stmt, intnat pos, int64_t n) { 1019 | sqlite3_stmt *stmt = safe_get_stmtw("bind_int64", v_stmt)->stmt; 1020 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 1021 | return Val_rc(sqlite3_bind_int64(stmt, pos, n)); 1022 | } 1023 | 1024 | CAMLprim value caml_sqlite3_bind_int64_bc(value v_stmt, value v_pos, 1025 | value v_n) { 1026 | return caml_sqlite3_bind_int64(v_stmt, Int_val(v_pos), Int64_val(v_n)); 1027 | } 1028 | 1029 | /* bind_text */ 1030 | 1031 | CAMLprim value caml_sqlite3_bind_text(value v_stmt, intnat pos, value v_str) { 1032 | sqlite3_stmt *stmt = safe_get_stmtw("bind_text", v_stmt)->stmt; 1033 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 1034 | return Val_rc(sqlite3_bind_text(stmt, pos, String_val(v_str), 1035 | caml_string_length(v_str), SQLITE_TRANSIENT)); 1036 | } 1037 | 1038 | CAMLprim value caml_sqlite3_bind_text_bc(value v_stmt, value v_pos, 1039 | value v_str) { 1040 | return caml_sqlite3_bind_text(v_stmt, Int_val(v_pos), v_str); 1041 | } 1042 | 1043 | /* bind */ 1044 | 1045 | CAMLprim value caml_sqlite3_bind(value v_stmt, intnat pos, value v_data) { 1046 | sqlite3_stmt *stmt = safe_get_stmtw("bind", v_stmt)->stmt; 1047 | range_check(pos - 1, sqlite3_bind_parameter_count(stmt)); 1048 | if (Is_long(v_data)) { 1049 | switch (Int_val(v_data)) { 1050 | case 1: 1051 | return Val_rc(sqlite3_bind_null(stmt, pos)); 1052 | default: 1053 | return Val_rc(SQLITE_ERROR); 1054 | } 1055 | } else { 1056 | value v_field = Field(v_data, 0); 1057 | switch (Tag_val(v_data)) { 1058 | case 0: 1059 | return Val_rc(sqlite3_bind_int64(stmt, pos, Int64_val(v_field))); 1060 | case 1: 1061 | return Val_rc(sqlite3_bind_double(stmt, pos, Double_val(v_field))); 1062 | case 2: 1063 | return Val_rc(sqlite3_bind_text(stmt, pos, String_val(v_field), 1064 | caml_string_length(v_field), 1065 | SQLITE_TRANSIENT)); 1066 | case 3: 1067 | return Val_rc(sqlite3_bind_blob(stmt, pos, String_val(v_field), 1068 | caml_string_length(v_field), 1069 | SQLITE_TRANSIENT)); 1070 | } 1071 | } 1072 | return Val_rc(SQLITE_ERROR); 1073 | } 1074 | 1075 | CAMLprim value caml_sqlite3_bind_bc(value v_stmt, value v_pos, value v_data) { 1076 | return caml_sqlite3_bind(v_stmt, Int_val(v_pos), v_data); 1077 | } 1078 | 1079 | /* clear_bindings */ 1080 | 1081 | CAMLprim value caml_sqlite3_clear_bindings(value v_stmt) { 1082 | sqlite3_stmt *stmt = safe_get_stmtw("clear_bindings", v_stmt)->stmt; 1083 | return Val_rc(sqlite3_clear_bindings(stmt)); 1084 | } 1085 | 1086 | CAMLprim value caml_sqlite3_column_name(value v_stmt, intnat pos) { 1087 | CAMLparam1(v_stmt); 1088 | sqlite3_stmt *stmt = safe_get_stmtw("column_name", v_stmt)->stmt; 1089 | range_check(pos, sqlite3_column_count(stmt)); 1090 | CAMLreturn(caml_copy_string(sqlite3_column_name(stmt, pos))); 1091 | } 1092 | 1093 | CAMLprim value caml_sqlite3_column_name_bc(value v_stmt, value v_pos) { 1094 | return caml_sqlite3_column_name(v_stmt, Int_val(v_pos)); 1095 | } 1096 | 1097 | CAMLprim value caml_sqlite3_column_decltype(value v_stmt, intnat pos) { 1098 | CAMLparam1(v_stmt); 1099 | sqlite3_stmt *stmt = safe_get_stmtw("column_decltype", v_stmt)->stmt; 1100 | range_check(pos, sqlite3_column_count(stmt)); 1101 | CAMLreturn(Val_string_option(sqlite3_column_decltype(stmt, pos))); 1102 | } 1103 | 1104 | CAMLprim value caml_sqlite3_column_decltype_bc(value v_stmt, value v_pos) { 1105 | return caml_sqlite3_column_decltype(v_stmt, Int_val(v_pos)); 1106 | } 1107 | 1108 | CAMLprim value caml_sqlite3_step(value v_stmt) { 1109 | CAMLparam1(v_stmt); 1110 | sqlite3_stmt *stmt = safe_get_stmtw("step", v_stmt)->stmt; 1111 | int rc; 1112 | caml_enter_blocking_section(); 1113 | rc = sqlite3_step(stmt); 1114 | caml_leave_blocking_section(); 1115 | CAMLreturn(Val_rc(rc)); 1116 | } 1117 | 1118 | /* data_count */ 1119 | 1120 | CAMLprim intnat caml_sqlite3_data_count(value v_stmt) { 1121 | sqlite3_stmt *stmt = safe_get_stmtw("data_count", v_stmt)->stmt; 1122 | return sqlite3_data_count(stmt); 1123 | } 1124 | 1125 | CAMLprim value caml_sqlite3_data_count_bc(value v_stmt) { 1126 | return Val_int(caml_sqlite3_data_count(v_stmt)); 1127 | } 1128 | 1129 | /* column_count */ 1130 | 1131 | CAMLprim intnat caml_sqlite3_column_count(value v_stmt) { 1132 | sqlite3_stmt *stmt = safe_get_stmtw("column_count", v_stmt)->stmt; 1133 | return sqlite3_column_count(stmt); 1134 | } 1135 | 1136 | CAMLprim value caml_sqlite3_column_count_bc(value v_stmt) { 1137 | return Val_int(caml_sqlite3_column_count(v_stmt)); 1138 | } 1139 | 1140 | /* column_blob */ 1141 | 1142 | CAMLprim value caml_sqlite3_column_blob(value v_stmt, intnat pos) { 1143 | CAMLparam1(v_stmt); 1144 | int len; 1145 | value v_str; 1146 | sqlite3_stmt *stmt = safe_get_stmtw("column_blob", v_stmt)->stmt; 1147 | range_check(pos, sqlite3_column_count(stmt)); 1148 | len = sqlite3_column_bytes(stmt, pos); 1149 | v_str = caml_alloc_initialized_string(len, sqlite3_column_blob(stmt, pos)); 1150 | CAMLreturn(v_str); 1151 | } 1152 | 1153 | CAMLprim value caml_sqlite3_column_blob_bc(value v_stmt, value v_pos) { 1154 | return caml_sqlite3_column_blob(v_stmt, Int_val(v_pos)); 1155 | } 1156 | 1157 | /* column_double */ 1158 | 1159 | CAMLprim double caml_sqlite3_column_double(value v_stmt, intnat pos) { 1160 | sqlite3_stmt *stmt = safe_get_stmtw("column_double", v_stmt)->stmt; 1161 | range_check(pos, sqlite3_column_count(stmt)); 1162 | return sqlite3_column_double(stmt, pos); 1163 | } 1164 | 1165 | CAMLprim value caml_sqlite3_column_double_bc(value v_stmt, value v_pos) { 1166 | return caml_copy_double(caml_sqlite3_column_double(v_stmt, Int_val(v_pos))); 1167 | } 1168 | 1169 | /* column_int32 */ 1170 | 1171 | CAMLprim int32_t caml_sqlite3_column_int32(value v_stmt, intnat pos) { 1172 | sqlite3_stmt *stmt = safe_get_stmtw("column_int32", v_stmt)->stmt; 1173 | range_check(pos, sqlite3_column_count(stmt)); 1174 | return sqlite3_column_int(stmt, pos); 1175 | } 1176 | 1177 | CAMLprim value caml_sqlite3_column_int32_bc(value v_stmt, value v_pos) { 1178 | return caml_copy_int32(caml_sqlite3_column_int32(v_stmt, Int_val(v_pos))); 1179 | } 1180 | 1181 | /* column_int64 */ 1182 | 1183 | CAMLprim int64_t caml_sqlite3_column_int64(value v_stmt, intnat pos) { 1184 | sqlite3_stmt *stmt = safe_get_stmtw("column_int64", v_stmt)->stmt; 1185 | range_check(pos, sqlite3_column_count(stmt)); 1186 | return sqlite3_column_int64(stmt, pos); 1187 | } 1188 | 1189 | CAMLprim value caml_sqlite3_column_int64_bc(value v_stmt, value v_pos) { 1190 | return caml_copy_int64(caml_sqlite3_column_int64(v_stmt, Int_val(v_pos))); 1191 | } 1192 | 1193 | /* column_text */ 1194 | 1195 | CAMLprim value caml_sqlite3_column_text(value v_stmt, intnat pos) { 1196 | CAMLparam1(v_stmt); 1197 | int len; 1198 | value v_str; 1199 | sqlite3_stmt *stmt = safe_get_stmtw("column_text", v_stmt)->stmt; 1200 | range_check(pos, sqlite3_column_count(stmt)); 1201 | len = sqlite3_column_bytes(stmt, pos); 1202 | v_str = caml_alloc_initialized_string(len, 1203 | (char *)sqlite3_column_text(stmt, pos)); 1204 | CAMLreturn(v_str); 1205 | } 1206 | 1207 | CAMLprim value caml_sqlite3_column_text_bc(value v_stmt, value v_pos) { 1208 | return caml_sqlite3_column_text(v_stmt, Int_val(v_pos)); 1209 | } 1210 | 1211 | /* column */ 1212 | 1213 | CAMLprim value caml_sqlite3_column(value v_stmt, intnat pos) { 1214 | CAMLparam1(v_stmt); 1215 | CAMLlocal1(v_tmp); 1216 | value v_res; 1217 | sqlite3_stmt *stmt = safe_get_stmtw("column", v_stmt)->stmt; 1218 | int len; 1219 | range_check(pos, sqlite3_column_count(stmt)); 1220 | switch (sqlite3_column_type(stmt, pos)) { 1221 | case SQLITE_INTEGER: 1222 | v_tmp = caml_copy_int64(sqlite3_column_int64(stmt, pos)); 1223 | v_res = caml_alloc_small(1, 0); 1224 | Field(v_res, 0) = v_tmp; 1225 | break; 1226 | case SQLITE_FLOAT: 1227 | v_tmp = caml_copy_double(sqlite3_column_double(stmt, pos)); 1228 | v_res = caml_alloc_small(1, 1); 1229 | Field(v_res, 0) = v_tmp; 1230 | break; 1231 | case SQLITE3_TEXT: 1232 | len = sqlite3_column_bytes(stmt, pos); 1233 | v_tmp = caml_alloc_initialized_string( 1234 | len, (char *)sqlite3_column_text(stmt, pos)); 1235 | v_res = caml_alloc_small(1, 2); 1236 | Field(v_res, 0) = v_tmp; 1237 | break; 1238 | case SQLITE_BLOB: 1239 | len = sqlite3_column_bytes(stmt, pos); 1240 | v_tmp = caml_alloc_initialized_string(len, sqlite3_column_blob(stmt, pos)); 1241 | v_res = caml_alloc_small(1, 3); 1242 | Field(v_res, 0) = v_tmp; 1243 | break; 1244 | case SQLITE_NULL: 1245 | v_res = Val_int(1); 1246 | break; 1247 | default: 1248 | v_res = Val_int(0); 1249 | } 1250 | CAMLreturn(v_res); 1251 | } 1252 | 1253 | CAMLprim value caml_sqlite3_column_bc(value v_stmt, value v_pos) { 1254 | return caml_sqlite3_column(v_stmt, Int_val(v_pos)); 1255 | } 1256 | 1257 | CAMLprim intnat caml_sqlite3_sleep(intnat duration) { 1258 | intnat res; 1259 | caml_enter_blocking_section(); 1260 | res = sqlite3_sleep(duration); 1261 | caml_leave_blocking_section(); 1262 | return res; 1263 | } 1264 | 1265 | CAMLprim value caml_sqlite3_sleep_bc(value v_duration) { 1266 | return Val_int(caml_sqlite3_sleep(Int_val(v_duration))); 1267 | } 1268 | 1269 | /* User-defined functions */ 1270 | 1271 | static inline value caml_sqlite3_wrap_values(int argc, sqlite3_value **args) { 1272 | if (argc <= 0 || args == NULL) 1273 | return Atom(0); 1274 | else { 1275 | int i, len; 1276 | CAMLparam0(); 1277 | CAMLlocal2(v_arr, v_tmp); 1278 | value v_res; 1279 | v_arr = caml_alloc(argc, 0); 1280 | for (i = 0; i < argc; ++i) { 1281 | sqlite3_value *arg = args[i]; 1282 | switch (sqlite3_value_type(arg)) { 1283 | case SQLITE_INTEGER: 1284 | v_tmp = caml_copy_int64(sqlite3_value_int64(arg)); 1285 | v_res = caml_alloc_small(1, 0); 1286 | Field(v_res, 0) = v_tmp; 1287 | break; 1288 | case SQLITE_FLOAT: 1289 | v_tmp = caml_copy_double(sqlite3_value_double(arg)); 1290 | v_res = caml_alloc_small(1, 1); 1291 | Field(v_res, 0) = v_tmp; 1292 | break; 1293 | case SQLITE3_TEXT: 1294 | len = sqlite3_value_bytes(arg); 1295 | v_tmp = 1296 | caml_alloc_initialized_string(len, (char *)sqlite3_value_text(arg)); 1297 | v_res = caml_alloc_small(1, 2); 1298 | Field(v_res, 0) = v_tmp; 1299 | break; 1300 | case SQLITE_BLOB: 1301 | len = sqlite3_value_bytes(arg); 1302 | v_tmp = caml_alloc_initialized_string(len, sqlite3_value_blob(arg)); 1303 | v_res = caml_alloc_small(1, 3); 1304 | Field(v_res, 0) = v_tmp; 1305 | break; 1306 | case SQLITE_NULL: 1307 | v_res = Val_int(1); 1308 | break; 1309 | default: 1310 | v_res = Val_none; 1311 | } 1312 | Store_field(v_arr, i, v_res); 1313 | } 1314 | CAMLreturn(v_arr); 1315 | } 1316 | } 1317 | 1318 | static inline void exception_result(sqlite3_context *ctx, value v_res) { 1319 | value v_exn = Extract_exception(v_res); 1320 | create_user_exception(v_exn); 1321 | sqlite3_result_error(ctx, "OCaml callback raised an exception", -1); 1322 | } 1323 | 1324 | static inline void set_sqlite3_result(sqlite3_context *ctx, value v_res) { 1325 | if (Is_exception_result(v_res)) 1326 | exception_result(ctx, v_res); 1327 | else if (Is_long(v_res)) 1328 | sqlite3_result_null(ctx); 1329 | else { 1330 | value v = Field(v_res, 0); 1331 | switch (Tag_val(v_res)) { 1332 | case 0: 1333 | sqlite3_result_int64(ctx, Int64_val(v)); 1334 | break; 1335 | case 1: 1336 | sqlite3_result_double(ctx, Double_val(v)); 1337 | break; 1338 | case 2: 1339 | sqlite3_result_text(ctx, String_val(v), caml_string_length(v), 1340 | SQLITE_TRANSIENT); 1341 | break; 1342 | case 3: 1343 | sqlite3_result_blob(ctx, String_val(v), caml_string_length(v), 1344 | SQLITE_TRANSIENT); 1345 | break; 1346 | default: 1347 | sqlite3_result_error(ctx, "unknown value returned by callback", -1); 1348 | } 1349 | } 1350 | } 1351 | 1352 | static void caml_sqlite3_user_function(sqlite3_context *ctx, int argc, 1353 | sqlite3_value **argv) { 1354 | user_function *data = sqlite3_user_data(ctx); 1355 | value v_args, v_res; 1356 | caml_leave_blocking_section(); 1357 | v_args = caml_sqlite3_wrap_values(argc, argv); 1358 | v_res = caml_callback_exn(Field(data->v_fun, 1), v_args); 1359 | set_sqlite3_result(ctx, v_res); 1360 | caml_enter_blocking_section(); 1361 | } 1362 | 1363 | typedef struct agg_ctx { 1364 | int initialized; 1365 | value v_acc; 1366 | } agg_ctx; 1367 | 1368 | #define MK_USER_FUNCTION_STEP_INVERSE(NAME, GET_FUN) \ 1369 | static void caml_sqlite3_user_function_##NAME( \ 1370 | sqlite3_context *ctx, int argc, sqlite3_value **argv) { \ 1371 | value v_args, v_res; \ 1372 | user_function *data = sqlite3_user_data(ctx); \ 1373 | agg_ctx *actx = sqlite3_aggregate_context(ctx, sizeof(agg_ctx)); \ 1374 | caml_leave_blocking_section(); \ 1375 | if (!actx->initialized) { \ 1376 | actx->v_acc = Field(data->v_fun, 1); \ 1377 | /* Not a generational global root, because it is hard to imagine \ 1378 | that there will ever be more than at most a few instances \ 1379 | (quite probably only one in most cases). */ \ 1380 | caml_register_global_root(&actx->v_acc); \ 1381 | actx->initialized = 1; \ 1382 | } \ 1383 | v_args = caml_sqlite3_wrap_values(argc, argv); \ 1384 | v_res = caml_callback2_exn(GET_FUN, actx->v_acc, v_args); \ 1385 | if (Is_exception_result(v_res)) \ 1386 | exception_result(ctx, v_res); \ 1387 | else \ 1388 | actx->v_acc = v_res; \ 1389 | caml_enter_blocking_section(); \ 1390 | } 1391 | 1392 | #define MK_USER_FUNCTION_VALUE_FINAL(NAME, GET_FUN, REMOVE_ROOT) \ 1393 | static void caml_sqlite3_user_function_##NAME(sqlite3_context *ctx) { \ 1394 | user_function *data = sqlite3_user_data(ctx); \ 1395 | agg_ctx *actx = sqlite3_aggregate_context(ctx, sizeof(agg_ctx)); \ 1396 | value v_res; \ 1397 | caml_leave_blocking_section(); \ 1398 | if (!actx->initialized) { \ 1399 | v_res = caml_callback_exn(GET_FUN, Field(data->v_fun, 1)); \ 1400 | set_sqlite3_result(ctx, v_res); \ 1401 | } else { \ 1402 | v_res = caml_callback_exn(GET_FUN, actx->v_acc); \ 1403 | set_sqlite3_result(ctx, v_res); \ 1404 | REMOVE_ROOT; \ 1405 | } \ 1406 | caml_enter_blocking_section(); \ 1407 | } 1408 | 1409 | MK_USER_FUNCTION_STEP_INVERSE(step, Field(data->v_fun, 2)) 1410 | 1411 | #if SQLITE_VERSION_NUMBER >= 3025000 1412 | MK_USER_FUNCTION_STEP_INVERSE(inverse, Field(Field(data->v_fun, 3), 0)) 1413 | MK_USER_FUNCTION_VALUE_FINAL(value, Field(Field(data->v_fun, 4), 0), ) 1414 | #endif 1415 | 1416 | MK_USER_FUNCTION_VALUE_FINAL(final, Field(data->v_fun, 5), 1417 | caml_remove_global_root(&actx->v_acc)) 1418 | 1419 | static inline void unregister_user_function(db_wrap *db_data, value v_name) { 1420 | user_function *prev = NULL, *link = db_data->user_functions; 1421 | const char *name = String_val(v_name); 1422 | 1423 | while (link != NULL) { 1424 | if (strcmp(String_val(Field(link->v_fun, 0)), name) == 0) { 1425 | if (prev == NULL) 1426 | db_data->user_functions = link->next; 1427 | else 1428 | prev->next = link->next; 1429 | caml_remove_generational_global_root(&link->v_fun); 1430 | caml_stat_free(link); 1431 | break; 1432 | } 1433 | prev = link; 1434 | link = link->next; 1435 | } 1436 | } 1437 | 1438 | static inline user_function *register_user_function(db_wrap *db_data, 1439 | value v_cell) { 1440 | /* Assume parameters are already protected */ 1441 | user_function *link = caml_stat_alloc(sizeof *link); 1442 | link->v_fun = v_cell; 1443 | link->next = db_data->user_functions; 1444 | caml_register_generational_global_root(&link->v_fun); 1445 | db_data->user_functions = link; 1446 | return link; 1447 | } 1448 | 1449 | static inline user_function * 1450 | register_scalar_user_function(db_wrap *db_data, value v_name, value v_fun) { 1451 | /* Assume parameters are already protected */ 1452 | value v_cell = caml_alloc_small(2, 0); 1453 | Field(v_cell, 0) = v_name; 1454 | Field(v_cell, 1) = v_fun; 1455 | return register_user_function(db_data, v_cell); 1456 | } 1457 | 1458 | static inline user_function * 1459 | register_aggregate_user_function(db_wrap *db_data, value v_name, value v_init, 1460 | value v_step, value v_inverse, value v_value, 1461 | value v_final) { 1462 | /* Assume parameters are already protected */ 1463 | value v_cell = caml_alloc_small(6, 0); 1464 | Field(v_cell, 0) = v_name; 1465 | Field(v_cell, 1) = v_init; 1466 | Field(v_cell, 2) = v_step; 1467 | Field(v_cell, 3) = v_inverse; 1468 | Field(v_cell, 4) = v_value; 1469 | Field(v_cell, 5) = v_final; 1470 | return register_user_function(db_data, v_cell); 1471 | } 1472 | 1473 | CAMLprim value caml_sqlite3_create_function(value v_db, value v_name, 1474 | intnat n_args, value v_fun) { 1475 | CAMLparam3(v_db, v_name, v_fun); 1476 | user_function *param; 1477 | int rc; 1478 | db_wrap *dbw = Sqlite3_val(v_db); 1479 | check_db(dbw, "create_function"); 1480 | param = register_scalar_user_function(dbw, v_name, v_fun); 1481 | rc = sqlite3_create_function(dbw->db, String_val(v_name), n_args, SQLITE_UTF8, 1482 | param, caml_sqlite3_user_function, NULL, NULL); 1483 | if (rc != SQLITE_OK) { 1484 | unregister_user_function(dbw, v_name); 1485 | raise_sqlite3_current(dbw->db, "create_function"); 1486 | } 1487 | CAMLreturn(Val_unit); 1488 | } 1489 | 1490 | CAMLprim value caml_sqlite3_create_function_bc(value v_db, value v_name, 1491 | value v_n_args, value v_fun) { 1492 | return caml_sqlite3_create_function(v_db, v_name, Int_val(v_n_args), v_fun); 1493 | } 1494 | 1495 | CAMLprim value caml_sqlite3_create_aggregate_function( 1496 | value v_db, value v_name, intnat n_args, value v_init, value v_stepfn, 1497 | value v_inversefn, value v_valuefn, value v_finalfn) { 1498 | CAMLparam5(v_db, v_name, v_init, v_stepfn, v_inversefn); 1499 | CAMLxparam2(v_valuefn, v_finalfn); 1500 | user_function *param; 1501 | int rc; 1502 | db_wrap *dbw = Sqlite3_val(v_db); 1503 | check_db(dbw, "create_aggregate_function"); 1504 | param = register_aggregate_user_function(dbw, v_name, v_init, v_stepfn, 1505 | v_inversefn, v_valuefn, v_finalfn); 1506 | #if SQLITE_VERSION_NUMBER >= 3025000 1507 | rc = sqlite3_create_window_function( 1508 | dbw->db, String_val(v_name), n_args, SQLITE_UTF8, param, 1509 | caml_sqlite3_user_function_step, caml_sqlite3_user_function_final, 1510 | Is_none(v_valuefn) ? NULL : caml_sqlite3_user_function_value, 1511 | Is_none(v_inversefn) ? NULL : caml_sqlite3_user_function_inverse, NULL); 1512 | #else 1513 | rc = sqlite3_create_function(dbw->db, String_val(v_name), n_args, SQLITE_UTF8, 1514 | param, NULL, caml_sqlite3_user_function_step, 1515 | caml_sqlite3_user_function_final); 1516 | #endif 1517 | if (rc != SQLITE_OK) { 1518 | unregister_user_function(dbw, v_name); 1519 | raise_sqlite3_current(dbw->db, "create_aggregate_function"); 1520 | } 1521 | CAMLreturn(Val_unit); 1522 | } 1523 | 1524 | CAMLprim value caml_sqlite3_create_aggregate_function_bc(value *argv, 1525 | int __unused argn) { 1526 | return caml_sqlite3_create_aggregate_function( 1527 | argv[0], argv[1], Int_val(argv[2]), argv[3], argv[4], argv[5], argv[6], 1528 | argv[7]); 1529 | } 1530 | 1531 | CAMLprim value caml_sqlite3_delete_function(value v_db, value v_name) { 1532 | int rc; 1533 | db_wrap *dbw = Sqlite3_val(v_db); 1534 | check_db(dbw, "delete_function"); 1535 | rc = sqlite3_create_function(dbw->db, String_val(v_name), 0, SQLITE_UTF8, 1536 | NULL, NULL, NULL, NULL); 1537 | if (rc != SQLITE_OK) 1538 | raise_sqlite3_current(dbw->db, "delete_function"); 1539 | unregister_user_function(dbw, v_name); 1540 | return Val_unit; 1541 | } 1542 | 1543 | /* User defined collations */ 1544 | 1545 | static inline void unregister_user_collation(db_wrap *db_data, value v_name) { 1546 | user_collation *prev = NULL, *link = db_data->user_collations; 1547 | const char *name = String_val(v_name); 1548 | 1549 | while (link != NULL) { 1550 | if (strcmp(String_val(Field(link->v_fun, 0)), name) == 0) { 1551 | if (prev == NULL) 1552 | db_data->user_collations = link->next; 1553 | else 1554 | prev->next = link->next; 1555 | caml_remove_generational_global_root(&link->v_fun); 1556 | caml_stat_free(link); 1557 | break; 1558 | } 1559 | prev = link; 1560 | link = link->next; 1561 | } 1562 | } 1563 | 1564 | static inline user_collation * 1565 | register_user_collation(db_wrap *db_data, value v_name, value v_fun) { 1566 | user_collation *link; 1567 | value v_cell = caml_alloc_small(2, 0); 1568 | Field(v_cell, 0) = v_name; 1569 | Field(v_cell, 1) = v_fun; 1570 | 1571 | /* Assume parameters are already protected */ 1572 | link = caml_stat_alloc(sizeof *link); 1573 | link->v_fun = v_cell; 1574 | link->next = db_data->user_collations; 1575 | caml_register_generational_global_root(&link->v_fun); 1576 | db_data->user_collations = link; 1577 | return link; 1578 | } 1579 | 1580 | int caml_sqlite3_user_collation(void *ctx, int nLeft, const void *zLeft, 1581 | int nRight, const void *zRight) { 1582 | user_collation *data = ctx; 1583 | value v_res, v_left, v_right; 1584 | int v_return; 1585 | caml_leave_blocking_section(); 1586 | v_left = caml_alloc_initialized_string(nLeft, zLeft); 1587 | v_right = caml_alloc_initialized_string(nRight, zRight); 1588 | v_res = caml_callback2_exn(Field(data->v_fun, 1), v_left, v_right); 1589 | v_return = Int_val(v_res); 1590 | caml_enter_blocking_section(); 1591 | return v_return; 1592 | } 1593 | 1594 | CAMLprim value caml_sqlite3_create_collation(value v_db, value v_name, 1595 | value v_fun) { 1596 | CAMLparam3(v_db, v_name, v_fun); 1597 | user_collation *param; 1598 | int rc; 1599 | db_wrap *dbw = Sqlite3_val(v_db); 1600 | check_db(dbw, "create_collation"); 1601 | param = register_user_collation(dbw, v_name, v_fun); 1602 | rc = sqlite3_create_collation(dbw->db, String_val(v_name), SQLITE_UTF8, param, 1603 | caml_sqlite3_user_collation); 1604 | if (rc != SQLITE_OK) { 1605 | unregister_user_collation(dbw, v_name); 1606 | raise_sqlite3_current(dbw->db, "create_collation"); 1607 | } 1608 | CAMLreturn(Val_unit); 1609 | } 1610 | 1611 | CAMLprim value caml_sqlite3_delete_collation(value v_db, value v_name) { 1612 | int rc; 1613 | db_wrap *dbw = Sqlite3_val(v_db); 1614 | check_db(dbw, "delete_collation"); 1615 | rc = sqlite3_create_collation(dbw->db, String_val(v_name), SQLITE_UTF8, NULL, 1616 | NULL); 1617 | if (rc != SQLITE_OK) 1618 | raise_sqlite3_current(dbw->db, "delete_collation"); 1619 | unregister_user_collation(dbw, v_name); 1620 | return Val_unit; 1621 | } 1622 | 1623 | CAMLprim value caml_sqlite3_busy_timeout(value v_db, intnat ms) { 1624 | int rc; 1625 | db_wrap *dbw = Sqlite3_val(v_db); 1626 | check_db(dbw, "busy_timeout"); 1627 | rc = sqlite3_busy_timeout(dbw->db, ms); 1628 | if (rc != SQLITE_OK) 1629 | raise_sqlite3_current(dbw->db, "busy_timeout"); 1630 | return Val_unit; 1631 | } 1632 | 1633 | CAMLprim value caml_sqlite3_busy_timeout_bc(value v_db, value v_ms) { 1634 | return caml_sqlite3_busy_timeout(v_db, Int_val(v_ms)); 1635 | } 1636 | 1637 | CAMLprim intnat caml_sqlite3_changes(value v_db) { 1638 | db_wrap *dbw = Sqlite3_val(v_db); 1639 | check_db(dbw, "changes"); 1640 | return sqlite3_changes(dbw->db); 1641 | } 1642 | 1643 | CAMLprim value caml_sqlite3_changes_bc(value v_db) { 1644 | return Val_int(caml_sqlite3_changes(v_db)); 1645 | } 1646 | 1647 | /* Backup functionality */ 1648 | 1649 | #define Sqlite3_backup_val(x) (*((sqlite3_backup **)Data_abstract_val(x))) 1650 | 1651 | CAMLprim value caml_sqlite3_backup_init(value v_dst, value v_dst_name, 1652 | value v_src, value v_src_name) { 1653 | CAMLparam4(v_dst, v_dst_name, v_src, v_src_name); 1654 | CAMLlocal1(v_res); 1655 | sqlite3_backup *res; 1656 | int dst_len, src_len; 1657 | char *dst_name, *src_name; 1658 | 1659 | db_wrap *dst = Sqlite3_val(v_dst); 1660 | db_wrap *src = Sqlite3_val(v_src); 1661 | 1662 | dst_len = caml_string_length(v_dst_name) + 1; 1663 | dst_name = caml_stat_alloc(dst_len); 1664 | memcpy(dst_name, String_val(v_dst_name), dst_len); 1665 | 1666 | src_len = caml_string_length(v_src_name) + 1; 1667 | src_name = caml_stat_alloc(src_len); 1668 | memcpy(src_name, String_val(v_src_name), src_len); 1669 | 1670 | caml_enter_blocking_section(); 1671 | 1672 | res = sqlite3_backup_init(dst->db, dst_name, src->db, src_name); 1673 | caml_stat_free(dst_name); 1674 | caml_stat_free(src_name); 1675 | 1676 | caml_leave_blocking_section(); 1677 | 1678 | if (NULL == res) 1679 | raise_sqlite3_current(dst->db, "backup_init"); 1680 | 1681 | v_res = caml_alloc(1, Abstract_tag); 1682 | Sqlite3_backup_val(v_res) = res; 1683 | 1684 | CAMLreturn(v_res); 1685 | } 1686 | 1687 | CAMLprim value caml_sqlite3_backup_step(value v_backup, intnat pagecount) { 1688 | CAMLparam1(v_backup); 1689 | sqlite3_backup *backup = Sqlite3_backup_val(v_backup); 1690 | int rc; 1691 | 1692 | caml_enter_blocking_section(); 1693 | 1694 | rc = sqlite3_backup_step(backup, pagecount); 1695 | 1696 | caml_leave_blocking_section(); 1697 | 1698 | CAMLreturn(Val_rc(rc)); 1699 | } 1700 | 1701 | CAMLprim value caml_sqlite3_backup_step_bc(value v_backup, value v_pagecount) { 1702 | return caml_sqlite3_backup_step(v_backup, Int_val(v_pagecount)); 1703 | } 1704 | 1705 | CAMLprim value caml_sqlite3_backup_finish(value v_backup) { 1706 | return Val_rc(sqlite3_backup_finish(Sqlite3_backup_val(v_backup))); 1707 | } 1708 | 1709 | CAMLprim intnat caml_sqlite3_backup_remaining(value v_backup) { 1710 | return sqlite3_backup_remaining(Sqlite3_backup_val(v_backup)); 1711 | } 1712 | 1713 | CAMLprim value caml_sqlite3_backup_remaining_bc(value v_backup) { 1714 | return Val_int(caml_sqlite3_backup_remaining(v_backup)); 1715 | } 1716 | 1717 | CAMLprim intnat caml_sqlite3_backup_pagecount(value v_backup) { 1718 | return sqlite3_backup_pagecount(Sqlite3_backup_val(v_backup)); 1719 | } 1720 | 1721 | CAMLprim value caml_sqlite3_backup_pagecount_bc(value v_backup) { 1722 | return Val_int(caml_sqlite3_backup_pagecount(v_backup)); 1723 | } 1724 | -------------------------------------------------------------------------------- /sqlite3.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "SQLite3 bindings for OCaml" 4 | description: """ 5 | sqlite3-ocaml is an OCaml library with bindings to the SQLite3 client API. 6 | Sqlite3 is a self-contained, serverless, zero-configuration, transactional SQL 7 | database engine with outstanding performance for many use cases.""" 8 | maintainer: ["Markus Mottl "] 9 | authors: [ 10 | "Markus Mottl " 11 | "Christian Szegedy " 12 | ] 13 | license: "MIT" 14 | tags: ["clib:sqlite3" "clib:pthread"] 15 | homepage: "https://mmottl.github.io/sqlite3-ocaml" 16 | doc: "https://mmottl.github.io/sqlite3-ocaml/api" 17 | bug-reports: "https://github.com/mmottl/sqlite3-ocaml/issues" 18 | depends: [ 19 | "dune" {>= "2.7"} 20 | "ocaml" {>= "4.12"} 21 | "dune-configurator" 22 | "conf-sqlite3" {build} 23 | "ppx_inline_test" {with-test} 24 | "odoc" {with-doc} 25 | ] 26 | build: [ 27 | ["dune" "subst"] {dev} 28 | [ 29 | "dune" 30 | "build" 31 | "-p" 32 | name 33 | "-j" 34 | jobs 35 | "@install" 36 | "@runtest" {with-test} 37 | "@doc" {with-doc} 38 | ] 39 | ] 40 | dev-repo: "git+https://github.com/mmottl/sqlite3-ocaml.git" 41 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean 2 | 3 | all: 4 | @dune runtest 5 | 6 | clean: 7 | @dune clean 8 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name sqlite3_test) 3 | (inline_tests) 4 | (libraries str sqlite3) 5 | (preprocess 6 | (pps ppx_inline_test))) 7 | -------------------------------------------------------------------------------- /test/test_agg.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let%test "test_agg" = 4 | let db = db_open "t_agg" in 5 | Aggregate.create_fun2 db "STRREPEAT" ~init:[] 6 | ~step:(fun l s i -> 7 | match (s, i) with 8 | | Data.TEXT s, Data.INT i -> 9 | let suffix = String.make (Int64.to_int i) s.[0] in 10 | (s ^ suffix) :: l 11 | | _ -> raise (Sqlite3.Error "wrong types to 'STRREPEAT'")) 12 | ~final:(fun l -> Data.TEXT (String.concat " | " (List.rev l))); 13 | let sqls = 14 | [ 15 | "DROP TABLE IF EXISTS tbl"; 16 | "CREATE TABLE tbl (a varchar(10), a2 varchar(10), b INTEGER, c FLOAT)"; 17 | "INSERT INTO tbl VALUES ('pippo', 'foo', 3, 3.14)"; 18 | "INSERT INTO tbl VALUES ('bar', 'onion', 5, 3.14)"; 19 | "SELECT STRREPEAT(a, b) FROM tbl"; 20 | "SELECT STRREPEAT(a2, b) FROM tbl"; 21 | ] 22 | in 23 | List.iter 24 | (fun sql -> 25 | try 26 | let res = 27 | exec db sql ~cb:(fun row _ -> 28 | match row.(0) with Some a -> print_endline a | _ -> ()) 29 | in 30 | match res with 31 | | Rc.OK -> () 32 | | r -> 33 | prerr_endline (Rc.to_string r); 34 | prerr_endline (errmsg db) 35 | with Sqlite3.Error s -> prerr_endline s) 36 | sqls; 37 | true 38 | -------------------------------------------------------------------------------- /test/test_backup.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let%test "test_backup" = 4 | (* Sql statements for this test *) 5 | let schema = 6 | "CREATE TABLE test_backup (num INTEGER NOT NULL, string TEXT NULL);" 7 | in 8 | let insert_sql = "INSERT INTO test_backup (num, string) VALUES (?, ?)" in 9 | let select_sql = "SELECT num, string FROM test_backup" in 10 | 11 | (* Construct database and statements *) 12 | let src = db_open "t_backup_src" in 13 | let rc = exec src schema in 14 | Printf.printf "Created schema: %s\n" (Rc.to_string rc); 15 | let insert_stmt = prepare src insert_sql in 16 | 17 | (* Insert values in row 1 *) 18 | for x = 0 to 1000 do 19 | ignore (reset insert_stmt); 20 | ignore (bind insert_stmt 1 (Sqlite3.Data.INT (Int64.of_int x))); 21 | ignore (bind insert_stmt 2 (Data.opt_text (Some (string_of_int x)))); 22 | ignore (step insert_stmt) 23 | done; 24 | Printf.printf "Data written to database\n"; 25 | 26 | (* Clean up *) 27 | ignore (finalize insert_stmt); 28 | 29 | (* Create a backup of the database *) 30 | let dst = db_open "t_backup_dst" in 31 | let backup = Backup.init ~dst ~dst_name:"main" ~src ~src_name:"main" in 32 | let rec run () = 33 | match Backup.step backup 1 with 34 | | Rc.LOCKED | Rc.BUSY | Rc.OK -> run () 35 | | Rc.DONE -> Printf.printf "Backup complete\n" 36 | | _ -> assert true 37 | in 38 | run (); 39 | ignore (Backup.finish backup); 40 | 41 | (* Fetch data back with values *) 42 | let select_stmt = prepare dst select_sql in 43 | ignore (reset select_stmt); 44 | let rec run () = 45 | match step select_stmt with 46 | | Rc.ROW -> 47 | assert ( 48 | string_of_int (Data.to_int_exn (column select_stmt 0)) 49 | = Data.to_string_exn (column select_stmt 1)); 50 | run () 51 | | Rc.DONE -> () 52 | | _ -> assert true 53 | in 54 | run (); 55 | Printf.printf "Data read from backup database\n"; 56 | 57 | (* Clean up *) 58 | ignore (finalize select_stmt); 59 | assert (db_close src); 60 | assert (db_close dst); 61 | true 62 | -------------------------------------------------------------------------------- /test/test_collation.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let assert_ok rc = assert (rc = Rc.OK) 4 | let assert_error rc = assert (rc = Rc.ERROR) 5 | 6 | let assert_rows_equal expected_rows db sql = 7 | let actual_rows = ref [] in 8 | let _ = 9 | assert_ok 10 | (exec db sql ~cb:(fun row _ -> 11 | match row.(0) with 12 | | Some a -> actual_rows := a :: !actual_rows 13 | | _ -> ())) 14 | in 15 | let actual_rows = List.sort compare (List.rev !actual_rows) in 16 | assert (actual_rows = expected_rows) 17 | 18 | let%test "test_collation" = 19 | let db = db_open "t_collation" in 20 | create_collation db "FIRST_CHAR" (fun left right -> 21 | compare (String.get left 0) (String.get right 0)); 22 | 23 | let found_first_char = ref false in 24 | let _ = 25 | assert_ok 26 | (exec db "PRAGMA collation_list" ~cb:(fun row _ -> 27 | match row.(1) with 28 | | Some a -> found_first_char := !found_first_char || a = "FIRST_CHAR" 29 | | _ -> ())) 30 | in 31 | assert !found_first_char; 32 | 33 | assert_ok (exec db "DROP TABLE IF EXISTS tbl"); 34 | assert_ok (exec db "CREATE TABLE tbl (a varchar(10) COLLATE FIRST_CHAR)"); 35 | assert_ok (exec db "INSERT INTO tbl VALUES ('pippo')"); 36 | assert_ok (exec db "INSERT INTO tbl VALUES ('pippo2')"); 37 | assert_ok (exec db "INSERT INTO tbl VALUES ('atypical')"); 38 | assert_rows_equal [ "pippo"; "pippo2" ] db 39 | "SELECT * FROM tbl WHERE a = 'pippo'"; 40 | assert_rows_equal [ "pippo"; "pippo2" ] db 41 | "SELECT * FROM tbl WHERE a = 'papa'"; 42 | assert_rows_equal [ "atypical" ] db 43 | "SELECT * FROM tbl WHERE a = 'asymmetrical'"; 44 | assert_rows_equal [ "atypical" ] db "SELECT * FROM tbl WHERE a = 'atypical'"; 45 | assert_rows_equal [] db "SELECT * FROM tbl WHERE a = 'border'"; 46 | 47 | assert_ok (exec db "DROP TABLE IF EXISTS tbl"); 48 | assert_ok (exec db "CREATE TABLE tbl (a varchar(10))"); 49 | assert_ok (exec db "INSERT INTO tbl VALUES ('pippo')"); 50 | assert_ok (exec db "INSERT INTO tbl VALUES ('pippo2')"); 51 | assert_rows_equal [ "pippo" ] db "SELECT * FROM tbl WHERE a = 'pippo'"; 52 | assert_rows_equal [ "pippo"; "pippo2" ] db 53 | "SELECT * FROM tbl WHERE a = 'pippo' COLLATE FIRST_CHAR"; 54 | 55 | delete_collation db "FIRST_CHAR"; 56 | assert_error 57 | (exec db "SELECT * FROM tbl WHERE a = 'pippo' COLLATE FIRST_CHAR"); 58 | true 59 | -------------------------------------------------------------------------------- /test/test_db.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let%test "test_db" = 4 | for _ = 1 to 1000 do 5 | let db = db_open "t_db" in 6 | Gc.full_major (); 7 | let _ = db_close db in 8 | () 9 | done; 10 | print_endline "Able to open and close database"; 11 | true 12 | -------------------------------------------------------------------------------- /test/test_error.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | exception This_function_always_fails 4 | 5 | (* Tests our ability to raise an exception from a user-defined function *) 6 | let%test "test_error" = 7 | let db = db_open "t_error" in 8 | create_fun0 db "MYERROR" (fun () -> raise This_function_always_fails); 9 | let first_test = 10 | try 11 | let res = exec db "SELECT MYERROR();" in 12 | prerr_endline ("Should have thrown an error: " ^ Rc.to_string res); 13 | false 14 | with This_function_always_fails -> 15 | print_endline "Ok"; 16 | true 17 | in 18 | 19 | (* This pattern shows typical usage *) 20 | exec db "PRAGMA synchronous = OFF;" |> Rc.check; 21 | exec db "PRAGMA journal_mode = MEMORY;" |> Rc.check; 22 | let second_test = 23 | try 24 | exec db "THIS SHOULD THROW AN EXCEPTION;; BECAUSE IT IS NOT VALID;;" 25 | |> Rc.check; 26 | false 27 | with SqliteError _ -> 28 | print_endline "Ok"; 29 | true 30 | in 31 | 32 | (* Check the extended error code. *) 33 | exec db "CREATE TABLE erc1 (x INTEGER UNIQUE NOT NULL CHECK (x > 0))" 34 | |> Rc.check; 35 | exec db "CREATE TABLE erc2 (x INTEGER PRIMARY KEY, y REFERENCES erc1(x))" 36 | |> Rc.check; 37 | let erc_test expected_erc q = 38 | let _ = exec db q in 39 | let erc = extended_errcode_int db in 40 | if erc = expected_erc then ( 41 | print_endline "Ok"; 42 | true) 43 | else ( 44 | Printf.eprintf "Expected extended error code %d for %S, got %d.\n%!" 45 | expected_erc q erc; 46 | false) 47 | in 48 | 49 | first_test && second_test 50 | && erc_test 1299 "INSERT INTO erc1 (x) VALUES (NULL)" 51 | && erc_test 275 "INSERT INTO erc1 (x) VALUES (0)" 52 | && erc_test 2067 "INSERT INTO erc1 (x) VALUES (1), (1)" 53 | && erc_test 1555 "INSERT INTO erc2 (x) VALUES (1), (1)" 54 | -------------------------------------------------------------------------------- /test/test_exec.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Sqlite3 3 | 4 | exception Dummy 5 | 6 | let assert_ok rc = assert (rc = Rc.OK) 7 | 8 | let%test "test_exec" = 9 | let db = db_open "t_exec" in 10 | for i = 0 to 10 do 11 | try 12 | let drop = sprintf "DROP TABLE IF EXISTS tbl%d" i 13 | and sql = 14 | sprintf "CREATE TABLE tbl%d (a varchar(1), b INTEGER, c FLOAT)" i 15 | in 16 | printf "%d %s\n%!" i sql; 17 | assert_ok (exec db drop); 18 | match exec db sql ~cb:(fun _ _ -> print_endline "???") with 19 | | Rc.OK -> () 20 | | _ -> 21 | printf "Failed: %s\n" (errmsg db); 22 | assert false 23 | with xcp -> print_endline (Printexc.to_string xcp) 24 | done; 25 | for i = 0 to 3 do 26 | let sql = sprintf "SYNTACTICALLY INCORRECT SQL STATEMENT" in 27 | printf "%d %s\n%!" i sql; 28 | try 29 | match exec db sql ~cb:(fun _ _ -> print_endline "???") with 30 | | Rc.ERROR -> printf "Identified error: %s\n" (errmsg db) 31 | | _ -> assert false 32 | with xcp -> print_endline (Printexc.to_string xcp) 33 | done; 34 | for i = 0 to 3 do 35 | let sql = sprintf "INSERT INTO tbl%d VALUES ('a', 3, 3.14)" i in 36 | printf "%d %s\n%!" i sql; 37 | try 38 | match exec db sql ~cb:(fun _ _ -> print_endline "???") with 39 | | Rc.OK -> printf "Inserted %d rows\n%!" (changes db) 40 | | _ -> assert false 41 | with xcp -> print_endline (Printexc.to_string xcp) 42 | done; 43 | let sql = sprintf "SELECT * FROM tbl0" in 44 | for _i = 0 to 3 do 45 | try 46 | print_endline "TESTING!"; 47 | match 48 | exec db sql ~cb:(fun _ _ -> 49 | print_endline "FOUND!"; 50 | raise Dummy) 51 | with 52 | | Rc.OK -> print_endline "OK" 53 | | _ -> assert false 54 | with xcp -> print_endline (Printexc.to_string xcp) 55 | done; 56 | true 57 | -------------------------------------------------------------------------------- /test/test_fun.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Sqlite3 3 | 4 | let%test "test_fun" = 5 | let db = db_open "t_fun" in 6 | create_fun2 db "REGEX" (fun s rex -> 7 | match (rex, s) with 8 | | Data.TEXT rex, Data.BLOB s | Data.TEXT rex, Data.TEXT s -> 9 | let r = Str.regexp rex in 10 | if Str.string_match r s 0 then Data.INT 1L else Data.INT 0L 11 | | _ -> raise (Sqlite3.Error "wrong types to 'REGEX'")); 12 | let sqls = 13 | [ 14 | "DROP TABLE IF EXISTS tbl"; 15 | "CREATE TABLE tbl (a varchar(10), b INTEGER, c FLOAT)"; 16 | "INSERT INTO tbl VALUES ('pippo', 3, 3.14)"; 17 | "SELECT * FROM tbl where REGEX(a,'^pippo$')"; 18 | "SELECT * FROM tbl where REGEX(a,'^ippo')"; 19 | "SELECT * FROM tbl where REGEX(a,'[^z]*')"; 20 | ] 21 | in 22 | List.iter 23 | (fun sql -> 24 | try 25 | let res = 26 | exec db sql ~cb:(fun row _ -> 27 | match (row.(0), row.(1), row.(2)) with 28 | | Some a, Some b, Some c -> printf "%s|%s|%s\n" a b c 29 | | _ -> ()) 30 | in 31 | match res with 32 | | Rc.OK -> () 33 | | r -> 34 | prerr_endline (Rc.to_string r); 35 | prerr_endline (errmsg db) 36 | with Sqlite3.Error s -> prerr_endline s) 37 | sqls; 38 | true 39 | -------------------------------------------------------------------------------- /test/test_stmt.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Sqlite3 3 | 4 | let assert_ok rc = assert (rc = Rc.OK) 5 | let assert_done rc = assert (rc = Rc.DONE) 6 | 7 | let column_decltype s i = 8 | match column_decltype s i with None -> "" | Some str -> str 9 | 10 | let stepbystep s = 11 | assert_done 12 | (iter s ~f:(function r -> 13 | Array.iteri 14 | (fun i c -> 15 | printf "%s column[%d] %s = %s\n%!" (column_decltype s i) i 16 | (column_name s i) (Data.to_string_coerce c)) 17 | r)) 18 | 19 | let stepbystep_wrong s = 20 | while step s = Rc.ROW do 21 | for i = 0 to data_count s do 22 | printf "%s column[%d] %s = %s\n%!" (column_decltype s i) i 23 | (column_name s i) 24 | (Data.to_string_coerce (column s i)) 25 | done 26 | done 27 | 28 | let mk_tbl db id = 29 | let sql = 30 | sprintf "CREATE TABLE tbl%d (a varchar(1), b INTEGER, c FLOAT)" id 31 | in 32 | Rc.check (exec db sql); 33 | let sql = sprintf "INSERT INTO tbl%d VALUES ('a', 3, 3.14)" id in 34 | Rc.check (exec db sql) 35 | 36 | let%test "test_stmt" = 37 | let db = db_open "t_stmt" in 38 | 39 | mk_tbl db 0; 40 | mk_tbl db 1; 41 | 42 | assert_ok (exec db "DROP TABLE IF EXISTS test0"); 43 | assert_ok (exec db "DROP TABLE IF EXISTS test1"); 44 | assert_ok (exec db "CREATE TABLE test0(a TEXT, b INTEGER, c REAL)"); 45 | assert_ok (exec db "CREATE TABLE test1(a TEXT, b INTEGER, c REAL)"); 46 | assert_ok (exec db "INSERT INTO test0 VALUES ('a', 1, 0.1), ('b', 2, 0.2)"); 47 | assert_ok (exec db "INSERT INTO test1 VALUES ('c', 3, 0.3), ('d', 4, 0.4)"); 48 | 49 | (* Test the finalization... *) 50 | for _i = 0 to 100 do 51 | (* printf "Create statement %d\n%!" i; *) 52 | let sql = sprintf "SELECT * FROM test0" in 53 | ignore (prepare db sql) 54 | done; 55 | 56 | for _i = 0 to 100 do 57 | (* printf "Create statement %d\n%!" i; *) 58 | let sql = sprintf "SELECT * FROM test0" in 59 | assert_ok (finalize (prepare db sql)) 60 | done; 61 | 62 | for _i = 0 to 100 do 63 | (* printf "Create statement %d\n%!" i; *) 64 | let sql = sprintf "SELECT * FROM test0; SELECT * FROM test1;" in 65 | ignore (prepare_tail (prepare db sql)) 66 | done; 67 | 68 | let premade_statement = ref None in 69 | for _i = 0 to 100 do 70 | (* printf "Create statement %d\n%!" i; *) 71 | let sql = sprintf "SELECT * FROM test0; SELECT * FROM test1;" in 72 | ignore (prepare_or_reset db premade_statement sql) 73 | done; 74 | 75 | for _i = 1 to 10 do 76 | (* printf "Create statement %d\n%!" i; *) 77 | let sql = sprintf "SELECT * FROM test0; SELECT * FROM test1;" in 78 | let stmt = prepare db sql in 79 | assert_ok (finalize stmt); 80 | try ignore (prepare_tail stmt) with _xcp -> () 81 | done; 82 | 83 | let sql = sprintf "SELECT * FROM test0; SELECT * FROM test0;" in 84 | let stmt = prepare db sql in 85 | print_endline "A-------------------------------------------"; 86 | stepbystep stmt; 87 | print_endline "B-------------------------------------------"; 88 | (match prepare_tail stmt with 89 | | Some s -> stepbystep s 90 | | None -> failwith "Tail not found!"); 91 | assert_ok (reset stmt); 92 | print_endline "C-------------------------------------------"; 93 | stepbystep stmt; 94 | print_endline "D-------------------------------------------"; 95 | (match prepare_tail stmt with 96 | | Some s -> stepbystep s 97 | | None -> failwith "Tail not found!"); 98 | (match prepare_tail stmt with 99 | | Some s -> stepbystep s 100 | | None -> failwith "Tail not found!"); 101 | print_endline "E-------------------------------------------"; 102 | (try 103 | match prepare_tail stmt with 104 | | Some s -> stepbystep_wrong s 105 | | None -> failwith "Tail not found!" 106 | with xcp -> printf "Ok: %s\n" (Printexc.to_string xcp)); 107 | assert_ok (finalize stmt); 108 | 109 | let stmt = prepare db "SELECT * FROM test0 WHERE a = ? AND b = ?" in 110 | assert_ok (bind_values stmt [ Data.TEXT "a"; Data.INT 1L ]); 111 | assert (step stmt = Rc.ROW); 112 | assert_ok (finalize stmt); 113 | let stmt = prepare db "SELECT * FROM test0 WHERE a = :a" in 114 | assert_ok (bind_name stmt ":a" (Data.TEXT "b")); 115 | assert (step stmt = Rc.ROW); 116 | assert_ok (finalize stmt); 117 | let stmt = prepare db "SELECT * FROM test0 WHERE a = :a AND b = :b" in 118 | assert_ok (bind_names stmt [ (":a", Data.TEXT "a"); (":b", Data.INT 1L) ]); 119 | assert (step stmt = Rc.ROW); 120 | assert_ok (finalize stmt); 121 | let stmt = prepare db "SELECT * FROM test0 WHERE a = ?" in 122 | (try assert_ok (bind_values stmt [ Data.INT 1L; Data.INT 2L ]) with 123 | | RangeError _ -> () 124 | | exn -> raise exn); 125 | (try assert_ok (bind_name stmt ":a" (Data.INT 3L)) with 126 | | Not_found -> () 127 | | exn -> raise exn); 128 | assert_ok (finalize stmt); 129 | 130 | let of_intdata = function Data.INT i -> i | _ -> failwith "Invalid type" in 131 | let stmt = prepare db "SELECT b FROM test0" in 132 | let rc, sum = 133 | fold stmt ~init:0L ~f:(fun s b -> Int64.add s (of_intdata b.(0))) 134 | in 135 | assert_ok (finalize stmt); 136 | assert_done rc; 137 | assert (sum = 3L); 138 | printf "fold: sum of table0(b) is %Ld\n" sum; 139 | 140 | Gc.full_major (); 141 | 142 | (* Collect any dangling statements *) 143 | assert (db_close db); 144 | true 145 | -------------------------------------------------------------------------------- /test/test_values.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let%test "test_values" = 4 | (* Sql statements for this test *) 5 | let schema = 6 | "CREATE TABLE test_values ( " ^ " row_id INTEGER NOT NULL, " 7 | ^ " string_col TEXT NULL, " ^ " int_col INT NULL, " 8 | ^ " int64_col INT NULL, " ^ " float_col FLOAT NULL, " 9 | ^ " bool_col INT NULL" ^ ");" 10 | in 11 | let insert_sql = 12 | "INSERT INTO test_values " 13 | ^ "(row_id, string_col, int_col, int64_col, float_col, bool_col) " 14 | ^ "VALUES (?, ?, ?, ?, ?, ?)" 15 | in 16 | let select_sql = 17 | "SELECT " ^ "string_col, int_col, int64_col, float_col, bool_col " 18 | ^ "FROM test_values WHERE row_id = ?" 19 | in 20 | 21 | (* Construct database and statements *) 22 | let db = db_open "t_values" in 23 | let rc = exec db schema in 24 | Printf.printf "Created schema: %s" (Rc.to_string rc); 25 | let insert_stmt = prepare db insert_sql in 26 | let select_stmt = prepare db select_sql in 27 | 28 | (* Insert values in row 1 *) 29 | let test_float_val = 56.789 in 30 | ignore (reset insert_stmt); 31 | ignore (bind insert_stmt 1 (Sqlite3.Data.INT 1L)); 32 | ignore (bind insert_stmt 2 (Data.opt_text (Some "Hi Mom"))); 33 | ignore (bind insert_stmt 3 (Data.opt_int (Some 1))); 34 | ignore (bind insert_stmt 4 (Data.opt_int64 (Some Int64.max_int))); 35 | ignore (bind insert_stmt 5 (Data.opt_float (Some test_float_val))); 36 | ignore (bind insert_stmt 6 (Data.opt_bool (Some true))); 37 | ignore (step insert_stmt); 38 | 39 | (* Insert nulls in row 2 *) 40 | ignore (reset insert_stmt); 41 | ignore (bind insert_stmt 1 (Sqlite3.Data.INT 2L)); 42 | ignore (bind insert_stmt 2 (Data.opt_text None)); 43 | ignore (bind insert_stmt 3 (Data.opt_int None)); 44 | ignore (bind insert_stmt 4 (Data.opt_int64 None)); 45 | ignore (bind insert_stmt 5 (Data.opt_float None)); 46 | ignore (bind insert_stmt 6 (Data.opt_bool None)); 47 | ignore (step insert_stmt); 48 | 49 | (* Fetch data back with values *) 50 | ignore (reset select_stmt); 51 | ignore (bind select_stmt 1 (Sqlite3.Data.INT 1L)); 52 | if Sqlite3.step select_stmt = Sqlite3.Rc.ROW then ( 53 | assert (Data.to_string_exn (column select_stmt 0) = "Hi Mom"); 54 | assert (Data.to_int_exn (column select_stmt 1) = 1); 55 | assert (Data.to_int64_exn (column select_stmt 2) = Int64.max_int); 56 | assert (Data.to_float_exn (column select_stmt 3) = test_float_val); 57 | assert (Data.to_bool_exn (column select_stmt 4) = true)); 58 | 59 | (* Fetch data back with nulls *) 60 | ignore (reset select_stmt); 61 | ignore (bind select_stmt 1 (Sqlite3.Data.INT 2L)); 62 | if Sqlite3.step select_stmt = Sqlite3.Rc.ROW then ( 63 | assert (column_text select_stmt 0 = ""); 64 | assert (column_int select_stmt 1 = 0); 65 | assert (column_int32 select_stmt 1 = 0l); 66 | assert (column_int64 select_stmt 2 = 0L); 67 | assert (column_double select_stmt 3 = 0.0); 68 | assert (column_bool select_stmt 4 = false)); 69 | 70 | (* Clean up *) 71 | ignore (finalize insert_stmt); 72 | ignore (finalize select_stmt); 73 | assert (db_close db); 74 | true 75 | -------------------------------------------------------------------------------- /test/test_win.ml: -------------------------------------------------------------------------------- 1 | open Sqlite3 2 | 3 | let%test "test_window" = 4 | Printf.printf "Using version %s\n" (sqlite_version_info ()); 5 | if sqlite_version () >= 3025000 then ( 6 | let db = db_open "t_fun" in 7 | let getval p = Data.FLOAT p in 8 | Aggregate.create_fun1 db "product" ~init:1.0 9 | ~step:(fun p v -> p *. Data.to_float_exn v) 10 | ~inverse:(fun p v -> p /. Data.to_float_exn v) 11 | ~value:getval ~final:getval; 12 | let s = 13 | prepare db 14 | "WITH cte(id, num) AS (VALUES (0,2.0),(1,3.0),(2,4.0),(3,5.0),(4,6.0)) \ 15 | SELECT id, product(num) OVER (ORDER BY id ROWS BETWEEN 2 PRECEDING \ 16 | AND CURRENT ROW) FROM cte ORDER BY id" 17 | in 18 | let expected = [| 2.0; 6.0; 24.0; 60.0; 120.0 |] in 19 | print_endline "Testing window functions."; 20 | while step s = Rc.ROW do 21 | Printf.printf "got %f expected %f\n" (column_double s 1) 22 | expected.(column_int s 0) 23 | done) 24 | else prerr_endline "Skipping window function test."; 25 | true 26 | --------------------------------------------------------------------------------