db: added list-tables, table-exists? (except for ODBC, so far)
This commit is contained in:
Ryan Culpepper
parent
50f0a32f9e
commit
82896bfce2
|
|
@ -64,7 +64,8 @@
|
|||
(free-statement stmt)
|
||||
(transaction-status fsym)
|
||||
(start-transaction fsym isolation)
|
||||
(end-transaction fsym mode))
|
||||
(end-transaction fsym mode)
|
||||
(list-tables fsym schema))
|
||||
|
||||
(super-new)))
|
||||
|
||||
|
|
@ -174,7 +175,8 @@
|
|||
(#t '_ (query fsym stmt))
|
||||
(#t '_ (start-transaction fsym isolation))
|
||||
(#f (void) (end-transaction fsym mode))
|
||||
(#f #f (transaction-status fsym)))
|
||||
(#f #f (transaction-status fsym))
|
||||
(#t '_ (list-tables fsym schema)))
|
||||
|
||||
(define/public (disconnect)
|
||||
(let ([c (get-connection #f)]
|
||||
|
|
@ -330,7 +332,8 @@
|
|||
(free-statement stmt)
|
||||
(transaction-status fsym)
|
||||
(start-transaction fsym isolation)
|
||||
(end-transaction fsym mode))
|
||||
(end-transaction fsym mode)
|
||||
(list-tables fsym schema))
|
||||
|
||||
;; (define-forward define/override (connected?))
|
||||
(define/override (connected?) (and connection #t))
|
||||
|
|
|
|||
|
|
@ -268,15 +268,27 @@
|
|||
|
||||
;; ========================================
|
||||
|
||||
(define (get-schemas c)
|
||||
(recordset-rows
|
||||
(send c query 'get-schemas
|
||||
"select catalog_name, schema_name from information_schema.schemata")))
|
||||
;; list-tables : ... -> (listof string)
|
||||
;; - lists unqualified table/view/etc names in search path (omit system tables, if possible).
|
||||
;; Maybe it would be better to just search the current schema only?
|
||||
;; or maybe mode = 'current | 'search | 'current-or-search (default)
|
||||
;; - lists unqualified table/view/etc names for given schema (and/or catalog?)
|
||||
;; - Add option to include system tables?
|
||||
(define (list-tables c
|
||||
#:schema [schema 'search-or-current])
|
||||
(send c list-tables 'list-tables schema))
|
||||
|
||||
(define (get-tables c)
|
||||
(recordset-rows
|
||||
(send c query 'get-tables
|
||||
"select table_catalog, table_schema, table_name from information_schema.tables")))
|
||||
(define (table-exists? c table-name
|
||||
#:schema [schema 'search-or-current]
|
||||
#:case-sensitive? [cs? #f])
|
||||
(let ([tables (send c list-tables 'table-exists? schema)])
|
||||
(for/or ([table (in-list tables)])
|
||||
(if cs?
|
||||
(string=? table-name table)
|
||||
(string-ci=? table-name table)))))
|
||||
|
||||
;; list-tables* : ... -> (listof vector)
|
||||
;; Return full catalog/schema/table/type list.
|
||||
|
||||
;; ========================================
|
||||
|
||||
|
|
@ -364,6 +376,16 @@
|
|||
(-> any/c connection?
|
||||
statement?))]
|
||||
|
||||
[list-tables
|
||||
(->* (connection?)
|
||||
(#:schema (or/c 'search-or-current 'search 'current))
|
||||
(listof string?))]
|
||||
[table-exists?
|
||||
(->* (connection? string?)
|
||||
(#:schema (or/c 'search-or-current 'search 'current)
|
||||
#:case-sensitive? any/c)
|
||||
boolean?)]
|
||||
|
||||
#|
|
||||
[get-schemas
|
||||
(-> connection? (listof vector?))]
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@
|
|||
end-transaction ;; symbol (U 'commit 'rollback) -> void
|
||||
transaction-status ;; symbol -> (U boolean 'invalid)
|
||||
|
||||
list-tables ;; symbol symbol -> (listof string)
|
||||
|
||||
free-statement)) ;; prepared-statement<%> -> void
|
||||
|
||||
;; no-cache-prepare<%>
|
||||
|
|
|
|||
|
|
@ -422,7 +422,25 @@
|
|||
((commit) "COMMIT")
|
||||
((rollback) "ROLLBACK"))])
|
||||
(query1 fsym stmt #t)
|
||||
(void)))))))
|
||||
(void)))))
|
||||
|
||||
;; Reflection
|
||||
|
||||
(define/public (list-tables fsym schema)
|
||||
(let* ([stmt
|
||||
;; schema is ignored; search = current
|
||||
(string-append "SELECT table_name FROM information_schema.tables "
|
||||
"WHERE table_schema = schema()")]
|
||||
[rows
|
||||
(vector-ref
|
||||
(call-with-lock fsym
|
||||
(lambda ()
|
||||
(query1 fsym stmt #t)))
|
||||
2)])
|
||||
(for/list ([row (in-list rows)])
|
||||
(vector-ref row 0))))
|
||||
|
||||
))
|
||||
|
||||
;; ========================================
|
||||
|
||||
|
|
|
|||
|
|
@ -515,6 +515,10 @@
|
|||
|
||||
;; GetTables
|
||||
|
||||
(define/public (list-tables fsym schema)
|
||||
(uerror fsym "unsupported"))
|
||||
|
||||
#|
|
||||
(define/public (get-tables fsym catalog schema table)
|
||||
(define-values (dvecs rows)
|
||||
(call-with-lock fsym
|
||||
|
|
@ -532,6 +536,7 @@
|
|||
;; Layout is: #(catalog schema table table-type remark)
|
||||
(recordset (map field-dvec->field-info dvecs)
|
||||
rows))
|
||||
|#
|
||||
|
||||
;; Handler
|
||||
|
||||
|
|
|
|||
|
|
@ -418,37 +418,53 @@
|
|||
(call-with-lock fsym (lambda () tx-status)))
|
||||
|
||||
(define/public (start-transaction fsym isolation)
|
||||
(let ([stmt
|
||||
(call-with-lock fsym
|
||||
(lambda ()
|
||||
(when tx-status
|
||||
(error/already-in-tx fsym))
|
||||
(let* ([isolation-level (isolation-symbol->string isolation)]
|
||||
(internal-query fsym
|
||||
(lambda ()
|
||||
(when tx-status
|
||||
(error/already-in-tx fsym)))
|
||||
(let ([isolation-level (isolation-symbol->string isolation)])
|
||||
;; 'read-only => "READ ONLY"
|
||||
;; 'read-write => "READ WRITE"
|
||||
[stmt
|
||||
(if isolation-level
|
||||
(string-append "BEGIN WORK ISOLATION LEVE " isolation-level)
|
||||
"BEGIN WORK")])
|
||||
(let-values ([(stmt result) (query1 fsym stmt)])
|
||||
stmt))))])
|
||||
(statement:after-exec stmt)
|
||||
(void)))
|
||||
(if isolation-level
|
||||
(string-append "BEGIN WORK ISOLATION LEVEL " isolation-level)
|
||||
"BEGIN WORK"))))
|
||||
|
||||
(define/public (end-transaction fsym mode)
|
||||
(let ([stmt
|
||||
(call-with-lock fsym
|
||||
(lambda ()
|
||||
(unless (eq? mode 'rollback)
|
||||
;; otherwise, COMMIT statement would cause silent ROLLBACK !!!
|
||||
(check-valid-tx-status fsym))
|
||||
(let ([stmt (case mode
|
||||
((commit) "COMMIT WORK")
|
||||
((rollback) "ROLLBACK WORK"))])
|
||||
(let-values ([(stmt result) (query1 fsym stmt)])
|
||||
stmt))))])
|
||||
(internal-query fsym
|
||||
(lambda ()
|
||||
(unless (eq? mode 'rollback)
|
||||
;; otherwise, COMMIT statement would cause silent ROLLBACK !!!
|
||||
(check-valid-tx-status fsym)))
|
||||
(case mode
|
||||
((commit) "COMMIT WORK")
|
||||
((rollback) "ROLLBACK WORK")))
|
||||
(void))
|
||||
|
||||
;; == Reflection
|
||||
|
||||
(define/public (list-tables fsym schema)
|
||||
(let* ([where-cond
|
||||
(case schema
|
||||
((search search-or-current)
|
||||
"table_schema = SOME (current_schemas(false))")
|
||||
((current)
|
||||
"table_schema = current_schema"))]
|
||||
[stmt
|
||||
(string-append "SELECT table_name FROM information_schema.tables WHERE "
|
||||
where-cond)]
|
||||
[rows (vector-ref (internal-query fsym void stmt) 2)])
|
||||
(for/list ([row (in-list rows)])
|
||||
(bytes->string/utf-8 (vector-ref row 0)))))
|
||||
|
||||
(define/private (internal-query fsym pre-thunk stmt)
|
||||
(let-values ([(stmt result)
|
||||
(call-with-lock fsym
|
||||
(lambda ()
|
||||
(pre-thunk)
|
||||
(query1 fsym stmt)))])
|
||||
(statement:after-exec stmt)
|
||||
(void)))))
|
||||
result))
|
||||
))
|
||||
|
||||
;; ========================================
|
||||
|
||||
|
|
|
|||
|
|
@ -223,6 +223,23 @@
|
|||
(statement:after-exec stmt)
|
||||
(void)))
|
||||
|
||||
;; Reflection
|
||||
|
||||
(define/public (list-tables fsym schema)
|
||||
(let ([stmt
|
||||
;; schema ignored, because sqlite doesn't support
|
||||
(string-append "SELECT tbl_name from sqlite_master "
|
||||
"WHERE type = 'table' or type = 'view'")])
|
||||
(let-values ([(stmt rows)
|
||||
(call-with-lock fsym
|
||||
(lambda ()
|
||||
(let-values ([(stmt _info rows)
|
||||
(query1 fsym stmt)])
|
||||
(values stmt rows))))])
|
||||
(statement:after-exec stmt)
|
||||
(for/list ([row (in-list rows)])
|
||||
(vector-ref row 0)))))
|
||||
|
||||
;; ----
|
||||
|
||||
(define-syntax-rule (HANDLE who expr)
|
||||
|
|
|
|||
|
|
@ -554,6 +554,44 @@ rollback invalid transactions.
|
|||
is rolled back.
|
||||
}
|
||||
|
||||
|
||||
@section{Database Information}
|
||||
|
||||
@defproc[(list-tables [c connection?]
|
||||
[#:schema schema
|
||||
(or/c 'search-or-current 'search 'current)
|
||||
'search-or-current])
|
||||
(listof string?)]{
|
||||
|
||||
Returns a list of unqualified names of tables (and views) defined in
|
||||
the current database.
|
||||
|
||||
If @racket[schema] is @racket['search], the list contains all tables
|
||||
in the current schema search path (with the possible exception of
|
||||
system tables); if the search path cannot be determined, an exception
|
||||
is raised. If @racket[schema] is @racket['current], the list contains
|
||||
all tables in the current schema. If @racket[schema] is
|
||||
@racket['search-or-current] (the default), the search path is used if
|
||||
it can be determined; otherwise the current schema is used.
|
||||
The schema search path cannot be determined for ODBC-based
|
||||
connections.
|
||||
}
|
||||
|
||||
@defproc[(table-exists? [c connection?]
|
||||
[table-name string?]
|
||||
[#:schema schema
|
||||
(or/c 'search-or-current 'search 'current)
|
||||
'search-or-current]
|
||||
[#:case-sensitive? case-sensitive? any/c #f])
|
||||
boolean?]{
|
||||
|
||||
Indicates whether a table (or view) named @racket[table-name]
|
||||
exists. The meaning of the @racket[schema] argument is the same as for
|
||||
@racket[list-tables], and the @racket[case-sensitive?] argument
|
||||
controls how table names are compared.
|
||||
}
|
||||
|
||||
|
||||
@section{Creating New Kinds of Statements}
|
||||
|
||||
@defthing[prop:statement (struct-type-property/c
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user