Class ::nsmcp::DatabaseSession

Class ::nsmcp::DatabaseSession (public)

 ::nx::Class ::nsmcp::DatabaseSession

Defined in /usr/local/ns/tcl/nsmcp/database.tcl

Testcases:: No testcase defined.

Source code:

    :property handle:required
    :variable scripts
    :variable inTransaction

    :method init {} {
        set :scripts {}
        set :inTransaction false
    }

    :method statements {sql} {
        if {[dict exists ${:scripts} $sql]} {
            return [dict get ${:scripts} $sql]
        }
        set trimmed [string trimleft $sql]
        if {[string first {;} $sql]<0 && $trimmed ne {}
            && [string range $trimmed 0 1] ni {-- /*}} {
            set statements [list $sql]
        } else {
            set statements {}
            set statement {}
            set length [string length $sql]
            set quote {}
            set comment {}
            set active false
            for {set i 0} {$i<$length} {incr i} {
                set char [string index $sql $i]
                set next [string index $sql [expr {$i+1}]]
                if {$comment eq "line"} {
                    append statement $char
                    if {$char eq "\n"} {
                        set comment {}
                    }
                    continue
                }
                if {$comment eq "block"} {
                    append statement $char
                    if {$char eq "*" && $next eq "/"} {
                        append statement $next
                        incr i
                        set comment {}
                    }
                    continue
                }
                if {$quote ne ""} {
                    append statement $char
                    if {$char eq $quote} {
                        if {$next eq $quote} {
                            append statement $next
                            incr i
                        } else {
                            set quote {}
                        }
                    }
                    continue
                }
                if {$char eq "-" && $next eq "-"} {
                    set comment line
                    append statement $char $next
                    incr i
                    continue
                }
                if {$char eq "/" && $next eq "*"} {
                    set comment block
                    append statement $char $next
                    incr i
                    continue
                }
                if {$char eq "'" || $char eq "\"" || $char eq "\x60"} {
                    set active true
                    set quote $char
                    append statement $char
                    continue
                }
                if {$char eq "\u005b"} {
                    set active true
                    set quote "\u005d"
                    append statement $char
                    continue
                }
                if {$char eq ";"} {
                    if {$active} {
                        lappend statements $statement
                    }
                    set statement {}
                    set active false
                    continue
                }
                if {![string is space -strict $char]} {
                    set active true
                }
                append statement $char
            }
            if {$quote ne "" || $comment eq "block"} {
                error "unterminated trusted SQL script"
            }
            if {$active} {
                lappend statements $statement
            }
        }
        if {[dict size ${:scripts}]>=64} {
            set :scripts {}
        }
        dict set :scripts $sql $statements
        return $statements
    }

    :public method execute {{-arrayName {}} {-script {}} sql} {
        #
        # Execute trusted SQL statements with bindings from the caller's scope.
        #
        # Materialize ns_set rows directly as alternating key/value lists, or run
        # the row callback through the supplied caller array; always flush result
        # sets.
        #
        # @param arrayName Optional caller-array name populated for each fetched
        #        row.
        # @param script Tcl script executed in the documented caller or callback
        #        context.
        # @param sql Trusted SQL text; current values are resolved in the caller's
        #        scope.
        #
        # @return The collected row lists, or an empty list when rows are consumed
        #         through a callback.
        #

        set rows {}
        foreach statement [:statements $sql] {
            # Core resolves current caller values and rejects missing names.
            set kind [uplevel 1 [list ns_db exec ${:handle} -bindvars -- $statement]]
            set command [string toupper [lindex [split [string trim $statement]] 0]]
            if {$command eq "BEGIN"} {
                set :inTransaction true
            }
            if {$command in {COMMIT ROLLBACK END}} {
                set :inTransaction false
            }
            if {$kind ne "NS_ROWS"} {
                continue
            }
            set row [ns_db bindrow ${:handle}]
            try {
                # Column names do not change between rows. Callback metadata
                # retains their original order, including duplicate names.
                if {$arrayName ne ""} {
                    set keys [ns_set keys $row]
                }
                while {[ns_db getrow ${:handle} $row]} {
                    set record [ns_set array $row]
                    if {$arrayName eq ""} {
                        lappend rows $record
                    } else {
                        upvar 1 $arrayName target
                        array unset target
                        array set target $record
                        set target(*) $keys
                        set code [catch {
                            uplevel 1 $script
                        } value options]
                        if {$code==3} {
                            break
                        }
                        if {$code==4} {
                            continue
                        }
                        if {$code} {
                            return -options $options $value
                        }
                    }
                }
            } finally {
                ns_db flush ${:handle}
                ns_set free $row
            }
        }
        return $rows
    }

    # DML accepts serialized SQL, or caller bindings with explicit type metadata.
    # Bulk VALUES payloads are handled by core without Tcl template parsing.
    # BEGIN/COMMIT/ROLLBACK continue through execute()/transaction().
    :public method executeDml {{-bindtypes {}} statement} {
        #
        # Execute one statement and require a DML result.
        #
        # Execute serialized SQL as supplied; when bindtypes is provided, resolve
        # caller variables through core binding with that explicit type metadata.
        #
        # @param bindtypes Optional dictionary describing scalar, list, rows or
        #        binary bindings.
        # @param statement One trusted SQL statement, with optional named value
        #        bindings.
        #
        # @return An empty result on success; row-returning statements raise an
        #         error.
        #

        if {$bindtypes eq {}} {
            set kind [ns_db exec ${:handle} $statement]
        } else {
            set kind [uplevel 1 [list ns_db exec ${:handle} -bindvars -bindtypes $bindtypes -- $statement]]
        }
        if {$kind eq "NS_ROWS"} {
            ns_db flush ${:handle}
            error "Expected a non-row-returning serialized DML statement"
        }
    }

    :public method scalar {sql} {
        #
        # Execute a query and return its first value.
        #
        # Reuse execute in the caller's scope, retaining its current-variable
        # binding behavior.
        #
        # @param sql Trusted SQL text; current values are resolved in the caller's
        #        scope.
        #
        # @return The first column of the first row, or an empty result when no row
        #         is returned.
        #

        set rows [uplevel 1 [list [nsf::current object] execute $sql]]
        if {$rows eq ""} {
            return {}
        }
        return [lindex [lindex $rows 0] 1]
    }

    :public method inTransaction {} {
        #
        # Report the transaction state tracked by this session.
        #
        # The flag follows transaction statements executed through this adapter.
        #
        # @return The current transaction flag.
        #

        return ${:inTransaction}
    }

    :public method changes {} {
        #
        # Read SQLite's affected-row count for the most recent statement.
        #
        # Query changes() on the owned handle without acquiring another session.
        #
        # @return The most recent SQLite change count.
        #

        return [:scalar {SELECT changes()}]
    }

    :public method batchCapabilities {} {
        #
        # Describe batch insertion support on the owned handle.
        #
        # Ask core nsdb for this driver's current batch capabilities.
        #
        # @return The batch-capability dictionary.
        #

        return [ns_db batchinfo -handle ${:handle}]
    }

    :public method batchInsert {{-mapping {}} {-schema {}} table batch} {
        #
        # Insert a supplied prepared batch using core nsdb's batch API.
        #
        # Pass optional column mapping and schema metadata to the owned database
        # handle.
        #
        # @param mapping Optional core batch column mapping.
        # @param schema Optional prepared-row schema.
        # @param table Target table identifier accepted by core batch insertion.
        # @param batch Prepared batch object or rows accepted by core nsdb.
        #
        # @return The batch insertion result returned by ns_db.
        #

        set options [list -table $table]
        if {$mapping ne {}} {
            lappend options -columns $mapping
        }
        if {$schema ne {}} {
            lappend options -schema $schema
        }
        return [ns_db batchinsert ${:handle} {*}$options $batch]
    }

    :public method transaction {script} {
        #
        # Execute a caller script inside an immediate SQLite transaction.
        #
        # Commit on normal completion and roll back if the script or commit raises
        # an error.
        #
        # @param script Tcl script executed in the documented caller or callback
        #        context.
        #
        # @return The caller script's result on successful commit.
        #

        :execute {BEGIN IMMEDIATE}
        try {
            set value [uplevel 1 $script]
            :execute COMMIT
            return $value
        } on error {message options} {
            catch {
                :execute ROLLBACK
            }
            return -options $options $message
        }
    }

    :public method close {} {
        #
        # Release this session and its checked-out database handle.
        #
        # Destroy the adapter so its destructor performs the connection cleanup.
        #
        # @return The object destruction result.
        #

        :destroy
    }

    :method destroy {} {
        if {[info exists :handle]} {
            if {${:inTransaction}} {
                catch {
                    ns_db dml ${:handle} ROLLBACK
                }
            }
            ns_db releasehandle ${:handle}
            unset :handle
        }
        next
    }

XQL Not present:

Generic, PostgreSQL, Oracle

[ hide source ] | [ make this the default ]