Skip to content
Browse files

Initial import

  • Loading branch information...
0 parents commit f3c56045215d8becd8a32efea992fcb1fcf2be11 @dmitryvk committed Mar 8, 2009
Showing with 1,066 additions and 0 deletions.
  1. +58 −0 cache.lisp
  2. +425 −0 index.html
  3. +194 −0 sqlite-ffi.lisp
  4. +9 −0 sqlite.asd
  5. +326 −0 sqlite.lisp
  6. +54 −0 style.css
58 cache.lisp
@@ -0,0 +1,58 @@
+(defpackage :sqlite.cache
+ (:use :cl :iter)
+ (:export :mru-cache
+ :get-from-cache
+ :put-to-cache
+ :purge-cache))
+
+(in-package :sqlite.cache)
+
+;(declaim (optimize (speed 3) (safety 0) (debug 0)))
+
+(defclass mru-cache ()
+ ((objects-table :accessor objects-table :initform (make-hash-table :test 'equal))
+ (last-access-time-table :accessor last-access-time-table :initform (make-hash-table :test 'equal))
+ (total-cached :type fixnum :accessor total-cached :initform 0)
+ (cache-size :type fixnum :accessor cache-size :initarg :cache-size :initform 100)
+ (destructor :accessor destructor :initarg :destructor :initform #'identity)))
+
+(defun get-from-cache (cache id)
+ (let ((available-objects-stack (gethash id (objects-table cache))))
+ (when (and available-objects-stack (> (length (the vector available-objects-stack)) 0))
+ (decf (the fixnum (total-cached cache)))
+ (setf (gethash id (last-access-time-table cache)) (get-internal-run-time))
+ (vector-pop (the vector available-objects-stack)))))
+
+(defun remove-empty-objects-stacks (cache)
+ (let ((table (objects-table cache)))
+ (maphash (lambda (key value)
+ (declare (type vector value))
+ (when (zerop (length value))
+ (remhash key table)
+ (remhash key (last-access-time-table cache))))
+ table)))
+
+(defun pop-from-cache (cache)
+ (let ((id (iter (for (id time) in-hashtable (last-access-time-table cache))
+ (when (not (zerop (length (the vector (gethash id (objects-table cache))))))
+ (finding id minimizing (the fixnum time))))))
+ (let ((object (vector-pop (gethash id (objects-table cache)))))
+ (funcall (destructor cache) object)))
+ (remove-empty-objects-stacks cache)
+ (decf (the fixnum (total-cached cache))))
+
+(defun put-to-cache (cache id object)
+ (when (>= (the fixnum (total-cached cache)) (the fixnum (cache-size cache)))
+ (pop-from-cache cache))
+ (let ((available-objects-stack (or (gethash id (objects-table cache))
+ (setf (gethash id (objects-table cache)) (make-array 0 :adjustable t :fill-pointer t)))))
+ (vector-push-extend object available-objects-stack)
+ (setf (gethash id (last-access-time-table cache)) (get-internal-run-time))
+ (incf (the fixnum (total-cached cache)))
+ object))
+
+(defun purge-cache (cache)
+ (iter (for (id items) in-hashtable (objects-table cache))
+ (when items
+ (iter (for item in-vector (the vector items))
+ (funcall (destructor cache) item)))))
425 index.html
@@ -0,0 +1,425 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<html>
+
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+ <title>SQLITE - Sqlite package</title>
+ <link rel="stylesheet" type="text/css" href="style.css">
+ <style type="text/css">
+ pre { padding:5px; background-color:#e0e0e0 }
+ h3, h4 { text-decoration: underline; }
+ a { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:visited { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; }
+ a:focus { text-decoration: none; padding: 1px 2px 1px 2px; border: none; }
+ a.none { text-decoration: none; padding: 0; }
+ a.none:visited { text-decoration: none; padding: 0; }
+ a.none:hover { text-decoration: none; border: none; padding: 0; }
+ a.none:focus { text-decoration: none; border: none; padding: 0; }
+ a.noborder { text-decoration: none; padding: 0; }
+ a.noborder:visited { text-decoration: none; padding: 0; }
+ a.noborder:hover { text-decoration: none; border: none; padding: 0; }
+ a.noborder:focus { text-decoration: none; border: none; padding: 0; }
+ pre.none { padding:5px; background-color:#ffffff }
+ </style>
+</head>
+
+<body bgcolor=white>
+
+<div class="header">
+ <h1>CL-SQLITE</h1>
+</div>
+
+<blockquote>
+<br>&nbsp;<br><h3><a name=abstract class=none>Abstract</a></h3>
+
+<p>CL-SQLITE package is an interface to the SQLite embedded relational database engine.</p>
+
+<p>The code is in public domain so you can basically do with it whatever you want.</p>
+
+<p style='color: red;'>This documentation describes only the CL-SQLITE package, not the SQLite database itself. SQLite documentation is available at <a href="http://sqlite.org/docs.html">http://sqlite.org/docs.html</a></p>
+
+
+<p>CL-SQLITE together with this documentation can be downloaded from <a href="http://common-lisp.net/project/cl-sqlite/releases/cl-sqlite-0.1.tar.gz">http://common-lisp.net/project/cl-sqlite/releases/cl-sqlite-0.1.tar.gz</a>.</p>
+
+<p>
+</blockquote>
+
+<br>&nbsp;<br><h3><a class=none name="contents">Contents</a></h3>
+<ol>
+ <li><a href="#installation">Installation</a>
+ <li><a href="#example">Example</a>
+ <li><a href="#usage">Usage</a>
+ <li><a href="#dictionary">The SQLITE dictionary</a>
+ <ol>
+ <li><a href="#bind-parameter"><code>bind-parameter</code></a>
+ <li><a href="#connect"><code>connect</code></a>
+ <li><a href="#disconnect"><code>disconnect</code></a>
+ <li><a href="#execute-non-query"><code>execute-non-query</code></a>
+ <li><a href="#execute-one-row-m-v"><code>execute-one-row-m-v</code></a>
+ <li><a href="#execute-single"><code>execute-single</code></a>
+ <li><a href="#execute-to-list"><code>execute-to-list</code></a>
+ <li><a href="#finalize-statement"><code>finalize-statement</code></a>
+ <li><a href="#last-insert-rowid"><code>last-insert-rowid</code></a>
+ <li><a href="#prepare-statement"><code>prepare-statement</code></a>
+ <li><a href="#reset-statement"><code>reset-statement</code></a>
+ <li><a href="#sqlite-handle"><code>sqlite-handle</code></a>
+ <li><a href="#sqlite-statement"><code>sqlite-statement</code></a>
+ <li><a href="#statement-column-value"><code>statement-column-value</code></a>
+ <li><a href="#step-statement"><code>step-statement</code></a>
+ <li><a href="#with-transaction"><code>with-transaction</code></a>
+ </ol>
+ <li><a href="#support">Support</a>
+ <li><a href="#ack">Acknowledgements</a>
+</ol>
+
+<br>&nbsp;<br><h3><a class=none name="installation">Installation</a></h3>
+
+<p>The package can be downloaded from <a href="http://common-lisp.net/project/cl-sqlite/releases/cl-sqlite-0.1.tar.gz">http://common-lisp.net/project/cl-sqlite/releases/cl-sqlite-0.1.tar.gz</a>. CL-SQLITE package has the following dependencies:</p>
+<ul>
+ <li><a href="http://common-lisp.net/project/cffi/">CFFI</a></li>
+ <li><a href="http://common-lisp.net/project/iterate/">iterate</a></li>
+</ul>
+
+<p>SQLITE has a system definition for <a href="http://www.cliki.net/asdf">ASDF</a>. Compile and load it in the usual way.</p>
+
+
+<br>&nbsp;<br><h3><a class=none name="example">Example</a></h3>
+
+<pre>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #000000;">use-package</span><span style="color: #000000;"> :sqlite</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #000000;">use-package</span><span style="color: #000000;"> :iter</span><span style="font-weight: bold;color: #0000ff;">)</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #d22811;">defvar</span><span style="color: #000080;"> *db* </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">connect </span><span style="color: #dd0000;">":memory:"</span><span style="font-weight: bold;color: #0000ff;">))</span><span style="color: #000000;"> </span><span style="font-style: italic;color: #808080;">;;Connect to the sqlite database. :memory: is the temporary in-memory database</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-non-query *db* </span><span style="color: #dd0000;">"create table users (id integer primary key, user_name text not null, age integer null)"</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> </span><span style="font-style: italic;color: #808080;">;;Create the table</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-non-query *db* </span><span style="color: #dd0000;">"insert into users (user_name, age) values (?, ?)"</span><span style="color: #000000;"> </span><span style="color: #dd0000;">"joe"</span><span style="color: #000000;"> </span><span style="color: #0000ff;">18</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-non-query *db* </span><span style="color: #dd0000;">"insert into users (user_name, age) values (?, ?)"</span><span style="color: #000000;"> </span><span style="color: #dd0000;">"dvk"</span><span style="color: #000000;"> </span><span style="color: #0000ff;">22</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-non-query *db* </span><span style="color: #dd0000;">"insert into users (user_name, age) values (?, ?)"</span><span style="color: #000000;"> </span><span style="color: #dd0000;">"qwe"</span><span style="color: #000000;"> </span><span style="color: #0000ff;">30</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-non-query *db* </span><span style="color: #dd0000;">"insert into users (user_name, age) values (?, ?)"</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #000000;">nil</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #000000;">nil</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> </span><span style="font-style: italic;color: #808080;">;; ERROR: constraint failed</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-single *db* </span><span style="color: #dd0000;">"select id from users where user_name = ?"</span><span style="color: #000000;"> </span><span style="color: #dd0000;">"dvk"</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-style: italic;color: #808080;">;; =&gt; 2</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-one-row-m-v *db* </span><span style="color: #dd0000;">"select id, user_name, age from users where user_name = ?"</span><span style="color: #000000;"> </span><span style="color: #dd0000;">"joe"</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-style: italic;color: #808080;">;; =&gt; (values 1 "joe" 18)</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">execute-to-list *db* </span><span style="color: #dd0000;">"select id, user_name, age from users"</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="font-style: italic;color: #808080;">;; =&gt; ((1 "joe" 18) (2 "dvk" 22) (3 "qwe" 30))</span>
+
+<span style="font-style: italic;color: #808080;">;; Use iterate</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">iter </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">for </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">id user-name age</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> in-sqlite-query </span><span style="color: #dd0000;">"select id, user_name, age from users where age &lt; ?"</span><span style="color: #000000;"> on-database *db* with-parameters </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #0000ff;">25</span><span style="font-weight: bold;color: #0000ff;">))</span>
+<span style="color: #000000;"> </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">collect </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #000000;">list</span><span style="color: #000000;"> id user-name age</span><span style="font-weight: bold;color: #0000ff;">)))</span>
+<span style="font-style: italic;color: #808080;">;; =&gt; ((1 "joe" 18) (2 "dvk" 22))</span>
+
+<span style="font-style: italic;color: #808080;">;; Use prepared statements directly</span>
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #000000;">loop</span>
+<span style="color: #000000;"> with statement </span><span style="font-weight: bold;color: #d22811;">=</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">prepare-statement *db* </span><span style="color: #dd0000;">"select id, user_name, age from users where age &lt; ?"</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="color: #000000;"> initially </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">bind-parameter statement </span><span style="color: #0000ff;">1</span><span style="color: #000000;"> </span><span style="color: #0000ff;">25</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="color: #000000;"> while </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">step-statement statement</span><span style="font-weight: bold;color: #0000ff;">)</span>
+<span style="color: #000000;"> collect </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="font-weight: bold;color: #000000;">list</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">statement-column-value statement </span><span style="color: #0000ff;">0</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">statement-column-value statement </span><span style="color: #0000ff;">1</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">statement-column-value statement </span><span style="color: #0000ff;">2</span><span style="font-weight: bold;color: #0000ff;">))</span>
+<span style="color: #000000;"> finally </span><span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">finalize-statement statement</span><span style="font-weight: bold;color: #0000ff;">))</span>
+<span style="font-style: italic;color: #808080;">;; =&gt; ((1 "joe" 18) (2 "dvk" 22))</span>
+
+<span style="font-weight: bold;color: #0000ff;">(</span><span style="color: #000000;">disconnect *db*</span><span style="font-weight: bold;color: #0000ff;">)</span><span style="color: #000000;"> </span><span style="font-style: italic;color: #808080;">;;Disconnect</span></pre>
+
+<br>&nbsp;<br><h3><a class=none name="usage">Usage</a></h3>
+
+<p>Two functions are used to manage connections to the database:</p>
+<ul>
+<li><a href="#connect">connect</a> connects to the database</li>
+<li><a href="#disconnect">disconnect</a> disconnects from the database</li>
+</ul>
+
+<p>To make queries to the database the following functions are provided:</p>
+<ul>
+<li><a href="#execute-non-query">execute-non-query</a> executes the query and returns nothing</li>
+<li><a href="#execute-single">execute-single</a> returns the first column of the first row of the result</li>
+<li><a href="#execute-one-row-m-v">execute-one-row-m-v</a> returns the first row of the result as multiple values</li>
+<li><a href="#execute-to-list">execute-to-list</a> returns all rows as the list of lists</li>
+</ul>
+
+<p>Support for <a href="http://common-lisp.net/project/iterate/">ITERATE</a> is provided. Use the following clause:
+ <blockquote><pre>(for (<i>vars</i>) in-sqlite-query <i>sql</i> on-database <i>db</i> &optional with-parameters (<i>&rest parameters</i>))</pre></blockquote>
+This clause will bind <i>vars</i> (a list of variables) to the values of the columns of query.</p>
+
+<p>Additionally, it is possible to use the prepared statements API of sqlite. Create the prepared statement with <a href="#prepare-statement">prepare-statement</a>, bind its parameters with <a href="#bind-parameter">bind-parameter</a>, step through it with <a href="#step-statement">step-statement</a>, retrieve the results with <a href="#statement-column-value">statement-column-value</a>, and finally reset it to be used again with <a href="#reset-statement">reset-statement</a> or dispose of it with <a href="#finalize-statement">finalize-statement</a>.</p>
+
+<p>Positional parameters in queries are supported (sqlite supports named parameters but this package does not support them). Parameters are denoted by question mark in SQL code.</p>
+
+<p>Following types are supported:</p>
+<ul>
+ <li>Integer. Integers are stored as 64-bit integers.</li>
+ <li>Float. Stored as double. Single-float and double-float may be passed as a parameter, and double-float will be returned.</li>
+ <li>String. Stored as an UTF-8 string.</li>
+ <li>Vector of bytes. Stored as a blob.</li>
+ <li>Null. Passed as NIL to and from database.</li>
+</ul>
+
+<br>&nbsp;<br><h3><a class=none name="dictionary">The SQLITE dictionary</a></h3>
+
+
+
+<!-- Entry for BIND-PARAMETER -->
+
+<p><br>[Function]<br><a class=none name='bind-parameter'><b>bind-parameter</b> <i>statement parameter value</i></a>
+<blockquote><br>
+
+Sets the <i>parameter</i>-th parameter in <i>statement</i> to the <i>value</i>.<br>
+Parameters are numbered from one.<br>
+Supported types:<br>
+<ul>
+<li>Null. Passed as NULL
+<li>Integer. Passed as an 64-bit integer
+<li>String. Passed as a string
+<li>Float. Passed as a double
+<li>(vector (unsigned-byte 8)) and vector that contains integers in range [0,256). Passed as a BLOB
+</ul>
+
+</blockquote>
+
+<!-- End of entry for BIND-PARAMETER -->
+
+
+<!-- Entry for CONNECT -->
+
+<p><br>[Function]<br><a class=none name='connect'><b>connect</b> <i>database-path</i> =&gt; <i>sqlite-handle</i></a>
+<blockquote><br>
+
+Connect to the sqlite database at the given <i>database-path</i>. Returns the <a href="#sqlite-handle">sqlite-handle</a> connected to the database. Use <a href="disconnect">disconnect</a> to disconnect.
+
+</blockquote>
+
+<!-- End of entry for CONNECT -->
+
+
+<!-- Entry for DISCONNECT -->
+
+<p><br>[Function]<br><a class=none name='disconnect'><b>disconnect</b> <i>handle</i></a>
+<blockquote><br>
+
+Disconnects the given <i>handle</i> from the database. All further operations on the handle are invalid.
+
+</blockquote>
+
+<!-- End of entry for DISCONNECT -->
+
+
+<!-- Entry for EXECUTE-NON-QUERY -->
+
+<p><br>[Function]<br><a class=none name='execute-non-query'><b>execute-non-query</b> <i>db sql <tt>&amp;rest</tt> parameters</i></a>
+<blockquote><br>
+
+Executes the query <i>sql</i> to the database <i>db</i> with given <i>parameters</i>. Returns nothing.<br>
+
+Example:<br>
+
+<pre>(execute-non-query db &quot;insert into users (user_name, real_name) values (?, ?)&quot; &quot;joe&quot; &quot;Joe the User&quot;)</pre>
+
+See <a href="#bind-parameter">bind-parameter</a> for the list of supported parameter types.
+
+</blockquote>
+
+<!-- End of entry for EXECUTE-NON-QUERY -->
+
+
+<!-- Entry for EXECUTE-ONE-ROW-M-V -->
+
+<p><br>[Function]<br><a class=none name='execute-one-row-m-v'><b>execute-one-row-m-v</b> <i>db sql <tt>&amp;rest</tt> parameters</i> =&gt; (values <i>result*</i>)</a>
+<blockquote><br>
+
+Executes the query <i>sql</i> to the database <i>db</i> with given <i>parameters</i>. Returns the first row as multiple values.<br>
+
+Example:<br>
+<pre>(execute-one-row-m-v db &quot;select id, user_name, real_name from users where id = ?&quot; 1)
+=&gt;
+(values 1 &quot;joe&quot; &quot;Joe the User&quot;)</pre>
+
+See <a href="#bind-parameter">bind-parameter</a> for the list of supported parameter types.
+
+</blockquote>
+
+<!-- End of entry for EXECUTE-ONE-ROW-M-V -->
+
+
+<!-- Entry for EXECUTE-SINGLE -->
+
+<p><br>[Function]<br><a class=none name='execute-single'><b>execute-single</b> <i>db sql <tt>&amp;rest</tt> parameters</i> =&gt; <i>result</i></a>
+<blockquote><br>
+
+Executes the query <i>sql</i> to the database <i>db</i> with given <i>parameters</i>. Returns the first column of the first row as single value.<br>
+
+Example:<br>
+<pre>(execute-single db &quot;select user_name from users where id = ?&quot; 1)
+=&gt;
+&quot;joe&quot;</pre>
+
+See <a href="#bind-parameter">bind-parameter</a> for the list of supported parameter types.
+
+</blockquote>
+
+<!-- End of entry for EXECUTE-SINGLE -->
+
+
+<!-- Entry for EXECUTE-TO-LIST -->
+
+<p><br>[Function]<br><a class=none name='execute-to-list'><b>execute-to-list</b> <i>db sql <tt>&amp;rest</tt> parameters</i> =&gt; <i>results</i></a>
+<blockquote><br>
+
+Executes the query <i>sql</i> to the database <i>db</i> with given <i>parameters</i>. Returns the results as list of lists.<br>
+
+Example:<br>
+
+<pre>(execute-to-list db &quot;select id, user_name, real_name from users where user_name = ?&quot; &quot;joe&quot;)
+=&gt;
+((1 &quot;joe&quot; &quot;Joe the User&quot;)
+ (2 &quot;joe&quot; &quot;Another Joe&quot;)) </pre>
+
+See <a href="#bind-parameter">bind-parameter</a> for the list of supported parameter types.
+
+</blockquote>
+
+<!-- End of entry for EXECUTE-TO-LIST -->
+
+
+<!-- Entry for FINALIZE-STATEMENT -->
+
+<p><br>[Function]<br><a class=none name='finalize-statement'><b>finalize-statement</b> <i>statement</i></a>
+<blockquote><br>
+
+Finalizes the <i>statement</i> and signals that associated resources may be released.<br>
+Note: does not immediately release resources because statements are cached.
+
+</blockquote>
+
+<!-- End of entry for FINALIZE-STATEMENT -->
+
+
+<!-- Entry for LAST-INSERT-ROWID -->
+
+<p><br>[Function]<br><a class=none name='last-insert-rowid'><b>last-insert-rowid</b> <i>db</i> =&gt; <i>result</i></a>
+<blockquote><br>
+
+Returns the auto-generated ID of the last inserted row on the database connection <i>db</i>.
+
+</blockquote>
+
+<!-- End of entry for LAST-INSERT-ROWID -->
+
+
+<!-- Entry for PREPARE-STATEMENT -->
+
+<p><br>[Function]<br><a class=none name='prepare-statement'><b>prepare-statement</b> <i>db sql</i> =&gt; <i>sqlite-statement</i></a>
+<blockquote><br>
+
+Prepare the statement to the DB that will execute the commands that are in <i>sql</i>.<br>
+
+Returns the <a href="#sqlite-statement">sqlite-statement</a>.<br>
+
+<i>sql</i> must contain exactly one statement.<br>
+<i>sql</i> may have some positional (not named) parameters specified with question marks.<br>
+
+Example:<br>
+
+<pre>(prepare-statement db &quot;select name from users where id = ?&quot;)</pre>
+
+</blockquote>
+
+<!-- End of entry for PREPARE-STATEMENT -->
+
+
+<!-- Entry for RESET-STATEMENT -->
+
+<p><br>[Function]<br><a class=none name='reset-statement'><b>reset-statement</b> <i>statement</i></a>
+<blockquote><br>
+
+Resets the <i>statement</i> and prepare it to be called again.
+
+</blockquote>
+
+<!-- End of entry for RESET-STATEMENT -->
+
+
+<!-- Entry for SQLITE-HANDLE -->
+
+<p><br>[Standard class]<br><a class=none name='sqlite-handle'><b>sqlite-handle</b></a>
+<blockquote><br>
+
+Class that encapsulates the connection to the database.
+
+</blockquote>
+
+<!-- End of entry for SQLITE-HANDLE -->
+
+
+<!-- Entry for SQLITE-STATEMENT -->
+
+<p><br>[Standard class]<br><a class=none name='sqlite-statement'><b>sqlite-statement</b></a>
+<blockquote><br>
+
+Class that represents the prepared statement.
+
+</blockquote>
+
+<!-- End of entry for SQLITE-STATEMENT -->
+
+
+<!-- Entry for STATEMENT-COLUMN-VALUE -->
+
+<p><br>[Function]<br><a class=none name='statement-column-value'><b>statement-column-value</b> <i>statement column-number</i> =&gt; <i>result</i></a>
+<blockquote><br>
+
+Returns the <i>column-number</i>-th column&#039;s value of the current row of the <i>statement</i>. Columns are numbered from zero.<br>
+Returns:<br>
+<ul>
+<li>NIL for NULL
+<li>integer for integers
+<li>double-float for floats
+<li>string for text
+<li>(simple-array (unsigned-byte 8)) for BLOBs
+</ul>
+</blockquote>
+
+<!-- End of entry for STATEMENT-COLUMN-VALUE -->
+
+
+<!-- Entry for STEP-STATEMENT -->
+
+<p><br>[Function]<br><a class=none name='step-statement'><b>step-statement</b> <i>statement</i> =&gt; <i>boolean</i></a>
+<blockquote><br>
+
+Steps to the next row of the resultset of <i>statement</i>.<br>
+Returns T is successfully advanced to the next row and NIL if there are no more rows.
+
+</blockquote>
+
+<!-- End of entry for STEP-STATEMENT -->
+
+
+<!-- Entry for WITH-TRANSACTION -->
+
+<p><br>[Macro]<br><a class=none name='with-transaction'><b>with-transaction</b> <i>db</i> <tt>&amp;body</tt> <i>body</i></i></a>
+<blockquote><br>
+
+Wraps the <i>body</i> inside the transaction.
+
+</blockquote>
+
+<!-- End of entry for WITH-TRANSACTION -->
+
+<br>&nbsp;<br><h3><a class=none name="support">Support</a></h3>
+
+This package is written by <a href="mailto:Kalyanov.Dmitry@gmail.com">Kalyanov Dmitry</a>.<br>
+
+This project has a <a href="http://common-lisp.net/mailman/listinfo/cl-sqlite-devel">cl-sqlite-devel</a> mailing list.<br>
+
+<br>&nbsp;<br><h3><a class=none name="ack">Acknowledgements</a></h3>
+
+<p>
+This documentation was prepared with <a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>.
+</p>
+<p>
+$Header: /usr/local/cvsrep/documentation-template/output.lisp,v 1.14 2008/05/29 08:23:37 edi Exp $
+
+</body>
+</html>
194 sqlite-ffi.lisp
@@ -0,0 +1,194 @@
+(defpackage :sqlite-ffi
+ (:use :cl :cffi)
+ (:export :error-code
+ :p-sqlite3
+ :sqlite3-open
+ :sqlite3-close
+ :sqlite3-errmsg
+ :p-sqlite3-stmt
+ :sqlite3-prepare
+ :sqlite3-finalize
+ :sqlite3-step
+ :sqlite3-reset
+ :sqlite3-clear-bindings
+ :sqlite3-column-count
+ :sqlite3-column-type
+ :sqlite3-column-text
+ :sqlite3-column-int64
+ :sqlite3-column-double
+ :sqlite3-column-bytes
+ :sqlite3-column-blob
+ :sqlite3-column-name
+ :sqlite3-bind-parameter-count
+ :sqlite3-bind-parameter-name
+ :sqlite3-bind-parameter-index
+ :sqlite3-bind-double
+ :sqlite3-bind-int64
+ :sqlite3-bind-null
+ :sqlite3-bind-text
+ :sqlite3-bind-blob
+ :destructor-transient
+ :destructor-static
+ :sqlite3-last-insert-rowid))
+
+(in-package :sqlite-ffi)
+
+(define-foreign-library sqlite3-lib
+ (:unix (:or "libsqlite3.so.0" "libsqlite3.so"))
+ (t (:default "libsqlite3")))
+
+(use-foreign-library sqlite3-lib)
+
+(defcenum error-code
+ (:OK 0)
+ (:ERROR 1)
+ (:INTERNAL 2)
+ (:PERM 3)
+ (:ABORT 4)
+ (:BUSY 5)
+ (:LOCKED 6)
+ (:NOMEM 7)
+ (:READONLY 8)
+ (:INTERRUPT 9)
+ (:IOERR 10)
+ (:CORRUPT 11)
+ (:NOTFOUND 12)
+ (:FULL 13)
+ (:CANTOPEN 14)
+ (:PROTOCOL 15)
+ (:EMPTY 16)
+ (:SCHEMA 17)
+ (:TOOBIG 18)
+ (:CONSTRAINT 19)
+ (:MISMATCH 20)
+ (:MISUSE 21)
+ (:NOLFS 22)
+ (:AUTH 23)
+ (:FORMAT 24)
+ (:RANGE 25)
+ (:NOTADB 26)
+ (:ROW 100)
+ (:DONE 101))
+
+(defcstruct sqlite3)
+
+(defctype p-sqlite3 (:pointer sqlite3))
+
+(defcfun sqlite3-open error-code
+ (filename :string)
+ (db (:pointer p-sqlite3)))
+
+(defcfun sqlite3-close error-code
+ (db p-sqlite3))
+
+(defcfun sqlite3-errmsg :string
+ (db p-sqlite3))
+
+(defcstruct sqlite3-stmt)
+
+(defctype p-sqlite3-stmt (:pointer sqlite3-stmt))
+
+(defcfun (sqlite3-prepare "sqlite3_prepare_v2") error-code
+ (db p-sqlite3)
+ (sql :string)
+ (sql-length-bytes :int)
+ (stmt (:pointer p-sqlite3-stmt))
+ (tail (:pointer (:pointer :char))))
+
+(defcfun sqlite3-finalize error-code
+ (statement p-sqlite3-stmt))
+
+(defcfun sqlite3-step error-code
+ (statement p-sqlite3-stmt))
+
+(defcfun sqlite3-reset error-code
+ (statement p-sqlite3-stmt))
+
+(defcfun sqlite3-clear-bindings error-code
+ (statement p-sqlite3-stmt))
+
+(defcfun sqlite3-column-count :int
+ (statement p-sqlite3-stmt))
+
+(defcenum type-code
+ (:integer 1)
+ (:float 2)
+ (:text 3)
+ (:blob 4)
+ (:null 5))
+
+(defcfun sqlite3-column-type type-code
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-text :string
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-int64 :int64
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-double :double
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-bytes :int
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-blob :pointer
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-column-name :string
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-bind-parameter-count :int
+ (statement p-sqlite3-stmt))
+
+(defcfun sqlite3-bind-parameter-name :string
+ (statement p-sqlite3-stmt)
+ (column-number :int))
+
+(defcfun sqlite3-bind-parameter-index :int
+ (statement p-sqlite3-stmt)
+ (name :string))
+
+(defcfun sqlite3-bind-double error-code
+ (statement p-sqlite3-stmt)
+ (parameter-index :int)
+ (value :double))
+
+(defcfun sqlite3-bind-int64 error-code
+ (statement p-sqlite3-stmt)
+ (parameter-index :int)
+ (value :int64))
+
+(defcfun sqlite3-bind-null error-code
+ (statement p-sqlite3-stmt)
+ (parameter-index :int))
+
+(defcfun sqlite3-bind-text error-code
+ (statement p-sqlite3-stmt)
+ (parameter-index :int)
+ (value :string)
+ (octets-count :int)
+ (destructor :pointer))
+
+(defcfun sqlite3-bind-blob error-code
+ (statement p-sqlite3-stmt)
+ (parameter-index :int)
+ (value :pointer)
+ (bytes-count :int)
+ (destructor :pointer))
+
+(defconstant destructor-transient-address (mod -1 (expt 2 (* 8 (cffi:foreign-type-size :pointer)))))
+
+(defun destructor-transient () (cffi:make-pointer destructor-transient-address))
+
+(defun destructor-static () (cffi:make-pointer 0))
+
+(defcfun sqlite3-last-insert-rowid :int64
+ (db p-sqlite3))
9 sqlite.asd
@@ -0,0 +1,9 @@
+(defsystem :sqlite
+ :name "sqlite"
+ :author "Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>"
+ :version "0.1"
+ :license "Public Domain"
+ :components ((:file "sqlite-ffi")
+ (:file "cache")
+ (:file "sqlite" :depends-on ("sqlite-ffi" "cache")))
+ :depends-on (:iterate :cffi))
326 sqlite.lisp
@@ -0,0 +1,326 @@
+(defpackage :sqlite
+ (:use :cl :iter)
+ (:export :sqlite-handle
+ :connect
+ :disconnect
+ :sqlite-statement
+ :prepare-statement
+ :finalize-statement
+ :step-statement
+ :reset-statement
+ :statement-column-value
+ :bind-parameter
+ :execute-non-query
+ :execute-to-list
+ :execute-single
+ :execute-one-row-m-v
+ :last-insert-rowid
+ :with-transaction))
+
+(in-package :sqlite)
+
+;(declaim (optimize (speed 3) (safety 0) (debug 0)))
+
+(defclass sqlite-handle ()
+ ((handle :accessor handle)
+ (database-path :accessor database-path)
+ (cache :accessor cache))
+ (:documentation "Class that encapsulates the connection to the database. Use connect and disconnect."))
+
+(defmethod initialize-instance :after ((object sqlite-handle) &key (database-path ":memory:") &allow-other-keys)
+ (cffi:with-foreign-object (ppdb 'sqlite-ffi:p-sqlite3)
+ (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb)))
+ (if (eq error-code :ok)
+ (setf (handle object) (cffi:mem-ref ppdb 'sqlite-ffi:p-sqlite3)
+ (database-path object) database-path)
+ (error "Received error code ~A when trying to open sqlite3 database ~A"
+ error-code database-path))))
+ (setf (cache object) (make-instance 'sqlite.cache:mru-cache :cache-size 16 :destructor #'really-finalize-statement)))
+
+(defun connect (database-path)
+ "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect."
+ (make-instance 'sqlite-handle :database-path database-path))
+
+(defun disconnect (handle)
+ "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
+ (sqlite.cache:purge-cache (cache handle))
+ (cond
+ ((typep handle 'sqlite-handle) (let ((error-code (sqlite-ffi:sqlite3-close (handle handle))))
+ (unless (eq error-code :ok)
+ (error "Received error code ~A when trying to close ~A (connected to ~A)" error-code handle (database-path handle)))))
+ ((cffi:pointerp handle) (let ((error-code (sqlite-ffi:sqlite3-close handle)))
+ (unless (eq error-code :ok)
+ (error "Received error code ~A when trying to close ~A" error-code handle))))))
+
+(defclass sqlite-statement ()
+ ((db :reader db :initarg :db)
+ (handle :accessor handle)
+ (sql :reader sql :initarg :sql)
+ (columns-count :accessor resultset-columns-count)
+ (columns-names :accessor resultset-columns-names)
+ (parameters-count :accessor parameters-count)
+ (parameters-names :accessor parameters-names))
+ (:documentation "Class that represents the prepared statement."))
+
+(defmethod initialize-instance :after ((object sqlite-statement) &key &allow-other-keys)
+ (cffi:with-foreign-object (p-statement 'sqlite-ffi:p-sqlite3-stmt)
+ (cffi:with-foreign-object (p-tail '(:pointer :char))
+ (cffi:with-foreign-string (sql (sql object))
+ (let ((error-code (sqlite-ffi:sqlite3-prepare (handle (db object)) sql -1 p-statement p-tail)))
+ (unless (eq error-code :ok)
+ (error "Error when trying to prepare sqlite statement '~A'. Code: ~A, message: ~A" (sql object) error-code (sqlite-ffi:sqlite3-errmsg (handle (db object)))))
+ (unless (zerop (cffi:mem-ref (cffi:mem-ref p-tail '(:pointer :char)) :uchar))
+ (error "SQL string '~A' contains more than one SQL statements" (sql object)))
+ (setf (handle object) (cffi:mem-ref p-statement 'sqlite-ffi:p-sqlite3-stmt)
+ (resultset-columns-count object) (sqlite-ffi:sqlite3-column-count (handle object))
+ (resultset-columns-names object) (loop
+ for i below (resultset-columns-count object)
+ collect (sqlite-ffi:sqlite3-column-name (handle object) i))
+ (parameters-count object) (sqlite-ffi:sqlite3-bind-parameter-count (handle object))
+ (parameters-names object) (loop
+ for i from 1 to (parameters-count object)
+ collect (sqlite-ffi:sqlite3-bind-parameter-name (handle object) i))))))))
+
+(defun prepare-statement (db sql)
+ "Prepare the statement to the DB that will execute the commands that are in SQL.
+
+Returns the SQLITE-STATEMENT.
+
+SQL must contain exactly one statement.
+SQL may have some positional (not named) parameters specified with question marks.
+
+Example:
+
+ select name from users where id = ?"
+ #+nil(make-instance 'sqlite-statement :db db :sql sql)
+ (or (sqlite.cache:get-from-cache (cache db) sql)
+ (make-instance 'sqlite-statement :db db :sql sql)))
+
+(defun really-finalize-statement (statement)
+ (sqlite-ffi:sqlite3-finalize (handle statement)))
+
+(defun finalize-statement (statement)
+ "Finalizes the statement and signals that associated resources may be released.
+Note: does not immediately release resources because statements are cached."
+ #+nil(really-finalize-statement statement)
+ (progn
+ (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement))))
+ (unless (eq error-code :ok)
+ (error "When resetting statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))
+ #+nil(let ((error-code (sqlite-ffi:sqlite3-clear-bindings (handle statement))))
+ (unless (eq error-code :ok)
+ (error "When resetting statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))
+ (sqlite.cache:put-to-cache (cache (db statement)) (sql statement) statement)))
+
+(defun step-statement (statement)
+ "Steps to the next row of the resultset of STATEMENT.
+Returns T is successfully advanced to the next row and NIL if there are no more rows."
+ (let ((error-code (sqlite-ffi:sqlite3-step (handle statement))))
+ (case error-code
+ (:done nil)
+ (:row t)
+ (t (error "When stepping statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))))
+
+(defun reset-statement (statement)
+ "Resets the STATEMENT and prepare it to be called again."
+ (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement))))
+ (unless (eq error-code :ok)
+ (error "When resetting statment ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement)))))))
+
+(defun statement-column-value (statement column-number)
+ "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
+Returns:
+ * NIL for NULL
+ * INTEGER for integers
+ * DOUBLE-FLOAT for floats
+ * STRING for text
+ * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
+ (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number)))
+ (ecase type
+ (:null nil)
+ (:text (sqlite-ffi:sqlite3-column-text (handle statement) column-number))
+ (:integer (sqlite-ffi:sqlite3-column-int64 (handle statement) column-number))
+ (:float (sqlite-ffi:sqlite3-column-double (handle statement) column-number))
+ (:blob (let* ((blob-length (sqlite-ffi:sqlite3-column-bytes (handle statement) column-number))
+ (result (make-array (the fixnum blob-length) :element-type '(unsigned-byte 8)))
+ (blob (sqlite-ffi:sqlite3-column-blob (handle statement) column-number)))
+ (loop
+ for i below blob-length
+ do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i)))
+ result)))))
+
+(defun execute-non-query (db sql &rest parameters)
+ "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
+
+Example:
+
+(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
+
+See BIND-PARAMETER for the list of supported parameter types."
+ (declare (dynamic-extent parameters))
+ (let ((stmt (prepare-statement db sql)))
+ (iter (for i from 1)
+ (declare (type fixnum i))
+ (for value in parameters)
+ (bind-parameter stmt i value))
+ (step-statement stmt)
+ (finalize-statement stmt)
+ (values)))
+
+(defun execute-to-list (db sql &rest parameters)
+ "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
+
+Example:
+
+(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
+=>
+((1 \"joe\" \"Joe the User\")
+ (2 \"joe\" \"Another Joe\"))
+
+See BIND-PARAMETER for the list of supported parameter types."
+ (declare (dynamic-extent parameters))
+ (let ((stmt (prepare-statement db sql))
+ result)
+ (iter (for i from 1)
+ (declare (type fixnum i))
+ (for value in parameters)
+ (bind-parameter stmt i value))
+ (loop (if (step-statement stmt)
+ (push (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))))
+ (declare (type fixnum i))
+ (collect (statement-column-value stmt i)))
+ result)
+ (return)))
+ (finalize-statement stmt)
+ (nreverse result)))
+
+(defun execute-one-row-m-v (db sql &rest parameters)
+ "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
+
+Example:
+(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
+=>
+(values 1 \"joe\" \"Joe the User\")
+
+See BIND-PARAMETER for the list of supported parameter types."
+ (let ((stmt (prepare-statement db sql)))
+ (unwind-protect
+ (progn
+ (iter (for i from 1)
+ (declare (type fixnum i))
+ (for value in parameters)
+ (bind-parameter stmt i value))
+ (if (step-statement stmt)
+ (return-from execute-one-row-m-v
+ (values-list (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))))
+ (declare (type fixnum i))
+ (collect (statement-column-value stmt i)))))
+ (return-from execute-one-row-m-v
+ (values-list (loop repeat (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))) collect nil)))))
+ (finalize-statement stmt))))
+
+(defun statement-parameter-index (statement parameter-name)
+ (sqlite-ffi:sqlite3-bind-parameter-index (handle statement) parameter-name))
+
+(defun bind-parameter (statement parameter value)
+ "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
+Parameters are numbered from one.
+Supported types:
+ * NULL. Passed as NULL
+ * INTEGER. Passed as an 64-bit integer
+ * STRING. Passed as a string
+ * FLOAT. Passed as a double
+ * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
+ (let ((index (etypecase parameter
+ (integer parameter)
+ (string (statement-parameter-index statement parameter)))))
+ (declare (type fixnum index))
+ (let ((error-code (typecase value
+ (null (sqlite-ffi:sqlite3-bind-null (handle statement) index))
+ (integer (sqlite-ffi:sqlite3-bind-int64 (handle statement) index value))
+ (single-float (sqlite-ffi:sqlite3-bind-double (handle statement) index (coerce value 'double-float)))
+ (double-float (sqlite-ffi:sqlite3-bind-double (handle statement) index value))
+ (string (sqlite-ffi:sqlite3-bind-text (handle statement) index value -1 (sqlite-ffi:destructor-transient)))
+ ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data (ptr value)
+ (sqlite-ffi:sqlite3-bind-blob (handle statement) index ptr (length value) (sqlite-ffi:destructor-transient))))
+ (vector (cffi:with-foreign-object (array :unsigned-char (length value))
+ (loop
+ for i from 0 below (length value)
+ do (setf (cffi:mem-aref array :unsigned-char i) (aref value i)))
+ (sqlite-ffi:sqlite3-bind-blob (handle statement) index array (length value) (sqlite-ffi:destructor-transient))))
+ (t (error "Do not know how to pass value ~A of type ~A to sqlite" value (type-of value))))))
+ (unless (eq error-code :ok)
+ (error "When binding parameter ~A to value ~A for statment ~A (sql: ~A), error ~A (~A)" parameter value statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))))
+
+(defun execute-single (db sql &rest parameters)
+ "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
+
+Example:
+(execute-single db \"select user_name from users where id = ?\" 1)
+=>
+\"joe\"
+
+See BIND-PARAMETER for the list of supported parameter types."
+ (declare (dynamic-extent parameters))
+ (let ((stmt (prepare-statement db sql)))
+ (unwind-protect
+ (progn
+ (iter (for i from 1)
+ (declare (type fixnum i))
+ (for value in parameters)
+ (bind-parameter stmt i value))
+ (if (step-statement stmt)
+ (statement-column-value stmt 0)
+ nil))
+ (finalize-statement stmt))))
+
+(defun last-insert-rowid (db)
+ "Returns the auto-generated ID of the last inserted row on the database connection DB."
+ (sqlite-ffi:sqlite3-last-insert-rowid (handle db)))
+
+(defmacro with-transaction (db &body body)
+ "Wraps the BODY inside the transaction."
+ (let ((ok (gensym "TRANSACTION-COMMIT-"))
+ (db-var (gensym "DB-"))
+ (result (gensym "RESULT-")))
+ `(let (,ok
+ (,db-var ,db))
+ (execute-non-query ,db-var "begin transaction")
+ (unwind-protect
+ (progn
+ (let ((,result (progn
+ ,@body)))
+ (setf ,ok t)
+ ,result))
+ (if ,ok
+ (execute-non-query ,db-var "commit transaction")
+ (execute-non-query ,db-var "rollback transaction"))))))
+
+(defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters)
+ (let ((statement (gensym "STATEMENT-"))
+ (kwd (if generate 'generate 'for)))
+ `(progn (with ,statement = (prepare-statement ,db ,query-expression))
+ (finally-protected (when ,statement (finalize-statement ,statement)))
+ ,@(when parameters
+ (list `(initially ,@(iter (for i from 1)
+ (for value in parameters)
+ (collect `(sqlite:bind-parameter ,statement ,i ,value))))))
+ (,kwd ,(if (symbolp vars)
+ `(values ,vars)
+ `(values ,@vars))
+ next (progn (if (step-statement ,statement)
+ (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
+ (collect `(statement-column-value ,statement ,i))))
+ (terminate)))))))
+
+(defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement)
+ (let ((statement-var (gensym "STATEMENT-"))
+ (kwd (if generate 'generate 'for)))
+ `(progn (with ,statement-var = ,statement)
+ (,kwd ,(if (symbolp vars)
+ `(values ,vars)
+ `(values ,@vars))
+ next (progn (if (step-statement ,statement-var)
+ (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
+ (collect `(statement-column-value ,statement-var ,i))))
+ (terminate)))))))
54 style.css
@@ -0,0 +1,54 @@
+
+.header {
+ font-size: medium;
+ background-color:#336699;
+ color:#ffffff;
+ border-style:solid;
+ border-width: 5px;
+ border-color:#002244;
+ padding: 1mm 1mm 1mm 5mm;
+}
+
+.footer {
+ font-size: small;
+ font-style: italic;
+ text-align: right;
+ background-color:#336699;
+ color:#ffffff;
+ border-style:solid;
+ border-width: 2px;
+ border-color:#002244;
+ padding: 1mm 1mm 1mm 1mm;
+}
+
+.footer a:link {
+ font-weight:bold;
+ color:#ffffff;
+ text-decoration:underline;
+}
+
+.footer a:visited {
+ font-weight:bold;
+ color:#ffffff;
+ text-decoration:underline;
+}
+
+.footer a:hover {
+ font-weight:bold;
+ color:#002244;
+ text-decoration:underline; }
+
+.check {font-size: x-small;
+ text-align:right;}
+
+.check a:link { font-weight:bold;
+ color:#a0a0ff;
+ text-decoration:underline; }
+
+.check a:visited { font-weight:bold;
+ color:#a0a0ff;
+ text-decoration:underline; }
+
+.check a:hover { font-weight:bold;
+ color:#000000;
+ text-decoration:underline; }

0 comments on commit f3c5604

Please sign in to comment.
Something went wrong with that request. Please try again.