MDD:
I've made a pure-Tcl client/server DP-RPC-compatible version of my A Mini Database Manager. It requires the dp_RPC.tcl file to be in both the client and server launch directories.
BTW: You'll need the Tables.txt and Introduction.txt table files from A Mini Database Manager to be in the server's launch directory.
Here's the code for the server:
####### # # rpc-DB-srv Mini Database Manager server, based on Eolas' dp_RPC.tcl system # by Mike Doyle ([email protected]) # also based on Richard Suchenwirth's Little Database API, Little Database Gui, # and Persistent array utility # ####### source dp_RPC.tcl set port 8088 console show wm withdraw . global db dir result port set dir [pwd] proc quit {} { stop_server exit } proc start_server {} { global port puts "t-DB Server started on port: [dp_MakeRPCServer $port]" #add approved client hostname -- one line for each host puts [dp_Host +localhost] puts [dp_Host +205.229.151.3] } proc stop_server {} { global port dp_CloseRPC $port puts "Server stopped on port $port" } 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 } db Tables persistentArray Tables foreach i [lsort -dic [Tables]] {persistentArray $i; db $i} start_server # End server code ###########################
And here's the code for the client:
####### # # rpc-DB-clnt Mini Database Manager client, based on Eolas' dp_RPC.tcl system # by Mike Doyle ([email protected]) # also based on Richard Suchenwirth's Little Database API, Little Database Gui, # and Persistent array utility # ####### global host port server source dp_RPC.tcl set port 8088 # server ip or host name set server localhost namespace eval db::ui { variable topic "" } ;# required before procs can be defined proc db::ui::browse {table} { global record current_table host port set record "" set current_table $table set t [toplevel .tpl] wm title $t "Mike's Mini dp_RPC Database Manager v.0.5" wm protocol $t WM_DELETE_WINDOW {dp_CloseRPC $host; exit} dp_RPC $host 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 [dp_RPC $host [.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 [dp_RPC $host 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 [dp_RPC $host $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} { global host 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 [dp_RPC $host $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} { global host $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 [dp_RPC $host $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} { global host variable topic set topic $title $w delete 1.0 end $w insert end $title\n title \n set titles [dp_RPC $host $table] foreach {item value} [dp_RPC $host $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} { global host set tofind [$w get] set found {} foreach key [dp_RPC $host $table] { set data [dp_RPC $host $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 host $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} [dp_RPC $host $table $r]" .tpl.bottom.edit configure -command {eval dp_RPC $host [.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 host $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 dp_RPC $host [.tpl.bottom.tofind get]; set record [lindex [.tpl.bottom.tofind get] 1] .tpl.main.lb delete 0 end; foreach i [lsort -dic [dp_RPC $host $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 host $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 dp_RPC $host [.tpl.bottom.tofind get]; } .tpl.main.lb delete 0 end; foreach i [lsort -dic [dp_RPC $host $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 host $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} [dp_RPC $host $table $r]" .tpl.bottom1.edit configure -command {eval dp_RPC $host [.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 host $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 dp_RPC $host [.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 [dp_RPC $host 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 host $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 [dp_RPC $host 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 . if { [winfo exist .connect] == 0 } then { toplevel .connect wm title .connect "Remote Host:" frame .connect.f1 pack .connect.f1 -fill x pack [entry .connect.f1.e1 -width 20 -textvariable server] -side right pack [label .connect.f1.l1 -text "Hostname: "] -side right pack [frame .connect.f3] -fill x pack [button .connect.f3.b1 -text Clear -command { .connect.f1.e1 delete 0 end} ] -side left pack [button .connect.f3.b2 -text "Connect" -command { wm withdraw .connect set host [dp_MakeRPCClient $server $port] db::ui::browse Introduction }] -side left } #console show wm deiconify .connect # End client code ###########################
Enjoy! MDD