diff --git a/collects/db/private/generic/connect-util.rkt b/collects/db/private/generic/connect-util.rkt index 04ace8084c..9dc8cda696 100644 --- a/collects/db/private/generic/connect-util.rkt +++ b/collects/db/private/generic/connect-util.rkt @@ -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)) diff --git a/collects/db/private/generic/functions.rkt b/collects/db/private/generic/functions.rkt index 609e037790..03a4ba50ba 100644 --- a/collects/db/private/generic/functions.rkt +++ b/collects/db/private/generic/functions.rkt @@ -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?))] diff --git a/collects/db/private/generic/interfaces.rkt b/collects/db/private/generic/interfaces.rkt index ab33185337..249be38965 100644 --- a/collects/db/private/generic/interfaces.rkt +++ b/collects/db/private/generic/interfaces.rkt @@ -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<%> diff --git a/collects/db/private/mysql/connection.rkt b/collects/db/private/mysql/connection.rkt index 498f441863..b3e84b4b41 100644 --- a/collects/db/private/mysql/connection.rkt +++ b/collects/db/private/mysql/connection.rkt @@ -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)))) + + )) ;; ======================================== diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt index 73e974f292..d5dc04c391 100644 --- a/collects/db/private/odbc/connection.rkt +++ b/collects/db/private/odbc/connection.rkt @@ -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 diff --git a/collects/db/private/postgresql/connection.rkt b/collects/db/private/postgresql/connection.rkt index 0692095861..4a43eaca45 100644 --- a/collects/db/private/postgresql/connection.rkt +++ b/collects/db/private/postgresql/connection.rkt @@ -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)) + )) ;; ======================================== diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt index 37267c744d..ca1969a6ca 100644 --- a/collects/db/private/sqlite3/connection.rkt +++ b/collects/db/private/sqlite3/connection.rkt @@ -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) diff --git a/collects/db/scribblings/query.scrbl b/collects/db/scribblings/query.scrbl index f295b0fef3..fd167af124 100644 --- a/collects/db/scribblings/query.scrbl +++ b/collects/db/scribblings/query.scrbl @@ -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