This is the mail archive of the
guile@sourceware.cygnus.com
mailing list for the Guile project.
Oracle interface
- To: guile at sourceware dot cygnus dot com
- Subject: Oracle interface
- From: Sergey Dolin <dsa-ugur at chel dot surnet dot ru>
- Date: 26 May 2000 08:13:01 +0600
- Organization: Ditworth. Magic, Inc.
Well. I ready to introduce oracle interface.
But i'm not experenced nor guile nor *nix at all.
Couldn't you to be so glad, to check this sample for
correction should be made.
Some notes:
interface is implemented in .so library and tested to be
loaded via :use-module (database interface oracle or) on linux
(thanx to yours advises some weeks ago)
Implemented oracle 7.x interface only.
Long and LOB not implemented, because i've never had deal with them,
and have no idea how they could be introdused to scheme.
All suggestions well be taken.
Interface was made to be as neat to native OCI as posible and
simple. All high level funcs intended to be implemented in
scheme.
autoconf.in and automake.am are in very innoncient state. I'm planned
to test them against cygwin and AIX in near future, but it would
be better if anybody do it. Because i'm mswindows-programmer mostly.
Doc's is absent and not planned. One reason is i keep syntax and
symantix very tight to OCI convention. Second - this is not
my main job but only part of another big project and i have to
move futher as fast as possible. Third - my english is too bad
(russian is not very vell too :)) to write docs myself.
At last. There is only one file or.c ~1250 lines. I'll ready to
ship it to evreone who promise to maintain it accurately.
8<--------8<--------8<--- ~/prg/or-0.1/src/otest.ccm -8<--------8<--------8<
;dont pay attention to ugly style
;at the moment I'm guru in cut-n-paste but not in Scheme ;)
;"staticaly" linking test in order to debugging
;this script ought to be called inside
;boot_guile_shell
;conventions:
;almost all routens returns #t if success, #f fail and () if "eof" found
;it's sample oh high level func above native o:erhms and o:err?
(define (o:check obj);source of error maybe connection
;or cursor or place-holder
;NB: place-holder have to deal with second argument
;internally it did. But in this func - not handled
(cond
((o:err? obj);return #f if no error or int code if any
(display "fail\n error: ")
(display (o:erhms obj)))
(#t
(display "ok")
))
(display "\n"))
;step one - establish connection
(display "Testing olog-ologof on sys/sys...")
(let ((connection (o:log "sys" "sys" "db66")))
(o:check connection)
(o:logof connection))
(display "Testing o:olog \"sys\" \"sys\" \"db66\"...")
(define connection (o:log "sys" "sys" "db66"))
(o:check connection)
;step two - allocate cursor
(display "Testing o:open...")
(define cursor (o:open connection))
(o:check cursor)
;try simple DDL statement. No input params. No output.
(let ((stmt "DROP TABLE test"))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:exec...")
(o:exec cursor)(o:check cursor))
(let ((stmt "CREATE TABLE test (id NUMBER,name VARCHAR2(255))"))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:exec...")
(o:exec cursor)(o:check cursor))
;try input parameters
(let ((stmt "INSERT INTO TEST test VALUES (:id,:name)")
(id 0)
(name ""))
;parse statement against cursor
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
;place-holder is rather ...ehhH(forget the word)... not easy structure
;A place-holder realy is array of cells - in order
;to utilase my lovest oracle feature - multi-row operations;
;Pay attention the way it is used.
;If dimension iz 0, it is assumed as scalar. Difference
;between one-row array is neat, but impotent to oracle.
;step one. creating place-holders
(display "Testing o:make-plhldr for one-row exec...")
(set! id (o:make-plhldr ":id" 0 'o:t-integer))
(set! name (o:make-plhldr ":name" 0 'o:t-stringz 255))
(or
(and id name (display "ok\n"))
(display "failed\n"))
;step two. Bind them to oracle parameter
(display "Testing o:bndrv id...")
(o:bndrv cursor id)(o:check cursor);also in case of error returns #f
(display "Testing o:bndrv name...")
(o:bndrv cursor name)(o:check cursor)
;step three. Setting values
(display "Testing o:set! id 1...")
(o:set! id 1)(display "ok\n")
(display "Testing o:set! name \"string one\"...")
(o:set! name "string one")(display "ok\n")
;step thour. Executing
(display "Testing o:exec...")
(o:exec cursor)(o:check cursor)
;all below is clear, i think.
;bndra - binds array of values fp PL/SQL
(let ((stmt "BEGIN INSERT INTO TEST test (id,name) VALUES (:id,:name); END;")
(id 0)
(name ""))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:make-plhldr for one-row exec...")
(set! id (o:make-plhldr ":id" 0 'o:t-integer))
(set! name (o:make-plhldr ":name" 0 'o:t-stringz 255))
(or
(and id name (display "ok\n"))
(display "failed\n"))
(display "Testing o:bndra id...")
(o:bndra cursor id)(o:check cursor);also in case of error returns #f
(display "Testing o:bndra name...")
(o:bndra cursor name)(o:check cursor)
(display "Testing o:set! id 1...")
(o:set! id 2)(display "ok\n")
(display "Testing o:set! name \"string one\"...")
(o:set! name "string two")(display "ok\n")
(display "Testing o:exec...")
(o:exec cursor)(o:check cursor)
(display "Testing o:com...")
(o:com connection)(o:check connection))
;bndrv - bins array for multiple inserts at once
(let ((stmt "INSERT INTO TEST test VALUES (:id,:name)")
(id 0)
(name ""))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:make-plhldr for three-row exn...")
(set! id (o:make-plhldr ":id" 3 'o:t-integer))
(set! name (o:make-plhldr ":name" 3 'o:t-stringz 255))
(or
(and id name (display "ok\n"))
(display "failed\n"))
(display "Testing o:bndrv id...")
(o:bndrv cursor id)(o:check cursor);also in case of error returns #f
(display "Testing o:bndrv name...")
(o:bndrv cursor name)(o:check cursor)
(display "Testing o:set! id[0] 10...")
(o:set! id 10 0)(display "ok\n")
(display "Testing o:set! name[0] \"string one-zero\"...")
(o:set! name "string one-zero" 0 )(display "ok\n")
(display "Testing o:set! id[1] 11...")
(o:set! id 11 1)(display "ok\n")
(display "Testing o:set! name[1] \"string one-one\"...")
(o:set! name "string one-one" 1 )(display "ok\n")
(display "Testing o:set! id[2] 12...")
(o:set! id 12 2)(display "ok\n")
(display "Testing o:set! name[2] \"string one-two\"...")
(o:set! name "string one-two" 2 )(display "ok\n")
(display "Testing o:exn 3...")
(o:exn cursor 3)(o:check cursor)
(display "Testing o:com...")
(o:com connection)(o:check connection)))
;fetches
;one-row fetch
(let ((stmt "SELECT * FROM TEST")
(id 0)
(name ""))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(let ((v #f))
(display "Testing o:descr 0 ...")
(set! v (or (o:descr cursor 0)(o:check cursor)))
(display v)(display "\n");
(display "Testing o:descr 1 ...")
(set! v (or (o:descr cursor 1)(o:check cursor)))
(display v)(display "\n");
(display "Testing o:descr 2 ...")
(set! v (or (o:descr cursor 2)(o:check cursor)))
(display v)(display "\n")
(display "Testing o:descr 3 ...")
(set! v (or (o:descr cursor 3)(o:check cursor)))
(display v)(display "\n"))
(display "Testing o:make-plhldr for one-row fetch...")
(set! id (o:make-plhldr "realy-unneded-" 0 'o:t-integer))
(set! name (o:make-plhldr "-in-this-place" 0 'o:t-stringz 255))
(display "ok\n")
(display "Testing o:defin id 1 ...")
(o:defin cursor id 1)(o:check cursor)
(display "Testing o:defin name 2 ...")
(o:defin cursor name 2)(o:check cursor)
(display "Testing o:exec ...")
(o:exec cursor)(o:check cursor)
(display "Testing o:fetch first time ...")
(o:fetch cursor)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id=")(display (o:ref id))(display "\n")
(display " name=")(display (o:ref name))(display "\n")))
(display "Testing o:fetch second time...")
(o:fetch cursor)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id=")(display (o:ref id))(display "\n")
(display " name=")(display (o:ref name))(display "\n")))
(display "Testing o:fetch silent third time...")
(o:fetch cursor)(o:check cursor)
(display "Testing o:fetch silent fourth time...")
(o:fetch cursor)(o:check cursor)
(display "Testing o:fetch silent fivth time...")
(o:fetch cursor)(o:check cursor)
(display "Testing o:fetch silent sixth time (will fail)...")
(o:fetch cursor)(o:check cursor)
)
(let ((stmt "SELECT * FROM TEST")
(id 0)
(name ""))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:make-plhldr for three-row fetch...")
(set! id (o:make-plhldr "realy-unneded-" 3 'o:t-integer))
(set! name (o:make-plhldr "-in-this-place" 3 'o:t-stringz 255))
(display "ok\n")
(display "Testing o:defin id 1 ...")
(o:defin cursor id 1)(o:check cursor)
(display "Testing o:defin name 2 ...")
(o:defin cursor name 2)(o:check cursor)
(display "Testing o:exec ...")
(o:exec cursor)(o:check cursor)
(display "Testing o:fen 3 first time ...")
(o:fen cursor 3)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id[0]=")(display (o:ref id))(display "\n")
(display " name[0]=")(display (o:ref name))(display "\n")
(display " id[1]=")(display (o:ref id 1))(display "\n")
(display " name[1]=")(display (o:ref name 1))(display "\n")
(display " id[2]=")(display (o:ref id 2))(display "\n")
(display " name[2]=")(display (o:ref name 2))(display "\n")))
(display "Testing o:fen 2 once again ...")
(o:fen cursor 2)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id[0]=")(display (o:ref id))(display "\n")
(display " name[0]=")(display (o:ref name))(display "\n")
(display " id[1]=")(display (o:ref id 1))(display "\n")
(display " name[1]=")(display (o:ref name 1))(display "\n")
(display " id[2]=")(display (o:ref id 2))(display "\n")
(display " name[2]=")(display (o:ref name 2))(display "\n")))
(display "Testing o:fen 2 once again (will fail)...")
(o:fen cursor 2)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id[0]=")(display (o:ref id))(display "\n")
(display " name[0]=")(display (o:ref name))(display "\n")
(display " id[1]=")(display (o:ref id 1))(display "\n")
(display " name[1]=")(display (o:ref name 1))(display "\n")
(display " id[2]=")(display (o:ref id 2))(display "\n")
(display " name[2]=")(display (o:ref name 2))(display "\n"))))
(display "Testing o:can...")
(o:can cursor)(o:check cursor)
(display "Testing o:rol...")
(o:rol connection)(o:check connection)
(let ((stmt "SELECT * FROM TEST")
(id 0)
(name ""))
(display "Testing o:parse \"")
(display stmt)
(display "\"...")
(o:parse cursor stmt)(o:check cursor)
(display "Testing o:make-plhldr for six-row exfet...")
(set! id (o:make-plhldr "realy-unneded-" 6 'o:t-integer))
(set! name (o:make-plhldr "-in-this-place" 6 'o:t-stringz 255))
(display "ok\n")
(display "Testing o:defin id 1 ...")
(o:defin cursor id 1)(o:check cursor)
(display "Testing o:defin name 2 ...")
(o:defin cursor name 2)(o:check cursor)
(display "Testing o:exfet ...")
(o:exfet cursor 5)(o:check cursor)
(or
(o:err? cursor)
(begin
(display " id[0]=")(display (o:ref id))(display "\n")
(display " name[0]=")(display (o:ref name))(display "\n")
(display " id[1]=")(display (o:ref id 1))(display "\n")
(display " name[1]=")(display (o:ref name 1))(display "\n")
(display " id[2]=")(display (o:ref id 2))(display "\n")
(display " name[2]=")(display (o:ref name 2))(display "\n")
(display " id[3]=")(display (o:ref id 3))(display "\n")
(display " name[3]=")(display (o:ref name 3))(display "\n")
(display " id[4]=")(display (o:ref id 4))(display "\n")
(display " name[4]=")(display (o:ref name 4))(display "\n")
(display " id[5]=")(display (o:ref id 5))(display "\n")
(display " name[5]=")(display (o:ref name 5))(display "\n"))))
8<--------8<--------8<--------8<--------8<--------8<--------8<--------8<
--
Sergey
05/26/2000 08:00 mailto:dsa-ugur@chel.surnet.ru
Gnus v5.8.3/XEmacs 21.1 (patch 3) "Acadia" [Lucid]