Class ::nsmcp::DatabaseSession (public)

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

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

Testcases:

No testcase defined.

Source code:

    :property handle:required
    :variable templates
    :variable inTransaction
    :method init {} {set :templates {}; set :inTransaction false}
    :public method quote {value} {
        if {[string first \x00 $value]>=0} {
            return "CAST(X'[binary encode hex [encoding convertto utf-8 $value]]' AS TEXT)"
        }
        return "'[string map [list ' ''] $value]'"
    }
    :method compile {sql} {
        if {[dict exists ${:templates} $sql]} {return [dict get ${:templates} $sql]}
        set statements {}; set parts {}; set literal {}; 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 literal $char
                if {$char eq "\n"} {set comment {}}
                continue
            }
            if {$comment eq "block"} {
                append literal $char
                if {$char eq "*" && $next eq "/"} {append literal $next; incr i; set comment {}}
                continue
            }
            if {$quote ne ""} {
                append literal $char
                if {$char eq $quote} {
                    if {$next eq $quote} {append literal $next; incr i} else {set quote {}}
                }
                continue
            }
            if {$char eq "-" && $next eq "-"} {set comment line; append literal $char $next; incr i; continue}
            if {$char eq "/" && $next eq "*"} {set comment block; append literal $char $next; incr i; continue}
            if {$char eq "'" || $char eq "\"" || $char eq "\x60"} {set active true; set quote $char; append literal $char; continue}
            if {$char eq "\u005b"} {set active true; set quote "\u005d"; append literal $char; continue}
            if {$char eq ";"} {
                lappend parts literal $literal
                if {$active} {lappend statements $parts}
                set parts {}; set literal {}; set active false; continue
            }
            if {![string is space -strict $char]} {set active true}
            if {$char eq "$" && [string match {[A-Za-z_]} $next]} {
                lappend parts literal $literal; set literal {}; set name {}
                while {$i+1<$length && [string match {[A-Za-z0-9_]} [string index $sql [expr {$i+1}]]]} {
                    incr i; append name [string index $sql $i]
                }
                lappend parts variable $name
            } else {append literal $char}
        }
        if {$quote ne "" || $comment eq "block"} {error "unterminated trusted SQL template"}
        lappend parts literal $literal
        if {$active} {lappend statements $parts}
        if {[dict size ${:templates}]>=64} {set :templates {}}
        dict set :templates $sql $statements
        return $statements
    }
    :public method execute {sql {arrayName {}} {script {}}} {
        set rows {}
        foreach template [:compile $sql] {
            set statement {}
            foreach {type value} $template {
                if {$type eq "literal"} {append statement $value} elseif {[uplevel 1 [list info exists $value]]} {
                    append statement [:quote [uplevel 1 [list set $value]]]
                } else {append statement NULL}
            }
            if {[string trim $statement] eq ""} continue
            set kind [ns_db exec ${:handle} $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 {
                while {[ns_db getrow ${:handle} $row]} {
                    set record {}; set keys {}
                    for {set i 0} {$i<[ns_set size $row]} {incr i} {
                        set key [ns_set key $row $i]
                        dict set record $key [ns_set value $row $i]; lappend keys $key
                    }
                    if {$arrayName eq ""} {lappend rows $record} else {
                        upvar 1 $arrayName target
                        array unset target
                        dict for {key value} $record {set target($key) $value}
                        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
    }
    :public method scalar {sql} {
        set rows [uplevel 1 [list [nsf::current object] execute $sql]]
        if {$rows eq ""} {return {}}
        return [lindex [dict values [lindex $rows 0]] 0]
    }
    :public method changes {} {return [:scalar {SELECT changes()}]}
    :public method transaction {script} {
        :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 {} {: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