#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 2005-01-19 18:19 CET by <thomas@schnucke>.
# Source directory was `/tmp'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
# This format requires very little intelligence at unshar time.
# "if test", "echo", "mkdir", and "sed" may be needed.
#
# This shar contains:
# length mode       name
# ------ ---------- ------------------------------------------
#   3565 -rw-r--r-- sqlite-g0.1/sqlite-g.scm
#   1716 -rwxr-xr-x sqlite-g0.1/sqlite-g-demo
#
echo=echo
if mkdir _sh03679; then
  $echo 'x -' 'creating lock directory'
else
  $echo 'failed to create lock directory'
  exit 1
fi
# ============= sqlite-g0.1/sqlite-g.scm ==============
if test ! -d 'sqlite-g0.1'; then
  $echo 'x -' 'creating directory' 'sqlite-g0.1'
  mkdir 'sqlite-g0.1'
fi
if test -f 'sqlite-g0.1/sqlite-g.scm' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'sqlite-g0.1/sqlite-g.scm' '(file already exists)'
else
  $echo 'x -' extracting 'sqlite-g0.1/sqlite-g.scm' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'sqlite-g0.1/sqlite-g.scm' &&
X;; sqlite-g.scm v0.1
X;; Copyright (c) 2005 Thomas Hafner
X;;
X;; This program is free software; you can redistribute it and/or
X;; modify it under the terms of the GNU General Public License as
X;; published by the Free Software Foundation; either version 2 of the
X;; License, or (at your option) any later version.
X;; 
X;; This program is distributed in the hope that it will be useful, but
X;; WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
X;; General Public License for more details.
X;;
X;; History:
X;;
X;; v0.1 2005-01-16 Thomas Hafner: First trial. Provide sqlite-open,
X;;   sqlite-exec and sqlite-close.
X;;
X;;--
X;;
X;; Compile like that:
X;; gsc -dynamic -ld-options "-lsqlite -static -o sqlite-g.o1" sqlite-g.scm
X;;
X;; Use like that:
X;; (load "sqlite-g.o1")
X;;
X;; Author's environment:
X;; - sqlite 2.4.7
X;; - Gambit-C 4.0 beta 11
X;; - Debian 3.0 with kernel Linux 2.4.26
X
X(c-declare
X "
X#include \"sqlite.h\"
X")
X
X;; exported variables:
X(define sqlite-open #f)
X(define sqlite-exec #f)
X(define sqlite-close #f)
X
X;; Make result for sqlite-open.
X(c-define
X (sqlite-ignore-make-open-result sqlh message)
X ((pointer "sqlite") char-string)
X scheme-object
X "SqliteG_MakeOpenResult" "static"
X (list sqlh message))
X
X;; Callback function to be passed to sqlite_exec.
X(c-define
X (sqlite-ignore-process-match pcontext nofcols fields colnames)
X ((pointer void) int (pointer char-string) (pointer char-string))
X int
X "SqliteG_ExecScheme" "static"
X (let ((get-scheme-obj-by-void*
X        (c-lambda ((pointer void))
X                  scheme-object
X                  " ___result = *(___SCMOBJ *)___arg1;"))
X       (get-string-from-array
X        (c-lambda ((pointer char-string) int)
X                  char-string
X                  " ___result = ___arg1[___arg2];")))
X   (let another-column ((index (- nofcols 1)) (acc '()))
X     (if (< index 0)
X         (let ((on-match (get-scheme-obj-by-void* pcontext)))
X           (if (on-match acc) 0 1))
X         (let ((field (get-string-from-array fields index))
X               (colname (get-string-from-array colnames index)))
X           (let ((elem (cons colname field)))
X             (another-column (- index 1) (cons elem acc))))))))
X
X;; Make result for sqlite-exec.
X(c-define
X (sqlite-ignore-make-exec-result status message) (int char-string)
X scheme-object
X "SqliteG_MakeExecResult" "static"
X (list status message))
X
X(let ()
X  ;; Open a new SQLite database.
X  ;; 
X  ;; Arguments:
X  ;; - filename
X  ;; - mode
X  ;; Returns list of:
X  ;; - pointer to sqlite instance or #f, if n/a
X  ;; - error message or #f, if n/a
X  (set! sqlite-open
X        (c-lambda (char-string int)
X                  scheme-object
X                  "
Xchar *msg;
Xsqlite *sqlh;
Xsqlh = sqlite_open(___arg1, ___arg2, &msg);
X___result = SqliteG_MakeOpenResult(sqlh, msg);
X"))
X
X  ;; Execute a SQL command.
X  ;;
X  ;; Arguments:
X  ;; - database handle
X  ;; - sql command
X  ;; - callback procedure
X  ;; Returns list of:
X  ;; - status
X  ;; - error message or #f, if n/a
X  (set! sqlite-exec
X        (c-lambda
X         ((pointer "sqlite") char-string scheme-object)
X         scheme-object
X         "
Xchar *msg;
Xint status;
Xstatus = sqlite_exec(
X    ___arg1,
X    ___arg2,
X    &SqliteG_ExecScheme,
X    &___arg3,
X    &msg);
X___result = SqliteG_MakeExecResult(status, msg);
X"))
X
X  ;; Close a SQLite database.
X  ;; Arguments:
X  ;; - pointer to sqlite instance (gotten by sqlite-open)
X  (set! sqlite-close
X        (c-lambda ((pointer "sqlite"))
X                  void
X                  "sqlite_close"))
X  #t)
SHAR_EOF
  : || $echo 'restore of' 'sqlite-g0.1/sqlite-g.scm' 'failed'
fi
# ============= sqlite-g0.1/sqlite-g-demo ==============
if test -f 'sqlite-g0.1/sqlite-g-demo' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'sqlite-g0.1/sqlite-g-demo' '(file already exists)'
else
  $echo 'x -' extracting 'sqlite-g0.1/sqlite-g-demo' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'sqlite-g0.1/sqlite-g-demo' &&
X#!/usr/bin/env gsi-script
X;; -*- mode: Scheme -*-
X
X;; Copyright (c) 2005 Thomas Hafner
X;;
X;; This program is free software; you can redistribute it and/or
X;; modify it under the terms of the GNU General Public License as
X;; published by the Free Software Foundation; either version 2 of the
X;; License, or (at your option) any later version.
X;; 
X;; This program is distributed in the hope that it will be useful, but
X;; WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
X;; General Public License for more details.
X;;
X;; History:
X;;
X;; v0.1 2005-01-16 Thomas Hafner: Used for sqlite-g.scm v0.1.
X;;
X;;--
X;;
X;; Usage:
X;; sqlite-g-demo dbfile.sql
X
X(load "sqlite-g.o1")
X
X(define sqlite-demo
X  (lambda (db-path)
X    (let ((sql-commands
X           '("CREATE TABLE demotable (no INTEGER PRIMARY KEY, name);"
X             "INSERT INTO demotable VALUES (1, \"Adam\");"
X             "INSERT INTO demotable VALUES (2, \"Eva\");"
X             "SELECT * FROM demotable;"))
X          (db-file-mode #o644))
X      (let* ((openres (sqlite-open db-path db-file-mode))
X             (sqlh (car openres)))
X        (if (not sqlh)
X            (abort (cdr openres))
X            (let next-exec ((sql-commands sql-commands))
X              (if (null? sql-commands)
X                  #t
X                  (let ((exec-result
X                         (sqlite-exec
X                          sqlh (car sql-commands)
X                          pp)))
X                    (pp `("sqlite-exec returns:" ,exec-result))
X                    (next-exec (cdr sql-commands))))))
X        (sqlite-close sqlh)))))
X
X(define main
X  (lambda (db-path . ignore)
X  (sqlite-demo db-path)))    
SHAR_EOF
  : || $echo 'restore of' 'sqlite-g0.1/sqlite-g-demo' 'failed'
fi
rm -fr _sh03679
exit 0