读写sqlite3数据库程序.tcl

TCL的数据库处理支撑库及一些示例

                if {[regexp "PRIMARY KEY" $name]} {
                    set primary_key $key_index_counter
                    set primary_key_name [lindex $name 0]
                }
                if {[lindex $name 0] != "" && [lindex $name 0] != "CREATE"} {
                    lappend column_names [lindex $name 0]
                }
                incr key_index_counter
            }
        }

        if {[regexp "CREATE VIEW" $initial_column_names] && ![regexp "\\*" $initial_column_names]} {
            # we need to get the names of the columns you want from between the SELECT and the FROM statements
            regexp "SELECT .+ FROM" $initial_column_names match
            puts "match == $match"
            regsub "SELECT " $match {} match
            regsub " FROM" $match {} match
            regsub -all {, } $match { } match
            puts "match == $match"

            # in this case, the initial_column_names is actually the table names - I know that is  confusing - just too lazy to change the code
            regsub "CREATE VIEW $table_name AS SELECT .+ FROM " $initial_column_names {} initial_column_names
            regsub { WHERE.+$} $initial_column_names {} initial_column_names
            set initial_column_names [split $initial_column_names ", "]
            regsub -all {\(} $initial_column_names {} initial_column_names
            regsub -all {\)} $initial_column_names {} initial_column_names
            regsub -all {\{} $initial_column_names {} initial_column_names
            regsub -all {\}} $initial_column_names {} initial_column_names
            regsub -all {\\} $initial_column_names {} initial_column_names

            set column_names $match

        }

        # this is the case where you use a wildcard for selecting the columnames when creating a view. So you will get all the column names in the tablelist widget.
        if {[regexp "CREATE VIEW" $initial_column_names] && [regexp "\\*" $initial_column_names]} {
            regsub "CREATE VIEW $table_name AS SELECT \\* FROM " $initial_column_names {} initial_column_names
            regsub { WHERE.+$} $initial_column_names {} initial_column_names
            set initial_column_names [split $initial_column_names ", "]
            regsub -all {\(} $initial_column_names {} initial_column_names
            regsub -all {\)} $initial_column_names {} initial_column_names
            regsub -all {\{} $initial_column_names {} initial_column_names
            regsub -all {\}} $initial_column_names {} initial_column_names
            regsub -all {\\} $initial_column_names {} initial_column_names
            puts $initial_column_names

            foreach view_table $initial_column_names {
                set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]]
                regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2
                regsub -all {\(} $initial_column_names2 {} initial_column_names2
                regsub -all {\)} $initial_column_names2 {} initial_column_names2
                regsub -all {\{} $initial_column_names2 {} initial_column_names2
                regsub -all {\}} $initial_column_names2 {} initial_column_names2

                # the reply still contains the column name followed by a comma and the type description
                # so we need to make a new list with only the first element - the name without the type description
                set key_index_counter 0
                foreach name [split $initial_column_names2 ","] {
                    if {[regexp "PRIMARY KEY" $name]} {
                        set primary_key $key_index_counter
                        set primary_key_name [lindex $name 0]
                    }

                    lappend column_names [lindex $name 0]

                    incr key_index_counter
                }

            }

        }

        set no_columns [llength [split $column_names " "]]
        for {set x $no_columns} {$x <= [llength $result]} {incr x [expr $no_columns + 1]} {
            set result [linsert $result $x  \n]
        }

        #.message.label configure -text "$initial_column_names"
        #.message.label2 configure -text "$column_names"

        if {$report_type == "text" || $report_type == "both"} {
            .result_text insert end "$column_names \n"
        }
        regsub -all {\{\n\}} $result "\n" result
        if {$report_type == "text" || $report_type == "both"} {
            .result_text insert end $result
        }
        set new_column_names [list "0 [join $column_names "\n0 "]"]
        regsub -all {\{} $new_column_names {} new_column_names
        regsub -all {\}} $new_column_names {} new_column_names
        if {$report_type == "tablelist" || $report_type == "both"} {
            if {$report_type == "tablelist"} {
                .pw fraction 0 100
            } else {
                .pw fraction 50 50
            }

            tablelist::tablelist .query_results -columns $new_column_names \
                    -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \
                    -editendcommand applyValue -height 15 -width 120 -stretch all \
                    -xscrollcommand [list .hsb set] -yscrollcommand [list .vsb set] \
                    -stripebackground           #e0e8f0
            for {set x 0} {$x < [llength $column_names]} {incr x} {
                .query_results columnconfigure $x -maxwidth 30 -editable no
            }
            scrollbar .vsb -orient vertical   -command [list .query_results yview]
            scrollbar .hsb -orient horizontal -command [list .query_results xview]
            #grid .query_results -row 0 -column 0 -sticky news
            #grid .vsb -row 0 -column 1 -sticky ns
            #grid .hsb -row 1 -column 0 -sticky ew

            #grid rowconfigure    $tf 0 -weight 1
            #grid columnconfigure $tf 0 -weight 1
            pack .hsb -in $right -expand true -fill x
            pack .vsb -in $right -side left -expand true -fill y
            pack .query_results -in $right -side left
            foreach line [split $result "\n"] {
                #regsub -all {\'} $line {\\\'} line
                .query_results insert end [string map {' \'} $line]
            }
        }
    }
 }
 pack .sqlframe.go_button -side left

 menubutton .sqlframe.report_type -relief raised -indicatoron true -text "Result Format" -menu  .sqlframe.report_type.menu
 pack .sqlframe.report_type -side left

 menu .sqlframe.report_type.menu
 .sqlframe.report_type.menu add radiobutton -label "Text        " -variable report_type -value "text"  -command {.sqlframe.report_type configure -text "Text         "}
 .sqlframe.report_type.menu add radiobutton -label "Tablelist   " -variable report_type -value  "tablelist" -command {.sqlframe.report_type configure -text "Tablelist    "}
 .sqlframe.report_type.menu add radiobutton -label "Both        " -variable report_type -value "both"  -command {.sqlframe.report_type configure -text "Both        "}

 label .sqlframe.column_label -text "No. Columns"
 pack .sqlframe.column_label -side left
 #set no_columns 1
 entry .sqlframe.columns -width 3 -textvariable no_columns
 pack .sqlframe.columns -side left -expand true -fill both

 focus -force .sqlframe.entry

 proc applyValue {tbl row col text} {
    global  primary_key primary_key_name
    #This proc gets called whenever you edit a value in a cell that is editable
    #The purpose is to then update the database with the change you made automatically

    # get the name of this table for the UPDATE sql command by introspection by querying the wm for  the top level title.
    # This way you can have multiple tablists open on different tables and each will know what table  it updates
    # without having to set any global variables.
    set table_name [wm title [winfo parent [winfo parent $tbl]]]
    puts $table_name

    # this inserts the change into the table cell from the entry box after user hits return key or  moves to another cell
    # it is set up to trim or the spaces on the right unless the data in the box is only a space, which is the default value.
    # a box has to have something in it in order to match the tablelist rows to rows in the SQLite table. This is because
    # if you have nothing in a box, the tablelist widget will output a list with that member removed from the list and then the
    # values going into the SQLIte table when it is updated do not match the right entry in the tablelist with the right column
    # in the SQLite table.
    if {![string compare $text " "]} {
        $tbl cellconfigure $row,$col -text [string trimleft [string trimright $text]]
    } else {
        $tbl cellconfigure $row,$col -text $text
    }
    # get the name of column by querying the tablelist widget for the title on the button at the top of the column
    # this will be passed to the SQL command for updating the database down below
    set columnname [$tbl columncget $col -title]

    #puts "columnname == $columnname"
    #set values "'"
    set changes [$tbl get $row]
    #puts "changes == $changes"

    set key [lindex $changes $primary_key]
    #puts "key == $key"
    #puts "primary_key_name == $primary_key_name"
    set changes2 [lindex $changes $col]
    regsub -all {'} $changes2 {\\u0027} changes2
    regsub -all {"} $changes2 {\\u0022} changes2
    #puts "changes2 == $changes2"

    #set changes [join $changes "','"]
    #regsub -all {\{} $changes {'} changes
    #regsub -all {\}} $changes {'} changes
    #regsub -all {@} $changes At changes

    #append values $changes
    #append values "'"

    # db eval [subst {INSERT INTO Names VALUES($values);}]
    db eval [subst {UPDATE $table_name SET $columnname = '$changes2' WHERE $primary_key_name =  '$key';}]
    return [string trimleft [string trimright $text]]
 }

 proc newRecord {tbl table_name} {
    global sock primary_key primary_key_name column_names
    set lastrow [expr [$tbl index end] -1]

    # this gets the highest value of the primary key, assuming that column is sorted in ascending  order in the tablelist.
    # that might not be a safe assumption, it might be better to get the key values with an SQL  command but this will do for now.
    # get the values in the last row in the table
    set lastindex [lindex [$tbl get $lastrow] $primary_key]

    # the primary_key variable has the column number of the primary key column.
    # this gets the value in that column in the last row and increments it by one.
    if {$lastindex != ""} {
        set lastindex [incr lastindex 1]
    } else {
        set lastindex 1
    }

    for {set x 0} {$x < [llength $column_names]} {incr x} {
        lappend new_row_data { }
    }

    # this inserts a new row in the table with the new index in the primary key column
    #$tbl insert end "{ } $lastindex { } { } { } { } { } { } { } { } { } { } { } { } { } { } { } { }"
    set new_row_data [lreplace $new_row_data $primary_key $primary_key $lastindex]
    $tbl insert end "$new_row_data"
    $tbl see end
    set new_row_data [join $new_row_data "\',\'"]
    set new_row_data "\'$new_row_data\'"
    puts $new_row_data
    #Eval_Remote $sock "db eval [subst {\{INSERT INTO Names VALUES(' ',$lastindex,' ',' ',' ',' ','  ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ');\}}]"
    db eval [subst {INSERT INTO $table_name VALUES($new_row_data);}]
 }

 # This is called whenever user clicks the delete selected row button when the cursor is focused on a  certain row
 proc deleteRecord {tbl table_name row primary_key} {

    set row_to_delete [eval $row]

    puts "table_name == $table_name"
    puts "row to delete == $row_to_delete"
    puts "primary_key == $primary_key"
    # get the value in the cell representing the primary key to pass later to the SQL DELETE command
    set primary_key_value [eval $tbl getcells $row_to_delete,$primary_key]
    puts "primary_key_value == $primary_key_value"
    # get the name of column with the primary key by querying the tablelist widget for the title on  the button at the top of the column
    # this will be passed to the SQL command for updating the database down below
    set columnname [$tbl columncget $primary_key -title]
    puts "columnname == $columnname"

    # Make a simple dialog to give user a chance to back out before it is too late.
    toplevel .are_you_sure
    label .are_you_sure.label -text "Are you sure you want to delte row $row_to_delete ?"
    pack .are_you_sure.label
    button .are_you_sure.yes -text "Yes, I AM sure" -command "
    destroy .are_you_sure
    # delete the row from the tablelist widget - has no actual effect on the SQLite database
    $tbl delete $row_to_delete
    # finally, delete the row from the Sqlite database itself.
    db eval {DELETE FROM $table_name WHERE $columnname = $primary_key_value}
    set sure_variable true
    "
    pack .are_you_sure.yes
    button .are_you_sure.no -text "No, I am NOT sure" -command {
        destroy .are_you_sure
        set sure_variable false
    }
    pack .are_you_sure.no
    tkwait variable sure_variable
 }

 proc newTable {} {
    global table_names

    set newTableName ""
    toplevel .newTable
    label .newTable.label -text "Table Name"
    pack .newTable.label
    entry .newTable.entry -textvariable newTableName
    pack .newTable.entry
    button .newTable.newField -text "Add Field" -command {
        set newFieldName ""
        set newFieldType ""
        toplevel .newField
        label .newField.label -text "Field Name"
        pack .newField.label
        entry .newField.entry -textvariable newFieldName
        pack .newField.entry
        menubutton .newField.menubutton -relief raised -text {Type Field} -indicatoron true -menu  .newField.menubutton.menu
        menu .newField.menubutton.menu
        .newField.menubutton.menu add radiobutton -label "TEXT" -variable newFieldType -value "TEXT"
        .newField.menubutton.menu add radiobutton -label "numeric" -variable newFieldType -value  "numeric"
        .newField.menubutton.menu add radiobutton -label "BLOB" -variable newFieldType -value "BLOB"
        .newField.menubutton.menu add radiobutton -label "INTEGER PRIMARY KEY" -variable newFieldType -value "INTEGER PRIMARY KEY"
        pack .newField.menubutton
        button .newField.done -text Done -command {
            lappend new_field_list "$newFieldName $newFieldType ,"
            puts $new_field_list

            destroy .newField
        }
        pack .newField.done

    }
    pack .newTable.newField
    button .newTable.create -text "Create Table" -command {
        if {![regexp $newTableName $table_names]} {

            if {[catch {
                    regsub -all {\}} $new_field_list {} new_field_list
                    regsub -all {\{} $new_field_list {} new_field_list
                    regsub {,$} $new_field_list {} new_field_list
                    puts $new_field_list
                } err]} {
                tk_dialog .error Error "You have to have at least one new field for your new table." error 0 OK
                return
            }
            set command [list db eval [subst {CREATE TABLE $newTableName ($new_field_list);}]]
            lappend table_names $newTableName
            puts $command