ADDED   autoload/autoload.meta
Index: autoload/autoload.meta
==================================================================
--- /dev/null
+++ autoload/autoload.meta
@@ -0,0 +1,9 @@
+;;; autoload.meta -*- Hen -*-
+
+((egg "autoload.egg")
+ (synopsis "Load modules lazily")
+ (category lang-exts)
+ (license "BSD")
+ (author "Alex Shinn")
+ (doc-from-wiki)
+ (files "autoload.meta" "autoload.scm" "autoload.release-info" "autoload.setup"))

ADDED   autoload/autoload.scm
Index: autoload/autoload.scm
==================================================================
--- /dev/null
+++ autoload/autoload.scm
@@ -0,0 +1,93 @@
+;;;; autoload.scm -- load modules lazily
+;;
+;; Copyright (c) 2005-2009 Alex Shinn
+;; All rights reserved.
+;;
+;; BSD-style license: http://www.debian.org/misc/bsd.license
+
+;; Provides an Emacs-style autoload facility which takes the basic form
+;;
+;;   (autoload unit procedure-name ...)
+;;
+;; such that the first time procedure-name is called, it will perform a
+;; runtime require of 'unit and then apply the procedure from the newly
+;; loaded unit to the args it was passed.  Subsequent calls to
+;; procedure-name will thereafter refer to the new procedure and will
+;; thus not incur any overhead.
+;;
+;; You may also specify an alias for the procedure, and a default
+;; procedure if the library can't be loaded:
+;;
+;;   (autoload unit (name alias default) ...)
+;;
+;; In this case, although the procedure name from the unit is "name,"
+;; the form defines the autoload procedure as "alias."
+;;
+;; If the library can't be loaded then an error is signalled, unless
+;; default is given, in which case the values are passed to that.
+;;
+;; Examples:
+;;
+;; ;; load iconv procedures lazily
+;; (autoload iconv iconv iconv-open)
+;;
+;; ;; load some sqlite procedures lazily with "-" names
+;; (autoload sqlite (sqlite:open sqlite-open)
+;;                  (sqlite:execute sqlite-execute))
+;;
+;; ;; load md5 library, falling back on slower scheme version
+;; (autoload scheme-md5 (md5:digest scheme-md5:digest))
+;; (autoload md5 (md5:digest #f scheme-md5:digest))
+
+(module autoload (autoload)
+
+(import scheme chicken)
+
+(define-syntax autoload
+  (er-macro-transformer
+   (lambda (expr rename compare)
+     (let ((module (cadr expr))
+           (procs (cddr expr))
+           (_import (rename 'import))
+           (_define (rename 'define))
+           (_let (rename 'let))
+           (_set! (rename 'set!))
+           (_begin (rename 'begin))
+           (_apply (rename 'apply))
+           (_args (rename 'args))
+           (_tmp (rename 'tmp))
+           (_eval (rename 'eval))
+           (_condition-case (rename 'condition-case)))
+       `(,_begin
+         ,@(map
+            (lambda (x)
+              (let* ((x (if (pair? x) x (list x)))
+                     (name (car x))
+                     (full-name
+                      (string->symbol
+                       (string-append (symbol->string module) "#"
+                                      (symbol->string name))))
+                     (alias (or (and (pair? (cdr x)) (cadr x)) name))
+                     (default (and (pair? (cdr x)) (pair? (cddr x)) (caddr x))))
+                (if default
+                    `(,_define (,alias . ,_args)
+                       (,_let ((,_tmp (,_condition-case
+                                       (,_begin
+                                        (,_eval
+                                         (begin (require-library ,module)
+                                                #f))
+                                        (,_eval ',full-name))
+                                        (exn () ,default))))
+                           (,_set! ,alias ,_tmp)
+                           (,_apply ,_tmp ,_args)))
+                    `(,_define (,alias . ,_args)
+                       (,_let ((,_tmp (,_begin
+                                        (,_eval
+                                         (begin (require-library ,module)
+                                                 #f))
+                                        (,_eval ',full-name))))
+                         (,_set! ,alias ,_tmp)
+                         (,_apply ,_tmp ,_args))))))
+            procs))))))
+
+)

ADDED   autoload/autoload.setup
Index: autoload/autoload.setup
==================================================================
--- /dev/null
+++ autoload/autoload.setup
@@ -0,0 +1,7 @@
+
+(compile -s -O2 -j autoload autoload.scm)
+(compile -s -O2 autoload.import.scm)
+
+(install-extension 
+ 'autoload '("autoload.so" "autoload.import.so") 
+ '((version 3.0) (syntax)))

ADDED   dbi/dbi.meta
Index: dbi/dbi.meta
==================================================================
--- /dev/null
+++ dbi/dbi.meta
@@ -0,0 +1,21 @@
+;; -*- scheme -*-
+(
+; Your egg's license:
+(license "BSD")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category db)
+
+; A list of eggs dbi depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs (autoload "3.0") sql-null)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "An abstract database interface."))

ADDED   dbi/dbi.release-info
Index: dbi/dbi.release-info
==================================================================
--- /dev/null
+++ dbi/dbi.release-info
@@ -0,0 +1,7 @@
+(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
+(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
+(release "0.5")
+(release "0.4")
+(release "0.3")
+(release "0.2")
+(release "0.1")

ADDED   dbi/dbi.scm
Index: dbi/dbi.scm
==================================================================
--- /dev/null
+++ dbi/dbi.scm
@@ -0,0 +1,483 @@
+;;; dbi: Minimal gasket to postgresql, sqlite3 and mysql
+;;;
+;; Copyright (C) 2007-2018 Matt Welland
+;; Copyright (C) 2016 Peter Bex
+;; Redistribution and use in source and binary forms, with or without
+;; modification, is permitted.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+;; DAMAGE.
+
+;; ONLY A LOWEST COMMON DEMOMINATOR IS SUPPORTED!
+
+;; d = db handle
+;; t = statement handle
+;; s = statement
+;; l = proc
+;; p = params
+;;
+;;          sqlite3                    postgres                   dbi
+;; prepare: (prepare d s)              n/a                        prepare (sqlite3, pg)
+;; for-each (for-each-row l d s . p)   (query-for-each l s d)     for-each-row
+;; for-each (for-each-row l t . p)     n/a                        NOT YET
+;; exec     (exec d s . p)             (query-tuples s d)      
+;; exec     (exec t . p)               n/a
+
+;; set to 'pg or 'sqlite3
+;; (define dbi:type 'sqlite3) ;; or 'pg
+;;  (dbi:open 'sqlite3 (list (cons 'dbname fullname)))
+
+;;======================================================================
+;; D B I
+;;======================================================================
+(module dbi
+    (open db-dbtype db-conn for-each-row get-one get-one-row get-rows
+     exec close escape-string mk-db now database? with-transaction fold-row
+     prepare map-row convert prepare-exec get-res
+
+     ;; TODO: These don't really belong here.  Also, the naming is not
+     ;; consistent with the usual Scheme conventions.
+     pgdatetime-get-year pgdatetime-get-month pgdatetime-get-day
+     pgdatetime-get-hour pgdatetime-get-minute pgdatetime-get-second
+     pgdatetime-get-microsecond
+     pgdatetime-set-year! pgdatetime-set-month! pgdatetime-set-day!
+     pgdatetime-set-hour! pgdatetime-set-minute! pgdatetime-set-second!
+     pgdatetime-set-microsecond!
+
+     lazy-bool)
+
+(import chicken scheme srfi-1 srfi-13)
+(use posix extras data-structures autoload sql-null)
+
+(define-record-type db
+  (make-db dbtype dbconn)
+  db?
+  (dbtype db-dbtype  db-dbtype-set!)
+  (dbconn db-conn    db-conn-set!))
+
+(define (missing-egg type eggname)
+  (lambda _
+    (error (printf
+               "Cannot access ~A databases.  Please install the ~S egg and try again." type eggname))))
+
+;; (define (sqlite3:statement? h) #f) ;; dummy - hope it gets clobbered if sqlite3 gets loaded
+
+;; TODO: Make a convenience macro for this?
+(define sqlite3-missing (missing-egg 'sqlite3 "sqlite3"))
+(autoload sqlite3
+          (open-database sqlite3:open-database sqlite3-missing)
+          (for-each-row sqlite3:for-each-row sqlite3-missing)
+          (execute sqlite3:execute sqlite3-missing)
+          (with-transaction sqlite3:with-transaction sqlite3-missing)
+          (finalize! sqlite3:finalize! sqlite3-missing)
+          (make-busy-timeout sqlite3:make-busy-timeout sqlite3-missing)
+          (set-busy-handler! sqlite3:set-busy-handler! sqlite3-missing)
+          (database? sqlite3:database? sqlite3-missing)
+          (prepare sqlite3:prepare sqlite3-missing)
+          (fold-row sqlite3:fold-row sqlite3-missing)
+          (map-row sqlite3:map-row sqlite3-missing)
+          (statement? sqlite3:statement? sqlite3-missing))
+
+(define sql-de-lite-missing (missing-egg 'sql-de-lite "sql-de-lite"))
+(autoload sql-de-lite
+          (open-database     sql:open-database     sql-de-lite-missing)
+	  (close-database    sql:close-database    sql-de-lite-missing)
+          (for-each-row      sql:for-each-row      sql-de-lite-missing)
+	  (fold-rows         sql:fold-rows         sql-de-lite-missing)
+          (exec              sql:exec              sql-de-lite-missing)
+	  (fetch-value       sql:fetch-value       sql-de-lite-missing)
+	  (with-transaction  sql:with-transaction  sql-de-lite-missing)
+          (finalize!         sql:finalize!         sql-de-lite-missing)
+          (make-busy-timeout sql:make-busy-timeout sql-de-lite-missing)
+          (set-busy-handler! sql:set-busy-handler! sql-de-lite-missing)
+	  (query             sql:query             sql-de-lite-missing)
+	  (sql               sql:sql               sql-de-lite-missing))
+
+(define pg-missing (missing-egg 'pg "postgresql"))
+(autoload postgresql
+          (connect pg:connect pg-missing)
+          (row-for-each pg:row-for-each pg-missing)
+          (with-transaction pg:with-transaction pg-missing)
+          (query pg:query pg-missing)
+          ;;(escape-string pg:escape-string pg-missing)
+          (disconnect pg:disconnect pg-missing)
+          (connection? pg:connection? pg-missing)
+          (row-fold pg:row-fold pg-missing)
+          (row-map pg:row-map pg-missing)
+          (affected-rows pg:affected-rows pg-missing)
+          (result? pg:result? pg-missing))
+
+(define mysql-missing (missing-egg 'mysql "mysql-client"))
+(autoload mysql-client 
+  (make-mysql-connection mysql:make-connection mysql-missing)
+  (mysql-null? mysql:mysql-null? mysql-missing))
+
+(define (open dbtype dbinit)
+  (make-db
+   dbtype
+   (case dbtype
+     ((sqlite3)     (sqlite3:open-database (alist-ref 'dbname dbinit)))
+     ((sql-de-lite) (sql:open-database (alist-ref 'dbname dbinit)))
+     ((pg)          (pg:connect dbinit))
+     ((mysql)       (mysql:make-connection (alist-ref 'host dbinit)
+					   (alist-ref 'user dbinit)
+					   (alist-ref 'password dbinit)
+					   (alist-ref 'dbname dbinit)
+					   port: (alist-ref 'port dbinit)))
+     (else (error "Unsupported dbtype " dbtype)))))
+
+(define (convert dbh)
+  (cond
+    ((database? dbh)           dbh) 
+    ((sqlite3:database? dbh)   (make-db 'sqlite3 dbh))
+    ((pg:connection? dbh)      (make-db 'pg dbh))
+    ((not mysql:mysql-null?)   (make-db 'mysql dbh))
+    (else (error "Unsupported database handle " dbh))))
+
+(define (for-each-row proc dbh stmt . params)
+    (let ((dbtype (db-dbtype dbh))
+	  (conn    (db-conn dbh)))
+      (case dbtype
+        ((sqlite3) (sqlite3:for-each-row 
+                    (lambda (first . remaining)
+                      (let ((tuple (list->vector (cons first remaining))))
+                        (proc tuple)))
+                    conn
+                    (apply sqlparam stmt params)))
+	((sql-de-lite)(apply sql:query (sql:for-each-row
+					(lambda (row)
+					  (proc (list->vector row))))
+			     (sql:sql conn stmt)
+			     params))
+        ((pg) (pg:row-for-each
+               (lambda (tuple)
+                 (proc (list->vector tuple)))
+               (pg:query conn (apply sqlparam stmt params))))
+        ((mysql) (let* ((replaced-sql (apply sqlparam stmt params))
+                        (fetcher (conn replaced-sql)))
+                   (fetcher (lambda (tuple)
+                              (proc (list->vector tuple))))))
+        (else (error "Unsupported dbtype " dbtype)))))
+
+;; common idiom is to seek a single value, #f if no match
+;; NOTE: wish to return first found. Do the set only if not set
+(define (get-one dbh stmt . params)
+  (let ((dbtype (db-dbtype dbh))
+	(conn    (db-conn dbh)))
+    (case dbtype
+      ((sql-de-lite)
+       (apply sql:query sql:fetch-value (sql:sql conn stmt) params))
+      (else 
+        (let ((res #f))
+	  (apply for-each-row
+		 (lambda (row)
+		   (if (not res)
+		       (set! res (vector-ref row 0))))
+		 dbh
+		 stmt 
+		 params)
+	  res)))))
+
+;; common idiom is to seek a single value, #f if no match
+;; NOTE: wish to return first found. Do the set only if not set
+(define (get-one-row dbh stmt . params)
+  (let ((res #f))
+    (apply for-each-row
+	   (lambda (row)
+	     (if (not res)
+	         (set! res row)))
+	   dbh
+	   stmt 
+	   params)
+    res))
+
+;; common idiom is to seek a list of rows, '() if no match
+(define (get-rows dbh stmt . params)
+  (let ((res '()))
+    (apply for-each-row
+	   (lambda (row)
+	     (set! res (cons row res)))
+	   dbh
+	   stmt 
+	   params)
+    (reverse res)))
+
+(define (exec dbh stmt . params)
+    (let ((dbtype (db-dbtype dbh))
+      	 (conn   (db-conn dbh))
+      	 (junk   #f))
+          (case dbtype
+            ((sqlite3) (apply sqlite3:execute conn stmt params))
+            ((sql-de-lite)(apply sql:exec (sql:sql conn stmt) params))
+            ((pg) (pg:query conn (apply sqlparam stmt params)))
+            ((mysql) (conn (apply sqlparam stmt params)))
+            (else (error "Unsupported dbtype " dbtype)))))
+
+(define (with-transaction dbh proc)
+  (let ((dbtype (db-dbtype dbh))
+  (conn   (db-conn dbh)))
+    (case dbtype
+      ((sql-de-lite)(sql:with-transaction conn proc))
+      ((sqlite3) (sqlite3:with-transaction
+                  conn
+                  (lambda () (proc))))
+      ((pg) (pg:with-transaction
+             conn (lambda () (proc))))
+      ((mysql) 
+        (conn "START TRANSACTION")
+        (conn proc)
+        (conn "COMMIT"))
+      (else (error "Unsupported dbtype " dbtype)))))
+
+(define (prepare dbh stmt)
+  (let ((dbtype (db-dbtype dbh))
+  (conn   (db-conn dbh)))
+    (case dbtype
+      ((sql-de-lite) dbh) ;; nop?
+      ((sqlite3) (sqlite3:prepare conn stmt))
+      ((pg) (exec dbh stmt) (cons (cons dbh (cadr (string-split stmt))) '()))
+      ((mysql) (print "WIP"))
+      (else (error "Unsupported dbtype" dbtype)))))
+
+(define (fold-row proc init dbh stmt . params) ;; expecting (proc init/prev res)
+  (let ((dbtype (db-dbtype dbh))
+  (conn   (db-conn dbh)))
+    (case dbtype
+      ((sql-de-lite) (apply sql:query (sql:fold-rows proc init)
+			    (sql:sql conn stmt) params))
+      ((sqlite3)     (let ((newproc (lambda (prev . rem)
+				      (proc rem prev))))
+		       (apply sqlite3:fold-row newproc init conn stmt params))) ;; (fold-row PROC INIT DATABASE SQL . PARAMETERS)
+      ((pg)          (pg:row-fold proc init (exec dbh stmt params)))
+      ((mysql)       (fold proc '() (get-rows dbh stmt)))
+      (else          (error "Unsupported dbtype" dbtype)))))
+
+(define (map-row proc init dbh stmt . params)
+  (let ((dbtype (db-dbtype dbh))
+  (conn   (db-conn dbh)))
+    (case dbtype
+      ((sqlite3) (apply sqlite3:map-row proc conn stmt params))
+      ((pg) (pg:row-map proc (exec dbh stmt params)))
+      ((mysql) (map proc (get-rows dbh stmt)))
+      (else (error "Unsupported dbtype" dbtype)))))
+
+(define (prepare-exec stmth . params)
+  (if (sqlite3:statement? stmth)
+        (apply sqlite3:execute stmth params))
+  (if (pair? stmth)
+    (let* ((dbh (car (car stmth)))
+          (dbtype (db-dbtype dbh))
+          (conn   (db-conn dbh))
+          (stmth-name (string->symbol (cdr (car stmth)))))
+        (apply pg:query conn stmth-name params))))
+
+(define (get-res handle option)
+  (if (pg:result? handle)
+      (case option
+        ((affected-rows) (pg:affected-rows handle)))))
+      
+(define (close dbh)
+  (cond
+   ((database? dbh)
+    (let ((dbtype (db-dbtype dbh))
+ 	  (conn   (db-conn dbh)))
+      (case dbtype
+	((sql-de-lite) (sql:close-database conn))
+	((sqlite3)     (sqlite3:finalize! conn)) 
+	((pg)          (pg:disconnect conn))
+	((mysql)       (void)) ; The mysql-client egg doesn't support closing...
+	(else (error "Unsupported dbtype " dbtype)))))
+   ((pair? dbh)
+    (let ((stmt (conc "DEALLOCATE " (cdr (car dbh)) ";")))
+      (exec (car (car dbh)) stmt)))
+   ((sqlite3:statement? dbh) ;; do this last so that *IF* it is a proper dbh it will be closed above and the sqlite3:statement? will not be called
+    (sqlite3:finalize! dbh))
+   
+   ))
+
+;;======================================================================
+;; D B   M I S C
+;;======================================================================
+
+(define (escape-string str)
+      (let ((parts (split-string str "'")))
+	(string-intersperse parts "''")))
+;;      (pg:escape-string val)))
+
+;; convert values to appropriate strings
+;;
+(define (sqlparam-val->string val)
+  (cond
+   ((list?   val)(string-intersperse (map conc val) ",")) ;; (a b c) => a,b,c
+   ((string? val)(string-append "'" (escape-string val) "'"))
+   ((sql-null? val) "NULL")
+   ((number? val)(number->string val))
+   ((symbol? val)(sqlparam-val->string (symbol->string val)))
+   ((boolean? val)
+    (if val "TRUE" "FALSE"))  ;; should this be "TRUE" or 1?
+                              ;; should this be "FALSE" or 0 or NULL?
+   ((vector? val) ;; 'tis a date NB// 5/29/2011 - this is badly borked BUGGY!
+    (sqlparam-val->string (time->string (seconds->local-time (current-seconds)))))
+   (else
+    (error "sqlparam: unknown type for value: " val)
+    "")))
+
+;; (sqlparam "INSERT INTO foo(name,age) VALUES(?,?);" "bob" 20)
+;; NB// 1. values only!! 
+;;      2. terminating semicolon required (used as part of logic)
+;;
+;; a=? 1 (number) => a=1
+;; a=? 1 (string) => a='1'
+;; a=? #f         => a=FALSE 
+;; a=? a (symbol) => a=a 
+;;
+(define (sqlparam query . args)
+  (let* ((query-parts (string-split query "?"))
+         (num-parts    (length query-parts))
+         (num-args    (length args)))
+    (if (not (= (+ num-args 1) num-parts))
+        (error "ERROR, sqlparam: wrong number of arguments or missing semicolon, " num-args " for query " query)
+        (if (= num-args 0) query
+            (let loop ((section (car query-parts))
+                       (tail    (cdr query-parts))
+                       (result  "")
+                       (arg     (car args))
+                       (argtail (cdr args)))
+              (let* ((valstr    (sqlparam-val->string arg))
+                     (newresult (string-append result section valstr)))
+                (if (null? argtail) ;; we are done
+                    (string-append newresult (car tail))
+                    (loop
+                     (car tail)
+                     (cdr tail)
+                     newresult
+                     (car argtail)
+                     (cdr argtail)))))))))
+
+;; a poorly written but non-broken split-string
+;;
+(define (split-string strng delim)
+  (if (eq? (string-length strng) 0) (list strng)
+      (let loop ((head (make-string 1 (car (string->list strng))))
+		 (tail (cdr (string->list strng)))
+		 (dest '())
+		 (temp ""))
+	(cond ((equal? head delim)
+	       (set! dest (append dest (list temp)))
+	       (set! temp ""))
+	      ((null? head) 
+	       (set! dest (append dest (list temp))))
+	      (else (set! temp (string-append temp head)))) ;; end if
+	(cond ((null? tail)
+	       (set! dest (append dest (list temp))) dest)
+	      (else (loop (make-string 1 (car tail)) (cdr tail) dest temp))))))
+
+(define (database? dbh)
+  (if (db? dbh)
+    (let ((dbtype (db-dbtype dbh))
+    (conn   (db-conn dbh)))
+      (case dbtype
+        ((sqlite3)     (if (sqlite3:database? conn) #t #f))
+	((sql-de-lite) #t) ;; don't know how to test for database
+        ((pg) (if (pg:connection? conn) #t #f))
+        ((mysql) #t)
+        (else (error "Unsupported dbtype " dbtype)))) #f))
+
+;;======================================================================
+;; Convienence routines
+;;======================================================================
+
+;; make a db from a list of statements or open it if it already exists
+(define (mk-db path file stmts)
+  (let* ((fname    (conc path "/" file))
+	 (dbexists (file-exists? fname))
+	 (dbh      (if dbexists (open 'sqlite3 (list (cons 'dbname fname))) #f)))
+    (if (not dbexists)
+	(begin
+	  (system (conc "mkdir -p " path)) ;; create the path
+	  (set! dbh (open 'sqlite3 (list (cons 'dbname fname))))
+	  (for-each 
+	   (lambda (sqry)
+	     (exec dbh sqry))
+	   stmts)))
+    (sqlite3:set-busy-handler!
+     (db-conn dbh) (sqlite3:make-busy-timeout 1000000))
+    dbh))
+
+(define (now dbh)
+  (let ((dbtype (db-dbtype dbh)))
+    (case dbtype
+      ((sqlite3) "datetime('now')")
+      ;; Standard SQL
+      (else      "now()"))))
+
+(define (make-pgdatetime)(make-vector 7))
+(define (pgdatetime-get-year          vec)    (vector-ref  vec 0))
+(define (pgdatetime-get-month         vec)    (vector-ref  vec 1))
+(define (pgdatetime-get-day           vec)    (vector-ref  vec 2))
+(define (pgdatetime-get-hour          vec)    (vector-ref  vec 3))
+(define (pgdatetime-get-minute        vec)    (vector-ref  vec 4))
+(define (pgdatetime-get-second        vec)    (vector-ref  vec 5))
+(define (pgdatetime-get-microsecond   vec)    (vector-ref  vec 6))
+(define (pgdatetime-set-year!         vec val)(vector-set! vec 0 val))
+(define (pgdatetime-set-month!        vec val)(vector-set! vec 1 val))
+(define (pgdatetime-set-day!          vec val)(vector-set! vec 2 val))
+(define (pgdatetime-set-hour!         vec val)(vector-set! vec 3 val))
+(define (pgdatetime-set-minute!       vec val)(vector-set! vec 4 val))
+(define (pgdatetime-set-second!       vec val)(vector-set! vec 5 val))
+(define (pgdatetime-set-microsecond!  vec val)(vector-set! vec 6 val))
+
+;; takes postgres date or timestamp
+(define (pg-date->string pgdate)
+  (conc (pgdatetime-get-month pgdate) "/"
+	(pgdatetime-get-day   pgdate) "/"
+	(pgdatetime-get-year  pgdate)))
+
+;; takes postgres date or timestamp
+(define (pg-datetime->string pgdate)
+  (conc (pgdatetime-get-month pgdate) "/"
+        (pgdatetime-get-day   pgdate) "/"
+        (pgdatetime-get-year  pgdate) " "
+	(pgdatetime-get-hour  pgdate) ":"
+	(pgdatetime-get-minute pgdate)`))
+
+
+
+;; map to 0 or 1 from a range of values
+;;            #f => 0
+;;            #t => 1
+;;           "0" => 0
+;;           "1" => 1
+;;         FALSE => 0
+;;          TRUE => 1
+;; anything else => 1
+(define (lazy-bool val)
+  (case val
+   ((#f) 0)
+   ((#t) 1)
+   ((0)  0)
+   ((1)  1)
+   (else
+    (cond
+     ((string? val)
+      (let ((nval (string->number val)))
+	(if nval 
+	    (lazy-bool nval)
+	    (cond
+	     ((string=? val "FALSE") 0)
+	     ((string=? val "TRUE")  1)
+	     (else 1)))))
+     ((symbol? val)
+      (lazy-bool (symbol->string val)))
+     (else 1)))))
+)

ADDED   dbi/dbi.setup
Index: dbi/dbi.setup
==================================================================
--- /dev/null
+++ dbi/dbi.setup
@@ -0,0 +1,11 @@
+;; Copyright 2007-2018, Matthew Welland.
+;;
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;;
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;;;; dbi.setup
+(standard-extension 'dbi "0.5")

ADDED   dbi/example.scm
Index: dbi/example.scm
==================================================================
--- /dev/null
+++ dbi/example.scm
@@ -0,0 +1,69 @@
+;;; dbi: Minimal gasket to postgresql, sqlite3 and mysql
+;;;
+;; Copyright (C) 2007-2016 Matt Welland
+;; Redistribution and use in source and binary forms, with or without
+;; modification, is permitted.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+;; DAMAGE.
+
+;; WARNING: This example is basically useless, I'll rewrite it one of these days ....
+
+(require-library margs dbi)
+
+(define help "help me")
+
+(define remargs (args:get-args 
+		 (argv)
+		 (list "-inf")
+		 (list "-h")
+		 args:arg-hash
+		 0))
+
+;; define DBPATH in setup.scm
+(include "setup.scm")
+
+(define (ftf:mk-db)
+  (let* ((fname    (conc DBPATH "/ftfplan.db"))
+ 	 (dbexists (file-exists? fname))
+	 (dbh      (if dbexists (dbi:open 'sqlite3 (list (cons 'dbname fname))) #f)))
+    (if (not dbexists)
+	(begin
+	  ;; (print "fullname: " fullname)
+	  (system (conc "mkdir -p " DBPATH)) ;; create the path
+	  (set! dbh (dbi:open 'sqlite3 (list (cons 'dbname fname))))
+	  (for-each 
+	   (lambda (sqry)
+	     ;; (print sqry)
+	     (dbi:exec dbh sqry))
+	   ;; types: 0 text, 1 jpg, 2 png, 3 svg, 4 spreadsheet, 5 audio, 6 video :: better specs to come...
+	   (list
+	    "CREATE TABLE pics     (id INTEGER PRIMARY KEY,name TEXT,dat_id INTEGER,thumb_dat_id INTEGER,created_on INTEGER,owner_id INTEGER);"
+	    "CREATE TABLE dats     (id INTEGER PRIMARY KEY,md5sum TEXT,dat BLOB,type INTEGER);"
+	     ;; on every modification a new tiddlers entry is created. When displaying the tiddlers do:
+	     ;;    select where created_on < somedate order by created_on desc limit 1
+	     "CREATE TABLE tiddlers (id INTEGER PRIMARY KEY,wiki_id INTEGER,name TEXT,rev INTEGER,dat_id INTEGER,created_on INTEGER,owner_id INTEGER);"
+	     ;; rev and tag only utilized when user sets a tag. All results from a select as above for tiddlers are set to the tag
+	     "CREATE TABLE revs     (id INTEGER PRIMARY KEY,tag TEXT);"
+	     ;; wikis is here for when postgresql support is added or if a sub wiki is created. 
+	     "CREATE TABLE wikis    (id INTEGER PRIMARY KEY,key_name TEXT,title TEXT,created_on INTEGER);"))
+             ))
+    dbh))
+
+(define db (ftf:mk-db))
+
+(dbi:exec db "INSERT INTO pics (name,owner_id) VALUES ('bob',1);")
+(dbi:for-each-row (lambda (row)(print "Name: " (vector-ref row 0) ", owner_id: " (vector-ref row 1)))
+   db
+   "SELECT name,owner_id FROM pics;")
+

ADDED   pathname-expand/pathname-expand.meta
Index: pathname-expand/pathname-expand.meta
==================================================================
--- /dev/null
+++ pathname-expand/pathname-expand.meta
@@ -0,0 +1,8 @@
+;; -*-scheme-*-
+((synopsis "Pathname expansion")
+ (license "BSD")
+ (category os)
+ (doc-from-wiki)
+ ;; No tests; this is very hard to do in a cross-platform way without
+ ;; writing a reimplementation of the functionality in our tests...
+ (author "The CHICKEN team"))

ADDED   pathname-expand/pathname-expand.scm
Index: pathname-expand/pathname-expand.scm
==================================================================
--- /dev/null
+++ pathname-expand/pathname-expand.scm
@@ -0,0 +1,111 @@
+;;; Pathname expansion, to replace the deprecated core functionality.
+;
+; Copyright (c) 2014, The CHICKEN Team
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without
+; modification, are permitted provided that the following conditions
+; are met:
+;
+;   Redistributions of source code must retain the above copyright
+;   notice, this list of conditions and the following disclaimer.
+;
+;   Redistributions in binary form must reproduce the above copyright
+;   notice, this list of conditions and the following disclaimer in
+;   the documentation and/or other materials provided with the
+;   distribution.
+;
+;   Neither the name of the author nor the names of its contributors
+;   may be used to endorse or promote products derived from this
+;   software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(module pathname-expand
+    (pathname-expand)
+
+(import chicken scheme)
+(use srfi-13 files posix)
+
+;; Expand pathname starting with "~", and/or apply base directory to
+;; relative pathname
+;
+; Inspired by Gambit's "path-expand" procedure.
+
+(define pathname-expand
+  (let* ((home
+          ;; Effective uid might be changed at runtime so this has to
+          ;; be a lambda, but we could try to cache the result on uid.
+          (lambda ()
+            (cond-expand
+              ((and windows (not cygwin))
+               (or (get-environment-variable "USERPROFILE")
+                   (get-environment-variable "HOME")
+                   "."))
+              (else
+               (let ((info (user-information (current-effective-user-id))))
+                 (list-ref info 5))))))
+         (slash
+          (cond-expand
+            ((and windows (not cygwin)) '(#\\ #\/))
+            (else '(#\/))))
+         (ts (string-append "~" (string (car slash))))
+         (tts (string-append "~" ts)))
+    (lambda (path #!optional (base (current-directory)))
+      (if (absolute-pathname? path)
+          path
+          (let ((len (string-length path)))
+            (cond
+             ((or (string=? "~~" path)
+                  (and (fx>= len 3) (string=? tts (substring path 0 3))))
+              ;; Repository-path
+              (let ((rp (repository-path)))
+                (if rp
+                    (string-append rp (substring path 2 len))
+                    (signal
+                     (make-composite-condition
+                      (make-property-condition
+                       'exn 'location 'pathname-expand
+                       'message "No repository path defined"
+                       'arguments (list path))
+                      (make-property-condition 'pathname-expand)
+                      (make-property-condition 'repository-path))))))
+             ((or (string=? "~" path)
+                  (and (fx> len 2) (string=? ts (substring path 0 2))))
+              ;; Current user's home dir
+              (string-append (home) (substring path 1 len)))
+             ((and (fx> len 0) (char=? #\~ (string-ref path 0)))
+              ;; Arbitrary user's home dir
+              (let ((rest (substring path 1 len)))
+                (if (and (fx> len 1) (memq (string-ref path 1) slash))
+                    (string-append (home) rest)
+                    (let* ((p (string-index path (lambda (c) (memq c slash))))
+                           (user (substring path 1 (or p len)))
+                           (info (user-information user)))
+                      (if info
+                          (let ((dir (list-ref info 5)))
+                            (if p
+                                (make-pathname dir (substring path p))
+                                dir))
+                          (signal
+                           (make-composite-condition
+                            (make-property-condition
+                             'exn 'location 'pathname-expand
+                             'message "Cannot expand homedir for user"
+                             'arguments (list path))
+                            (make-property-condition 'pathname-expand)
+                            (make-property-condition 'username))))))))
+             (else (make-pathname base path))))))))
+
+)

ADDED   pathname-expand/pathname-expand.setup
Index: pathname-expand/pathname-expand.setup
==================================================================
--- /dev/null
+++ pathname-expand/pathname-expand.setup
@@ -0,0 +1,2 @@
+;; -*-scheme-*-
+(standard-extension 'pathname-expand 0.1)