# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package provide database 1.0
package require sqlite3

namespace eval ::database {
    variable dbs
    variable counter
    variable db.code.template
}

proc ::database::new {file} {
    variable counter
    incr counter

    set db database#$counter
    lappend mapping %NAME% $db

    variable db.code.template
    eval [string map $mapping ${db.code.template}]
    ${db} init $file

    variable dbs
    set dbs($db) 1
    return $db
}

proc ::database::delete {db} {
    namespace delete ::$db
    variable dbs
    unset dbs($db)
}

set ::database::db.code.template {

    proc ::%NAME% {cmd args} {
        set targets [info procs ::%NAME%::$cmd]
        if {[llength $targets] == 0} {
            error "no procedure: ::%NAME%::$cmd"
        }
        foreach target $targets {
            return [eval $target $args]
        }
    }

    namespace eval ::%NAME% {
        variable file
        variable db
        variable map:tables
    }

    proc ::%NAME%::init {_file} {
        variable file $_file
        variable db %NAME%::db
        open
        map:tables:update
    }

    proc ::%NAME%::open {} {
        variable db
        if {[info command $db] != {}} return
        variable file
        sqlite3 $db $file
    }

    proc ::%NAME%::close {} {
        variable db
        if {[info command $db] == {}} return
        $db close
    }

    proc ::%NAME%::db:eval {args} {
        #puts [string trim [lindex $args 0]]
        return [uplevel "variable db; \$db eval $args"]
    }

    proc ::%NAME%::map:format {arity nkeys nvals} {
        return "map_${arity}_${nkeys}_${nvals}"
    }

    proc ::%NAME%::map:scan {string arity nkeys nvals} {
        uplevel "scan $string \"map_%d_%d_%d\" $arity $nkeys $nvals"
    }

    proc ::%NAME%::map:create {arity nkeys nvals {types {}}} {
        set table [map:format $arity $nkeys $nvals]

        append columns "c0 text"
        for {set i 1} {$i < $arity} {incr i} {
            append columns ", c$i text"
        }

        append keys "c0"
        for {set i 1} {$i < $nkeys} {incr i} {
            append keys ", c$i"
        }

        db:eval "create table $table ($columns, primary key ($keys))"

        for {set i 0} {$i < $arity} {incr i} {
            db:eval "create index ${table}_idx$i on $table (c$i)"
        }

        variable map:tables
        set map:tables($table) 1
    }

    proc ::%NAME%::map:exists {arity nkeys nvals} {
        variable map:tables
        set table [map:format $arity $nkeys $nvals]
        set exists [lindex [array get map:tables $table] 1]
        set result [expr {$exists == 1}]
        return $result
    }

    proc ::%NAME%::map:tables:update {} {
        variable map:tables
        array unset map:tables
        set tables [get:tables]
        foreach table $tables {
            if {[map:scan $table arity nkeys nvals] != 3} continue
            set map:tables($table) 1
        }
    }

    proc ::%NAME%::map:set {keys args} {
        set nkeys [llength $keys]
        set nvals [llength $args]
        set arity [expr $nkeys + $nvals]

        set table [map:format $arity $nkeys $nvals]
        #map:scan $table arity nkeys nvals

        if ![map:exists $arity $nkeys $nvals] {
            map:create $arity $nkeys $nvals
        }

        eval lappend list $keys $args
        append values "\$v(0)"
        set v(0) [lindex $list 0]

        for {set i 1} {$i < $arity} {incr i} {
            append values ", \$v($i)"
            set v($i) [lindex $list $i]
        }

        db:eval "replace into $table values ($values)"
    }

    proc ::%NAME%::map:set:many:nkeys:nvals {records nkeys nvals} {
        set arity [expr $nkeys + $nvals]
        set table [map:format $arity $nkeys $nvals]
        #map:scan $table arity nkeys nvals

        if ![map:exists $arity $nkeys $nvals] {
            map:create $arity $nkeys $nvals
        }

        # It is much more efficient with transactions than without.
        set script "begin;\n"
        set vidx 0

        foreach record $records {
            set list [lindex $record 0]
            for {set i 1} {$i < $nvals + 1} {incr i} {
                lappend list [lindex $record $i]
            }

            set values "\$v($vidx)"
            set v($vidx) [lindex $list 0]
            incr vidx

            for {set i 1} {$i < $arity} {incr i} {
                append values ", \$v($vidx)"
                set v($vidx) [lindex $list $i]
                incr vidx
            }

            append script "replace into $table values ($values);\n"
        }

        append script "commit"
        db:eval $script
    }

    proc ::%NAME%::map:set:many {records} {
        # Collect records with the same model.
        foreach record $records {
            set nkeys [llength [lindex $record 0]]
            set nvals [expr [llength $record] - 1]
            set l records:$nkeys:$nvals
            lappend $l $record
            set k [list $nkeys $nvals]
            if {[array get visited $k] == ""} {
                set visited($k) 1
            }
        }

        # Insert the records of each model.
        foreach k [array names visited] {
            lassign $k nkeys nvals
            set l [subst $\{records:$nkeys:$nvals\}]
            map:set:many:nkeys:nvals $l $nkeys $nvals
        }
    }

    # A macro which creates a 'constraint' variable in the caller,
    # corresponding to a SQL constraint built from the caller's
    # arguments.  Called by map:get and map:get:count.
    proc ::%NAME%::map:get:prepare {} {
        uplevel {
            set arity_min [llength $args]
            if {$arity_min == 0} { return {} }

            append constraint "(c0 = \$v(0))"
            set v(0) [lindex $args 0]
            for {set i 1} {$i < $arity_min} {incr i} {
                set argsi [lindex $args $i]
                if {$argsi == "*"} continue
                append constraint " and (c$i = \$v($i))"
                set v($i) $argsi
            }
        }
    }

    proc ::%NAME%::map:get {args} {
        set arity_min [llength $args]
        if {$arity_min == 0} { return {} }
        map:get:prepare

        set result {}
        variable map:tables

        foreach {table exists} [array get map:tables] {
            if !$exists continue
            map:scan $table arity nkeys nvals
            if {$arity < $arity_min} continue

            set script "select * from $table where $constraint"
            db:eval $script record {
                set _record $record(c0)
                for {set i 1} {$i < $arity} {incr i} \
                    { lappend _record $record(c$i) }
                lappend result $_record
            }
        }

        return $result
    }

    proc ::%NAME%::map:get:count {args} {
        set arity_min [llength $args]
        if {$arity_min == 0} { return {} }
        map:get:prepare

        set result 0
        variable map:tables

        foreach {table exists} [array get map:tables] {
            if !$exists continue
            map:scan $table arity nkeys nvals
            if {$arity < $arity_min} continue

            set script "select count(*) as count from $table where $constraint"
            db:eval $script record {
                incr result $record(count)
            }
        }

        return $result
    }

    proc ::%NAME%::map:delete {args} {
        set arity_min [llength $args]
        if {$arity_min == 0} { return {} }
        map:get:prepare

        variable map:tables
        foreach {table exists} [array get map:tables] {
            if !$exists continue
            map:scan $table arity nkeys nvals
            if {$arity < $arity_min} continue
            db:eval "delete from $table where $constraint"
        }
    }

    proc ::%NAME%::get:tables {} {
        set table "sqlite_master"
        set constraint "(type = 'table')"
        return [db:eval "select name from $table where $constraint"]
    }

    proc ::%NAME%::clear {} {
        set tables [get:tables]
        foreach table $tables {
            db:eval "drop table $table"
        }
        variable map:tables
        array unset map:tables
        db:eval { vacuum }
    }

    proc ::%NAME%::delete:hard {} {
        close
        variable file
        file delete $file
    }

    proc ::%NAME%::delete {} {
        close
        ::database::delete %NAME%
    }
}

