rpc-DB

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 var $arrName wu [list persist'save $filename]]
 }

 proc persist'save {filename arrName el op} {
    upvar 1 $arrName arr
    switch -- $op {
        w {set value $arr($el)}
        u {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