A Mini Database Manager
MDD: I was playing around with some of RS's terrific little Tcl utilities, and decided to try my hand at morphing his "A little database GUI" into a reasonably-capable little database manager that would allow one to create, edit and browse persistent database tables.
Make sure you include the "Tables.txt" and "Introduction.txt" file (shown at the end of the code, below) in the launch directory. The instructions for use are contained in the "Introduction" table.
BTW: The green button will open the console window (under Win32) for those who want to play around with direct db commands. For example, entering "Introduction" will return the full contents of the Introduction table, while entering "Introduction {B. Data manipulation syntax}" will return the contents of that record.
####### # # t-DB Mini Database Manager # by Mike Doyle ([email protected]) # based on Richard Suchenwirth's Little Database API, Little Database Gui, # and Persistent array utility # ####### proc persistentArray {arrName {filename {}}} { upvar 1 $arrName arr array set arr {} ;# to make sure it exists, and is an array if {$filename==""} {set filename $arrName.txt} set filename [file join [pwd] $filename] if [file exists $filename] { set fp [open $filename] array set arr [read $fp] close $fp } uplevel 1 [list trace add variable $arrName {write unset} [list persist'save $filename]] } proc persist'save {filename arrName el op} { upvar 1 $arrName arr switch -- $op { write {set value $arr($el)} unset {set value {}} } set fp [open $filename a] puts $fp [list $el $value] close $fp } proc db {table args} { upvar #0 $table db set key "" ;# in case args is empty foreach {- key item value} $args break set exists [info exists db($key)] set res {} switch [llength $args] { 0 { array set db {} ;# force to be an array interp alias {} $table {} db $table - set res $table } 1 {set res [array names db]} 2 {if {$key != ""} { if {$exists} {set res $db($key)} } else {array unset db} } 3 {if {$item != ""} { if {$exists} { set t $db($key) if {!([set pos [lsearch $t $item]]%2)} { set res [lindex $t [incr pos]] } } } elseif {$exists} {unset db($key)} } 4 { if {$exists} { if {!([set pos [lsearch $db($key) $item]]%2)} { if {$value != ""} { set db($key) [lreplace $db($key) [incr pos] $pos $value] } else {set db($key) [lreplace $db($key) $pos [incr pos]]} } elseif {$value != ""} { lappend db($key) $item $value } } elseif {$value != ""} {set db($key) [list $item $value]} set res $value ;# to be returned } default { if {[llength $args]%2} {error "non-paired item/value list"} foreach {item value} [lrange $args 2 end] { db $table - $key $item $value } } } set res } namespace eval db::ui { variable topic "" } ;# required before procs can be defined proc db::ui::browse {table} { global record current_table set record "" set current_table $table set t [toplevel .tpl] wm title $t "Mike's Mini Database Manager v.0.5" wm protocol $t WM_DELETE_WINDOW {exit} db $table set m1 [frame $t.top] listbox $m1.lb -bg white -height 5 -yscrollcommand [list $m1.y1 set] bind $m1.lb <ButtonRelease-1> [list db::ui::select %W %y Tables] bind $m1.lb <Double-ButtonRelease-1> {.tpl.main.lb delete 0 end; set current_table [.tpl.top.lb get @0,%y]; foreach i [lsort -dic [[.tpl.top.lb get @0,%y]]] {.tpl.main.lb insert end $i}; db::ui::htext2 .tpl.main.t [.tpl.top.lb get @0,%y] -yscrollcommand [list .tpl.main.y2 set]} scrollbar $m1.y1 -command [list $m1.lb yview] htexttop $m1.t Tables -yscrollcommand [list $m1.y2 set] scrollbar $m1.y2 -command [list $m1.t yview] eval pack [winfo children $m1] -side left -fill y pack $m1.t -fill both -expand 1 set b1 [frame $t.bottom1] button $b1.edit -text Edit -command {db::edit_table .tpl.bottom1.edit $record Tables} button $b1.new -text New -command {db::new_table .tpl.bottom1.new $record Tables} button $b1.del -text Delete -command {db::delete_table .tpl.bottom1.del $record Tables} label $b1.find -text Find: entry $b1.tofind bind $b1.tofind <Return> [list db::ui::find %W $m1.t Tables] button $b1.action -text " 0 " -background green -command {catch "console show"} eval pack [winfo children $b1] -side left -fill x pack $b1.tofind -expand 1 pack $b1 -side top -fill x foreach i [lsort -dic [Tables]] {$m1.lb insert end $i} set m [frame $t.main] listbox $m.lb -bg white -height 15 -yscrollcommand [list $m.y1 set] bind $m.lb <ButtonRelease-1> [list db::ui::select %W %y $table] scrollbar $m.y1 -command [list $m.lb yview] htext $m.t $table -yscrollcommand [list $m.y2 set] scrollbar $m.y2 -command [list $m.t yview] eval pack [winfo children $m] -side left -fill y pack $m.t -fill both -expand 1 set b [frame $t.bottom] button $b.edit -text Edit -command {db::edit_record .tpl.bottom.edit $record $current_table} button $b.new -text New -command {db::new_record .tpl.bottom.new $record $current_table} button $b.del -text Delete -command {db::delete_record .tpl.bottom.del $record $current_table} label $b.find -text Find: entry $b.tofind bind $b.tofind <Return> [list db::ui::find %W $m.t $table] button $b.action -text " ! " -command {db::ui::callback $db::ui::topic} eval pack [winfo children $b] -side left -fill x pack $b.tofind -expand 1 pack $b -side bottom -fill x pack $m1 -fill both -expand 0 pack $m -fill both -expand 1 foreach i [lsort -dic [$table]] {$m.lb insert end $i} set t } proc db::ui::callback args {} ;# redefine this for specific action proc db::ui::htext {w table args} { eval text $w -bg grey90 -padx 3 -wrap word -height 7 -width 50 $args $w tag config title -font {Times 12 bold} $w tag config link -foreground blue -underline 1 $w tag bind link <Enter> "$w config -cursor hand2" $w tag bind link <Leave> "$w config -cursor {}" $w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table] $w insert end \n\n$table\n\n title "Select topic from listbox" $w insert end "\n\n[llength [$table]] entries in table" set w } proc db::ui::htexttop {w table args} { eval text $w -bg grey90 -padx 3 -wrap word -height 7 -width 50 $args $w tag config title -font {Times 12 bold} $w tag config link -foreground blue -underline 1 $w tag bind link <Enter> "$w config -cursor hand2" $w tag bind link <Leave> "$w config -cursor {}" $w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table] $w insert end \n\n$table\n\n title "Double-click table name at left to view its records" set w } proc db::ui::htext2 {w table args} { $w delete 1.0 end $w tag config title -font {Times 12 bold} $w tag config link -foreground blue -underline 1 $w tag bind link <Enter> "$w config -cursor hand2" $w tag bind link <Leave> "$w config -cursor {}" $w tag bind link <ButtonRelease-1> [list db::ui::click %W %x %y $table] $w insert end \n\n$table\n\n title "Select topic from listbox" $w insert end "\n\n[llength [$table]] entries in table" bind .tpl.main.lb <ButtonRelease-1> [list db::ui::select %W %y $table] set w } proc db::ui::click {w x y table} { set range [$w tag prevrange link [$w index @$x,$y]] if [llength $range] { Show $w [eval $w get $range] $table } } proc db::ui::select {w y table} { global record set record [$w get @0,$y] Show [winfo parent $w].t [$w get @0,$y] $table } proc db::ui::Show {w title table} { variable topic set topic $title $w delete 1.0 end $w insert end $title\n title \n set titles [$table] foreach {item value} [$table $title] { if {$item == "@" && [file exists $value]} { set img [image create photo -file $value] $w image create 1.0 -image $img $w insert 1.1 " " } else { $w insert end $item\t foreach word $value { if {[lsearch $titles $word]>=0} {set tag link} else {set tag {}} $w insert end $word $tag " " } } $w insert end \n } } proc db::ui::find {w textw table} { set tofind [$w get] set found {} foreach key [$table] { set data [$table $key] if [regexp -indices -nocase ($tofind) $data -> pos] { lappend found [list $key [lindex $pos 0] $data] } } switch [llength $found] { 0 {error "No match for $tofind"} 1 {Show $textw [lindex [lindex $found 0] 0] $table} default {choice $textw $table $tofind $found} } } proc db::ui::choice {w table tofind found} { $w delete 1.0 end $w insert end "Search results for '$tofind':\n" title \n foreach pair $found { foreach {title pos data} $pair break set context [string range $data [expr $pos-15] [expr $pos+25]] $w insert end $title link \t...$context...\n "" pos=$pos\n } } proc db::edit_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.del configure -state disabled .tpl.bottom.new configure -state disabled .tpl.bottom.find configure -text Record: .tpl.bottom.tofind delete 0 end .tpl.bottom.tofind insert end "{$table} {$r} [$table $r]" .tpl.bottom.edit configure -command {eval [.tpl.bottom.tofind get]; .tpl.bottom.tofind delete 0 end; .tpl.bottom.find configure -text Find: db::ui::Show .tpl.main.t $record $current_table .tpl.bottom.edit configure -text Edit .tpl.bottom.del configure -state active .tpl.bottom.new configure -state active .tpl.bottom.edit configure -command {db::edit_record .tpl.bottom.edit $record $current_table}} } proc db::new_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.del configure -state disabled .tpl.bottom.edit configure -state disabled .tpl.bottom.find configure -text Record: .tpl.bottom.tofind delete 0 end .tpl.bottom.tofind insert end "$table {RECORD} {FIELD} {VALUE}" .tpl.bottom.new configure -command {eval [.tpl.bottom.tofind get]; set record [lindex [.tpl.bottom.tofind get] 1] .tpl.main.lb delete 0 end; foreach i [lsort -dic [$current_table]] {.tpl.main.lb insert end $i}; .tpl.bottom.tofind delete 0 end; .tpl.bottom.find configure -text Find: .tpl.bottom.del configure -state active .tpl.bottom.edit configure -state active db::ui::Show .tpl.main.t $record $current_table .tpl.bottom.new configure -text New .tpl.bottom.new configure -command {db::new_record .tpl.bottom.new $record $current_table}} } proc db::delete_record {w r table} { global record current_table $w configure -text Done .tpl.bottom.new configure -state disabled .tpl.bottom.edit configure -state disabled .tpl.bottom.find configure -text "Delete $r? Enter yes/no to confirm/cancel:" .tpl.bottom.tofind delete 0 end .tpl.bottom.del configure -command { if {[.tpl.bottom.tofind get] == "yes"} { .tpl.bottom.tofind delete 0 end .tpl.bottom.tofind insert end {$current_table $record ""} eval [.tpl.bottom.tofind get]; } .tpl.main.lb delete 0 end; foreach i [lsort -dic [$current_table]] {.tpl.main.lb insert end $i}; .tpl.bottom.tofind delete 0 end; .tpl.bottom.new configure -state active .tpl.bottom.edit configure -state active .tpl.bottom.find configure -text Find: .tpl.bottom.del configure -text Delete .tpl.main.t delete 1.0 end .tpl.bottom.del configure -command {db::delete_record .tpl.bottom.del $record $current_table} } } proc db::edit_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.del configure -state disabled .tpl.bottom1.new configure -state disabled .tpl.bottom1.find configure -text Record: .tpl.bottom1.tofind delete 0 end .tpl.bottom1.tofind insert end "{$table} {$r} [$table $r]" .tpl.bottom1.edit configure -command {eval [.tpl.bottom1.tofind get]; .tpl.bottom1.tofind delete 0 end; .tpl.bottom1.find configure -text Find: db::ui::Show .tpl.top.t $record Tables .tpl.bottom1.edit configure -text Edit .tpl.bottom1.del configure -state active .tpl.bottom1.new configure -state active .tpl.bottom1.edit configure -command {db::edit_table .tpl.bottom1.edit $record Tables}} } proc db::new_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.del configure -state disabled .tpl.bottom1.edit configure -state disabled .tpl.bottom1.find configure -text Record: .tpl.bottom1.tofind delete 0 end .tpl.bottom1.tofind insert end "$table {TABLENAME} Description: {DESCRIPTION TEXT}" $w configure -command {eval [.tpl.bottom1.tofind get]; set record [lindex [.tpl.bottom1.tofind get] 1] db $record persistentArray $record .tpl.top.lb delete 0 end; foreach i [lsort -dic [Tables]] {.tpl.top.lb insert end $i}; .tpl.bottom1.tofind delete 0 end; .tpl.bottom1.find configure -text Find: .tpl.bottom1.del configure -state active .tpl.bottom1.edit configure -state active db::ui::Show .tpl.top.t $record Tables .tpl.bottom1.new configure -text New .tpl.bottom1.new configure -command {db::new_record .tpl.bottom1.new $record Tables}} } proc db::delete_table {w r table} { global record current_table $w configure -text Done .tpl.bottom1.new configure -state disabled .tpl.bottom1.edit configure -state disabled .tpl.bottom1.find configure -text "Delete $r? Enter yes/no to confirm/cancel:" .tpl.bottom1.tofind delete 0 end .tpl.bottom1.del configure -command { if {[.tpl.bottom1.tofind get] == "yes"} { .tpl.bottom1.tofind delete 0 end .tpl.bottom1.tofind insert end {Tables $record ""} eval [.tpl.bottom1.tofind get]; } .tpl.top.lb delete 0 end; foreach i [lsort -dic [Tables]] {.tpl.top.lb insert end $i}; .tpl.bottom1.tofind delete 0 end; .tpl.bottom1.new configure -state active .tpl.bottom1.edit configure -state active .tpl.bottom1.find configure -text Find: .tpl.bottom1.del configure -text Delete .tpl.top.t delete 1.0 end .tpl.bottom1.del configure -command {db::delete_table .tpl.bottom1.del $record $current_table} } } wm withdraw . db Tables persistentArray Tables foreach i [lsort -dic [Tables]] {persistentArray $i; db $i} db::ui::browse Introduction
Prior to initial launch, put the following into a file called "Tables.txt" :
Introduction {Welcome: {\nThe Mini Database Manager is a simple demo application to show the ease with which small database applications can be implemented using a few of the wonderful little Tcl utilities created by Richard Suchenwirth.}}And also put the following into another file called "Introduction.txt" :
{A. Introduction} {Introduction {\n\nThe Mini Database Manager draws upon several useful utilities, created by Richard Suchenwirth, to provide a small interactive database manager in a greatly simplified manner. The system incorporates a combination of a keyword-less data manipulation syntax with a persistent array utility to provide an extremely lightweight interface for building and browsing a set of database tables. \n\n}}
{B. Data manipulation syntax} {Description: {\n\nThe data manipulation syntax represents each record as a string with four or more parts. \n\nFor example, the string {{Division Employee Name {Jim Shoe}}} would describe a table named {{Division}} with a record named {{Employee}} a field named {{Name}} and a value for that field of {{Jim Shoe}} . \n\nThe system uses a keyword-less query and data manipulation paradigm, so that entering a four-value string will create or modify a record, but just entering the first three values will return the data stored in the relevant field. \n\nEntering just two values would cause the entire record to be returned. Entering just the table name would cause the data for the entire table to be returned.\n\nThis GUI application is designed to simplify the task of creating tables, reating records, browsing those data, and manipulating them.}}
{C. Creating Tables} {Description: {\n\nTo start the task of creating a table, click the 'new' button at the top of the application window. You will be presented with 'Tables {{TABLENAME}} Description: {{DESCRIPTION TEXT}} .' Just replace the bracketed TABLENAME with your desired table name and DESCRIPTION TEXT with a short description of the table's purpose. Click 'Done" when you are finished. The new table name will appear in the table list to the upper left. To start creating records for this new table, be sure to first select it by double-clicking its name in the top list.}}
{D. Creating Records} {Description: {\n\nCreating records is very similar to the process of creating tables. To start the task of creating a record click the 'New' button at the BOTTOM of the application window. You will be presented with 'TABLENAME {{RECORD}} {{FIELD}} {{VALUE}} .' Just replace the bracketed RECORD with your desired record name, and follow it with at least one {{FIELD}} {{VALUE}} pair to simultaneously set up the fields of the table and populate them with data. Click 'Done' when you are finished. The new record name will appear in the table list to the bottom left. To browse the records, just click their names in the record list (bottom left) and each record's fields will be displayed in the frame to the right. \n\nAnother approach is to just include one FIELD VALUE pair when creating the record, then you can add additional fields by clicking 'New" and using the name of the record you want to add a field to, and using a new FIELD name before clicking 'Done.' The new field andvalue will be added to the list of record data in the record browsing frame to the right.}}
{E. Editing Records} {Description: {\n\nAn astute Tcl coder might have guessed by now that every time you click the 'Done" button during a New operation, you are actually just sending whatever is in the entrybox to the interpreter as a command. That's exactly what is happening. When you click the 'Edit' button, the current value for that record will be displayed in the entrybox. You can manually edit that value and then click 'Done' to replace the new value for the old one. The entire record is actually represented by a single Tcl array, in string form. Be careful not to corrupt the Tcl array string format, or you will get an error message when you try to click 'Done.' If you do get such an error, you can just kill the application and re-reun it to try again. Since your data resides in a persistent text file, you shouldn't have lost anything.}}MDD: It's little diversions like this that remind me why I've been a Tcl addict since 1995. ;-)
You can also download the app [L1 ] and the two startup tables [L2 ] and [L3 ], as well as a stand-alone Windows binary [L4 ]. If you use the binary (Tclkit'ed) version, you should still put the startup tables in the launch directory.
Note that you could also use the UPX'ed version of tclkit to reduce the download size further than the uncompressed one -jcw
Done. It's now only 863K. Thanks. --MDD
Question: is there a way to put the text files into the virtual filesystem of the application's scripted document?
I don't think so. Not unless you split them up into two files: Tclkit and the scripted doc. If you prove otherwise, please let me know. --MDD
That's correct. If everything is inside a single exe, then it can't be open r/w - the O/S won't allow it. This is one reason to use the 2-file tclkit/sd approach. Another possible split, is to have the exe contain the app, as it is now, but to create a secondary scripted doc and mount it - just to hold data:
vfs::mk4::Mount datafile.dat datafile.dat
Then, either do "cd datafile.dat" (which will look like a dir to Tcl once mounted), or write with the corresponding path:
set fd [open datafile.dat w]
puts $fd hi!
close $fdNote that the above mount will create the file if it did not exist. It's not "runnable" as a normal scripted doc, but it'll contain a VFS nevertheless. Tip: you can use "sdx lsd datafile.dat" to list the contents, and "sdx sd2fs datafile.dat" to unpack the contents to a normal directory hierarchy, as with other sd's. -jcw
PWQ, isn't the required process just a simple file copy , eg:
file copy $starkit::topdir/file.dat $env(TEMP)/file.dat
If that fails the kit can mount the internal file readonly and at least have readonly functionality.
BTW: If you stop the mk4 checkpoint, then starpacks can appear to be written to. The changes just disappear when you exit. Opens up the possibility for save on exit type operation. Worked under windows. I think linux just writes to the exe file regardless (at least as root), ymmv (almost a certainty under linux 2.0 as locking is advisary not hard).
I've also created a networked, client-server, version of this app, called A Mini Networked Database Manager. The results are pretty cool.