Source code for the Tcl/Tk Rolodex server. This application assumes that spynergy.tcl is in the launch directory.




########################################
#   Rolodex RPC server, an Internet database server using the Web Fusion database Engine
#     by Mike Doyle -- modified for Spynergy RPC by Hengbing Duan on August 29, 1997
#
#  Copyright (c) 1997 Eolas Technologies Inc.
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details
########################################

source spynergy.tcl
set port 8088


global db dir result port

set dir [pwd] 
  
proc quit {} {

	stop_server
	exit
}

proc start_server {} {
global port

	puts "Rolodex 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 db_open {} {
    global db dir result
    if {[info exists db]} {dbClose db}
    if {![file exist $dir/rolodex.idx]} {
	 dbCreate $dir db rolodex "NAME STREET CITY STATE ZIP PHONE FAX CELL COMPANY C_STREET C_CITY C_STATE C_ZIP C_PHONE C_FAX  C_CELL EMAIL PERSONALWEB WORKWEB PAGER PGPFINGERPRINT PGPKEY NOTES"
    } 
    dbOpen $dir db
}

proc db_sort {} {
   global db dir result
   set first 1	
   if {![file exist $dir/sorted.idx]} {
        dbCreate $dir db sorted "NAME STREET CITY STATE ZIP PHONE FAX CELL COMPANY C_STREET C_CITY C_STATE C_ZIP C_PHONE C_FAX  C_CELL EMAIL PERSONALWEB WORKWEB PAGER PGPFINGERPRINT PGPKEY NOTES"
   } 

   foreach seqno [dbuSort db rolodex NAME] {
	dbGetRow db sorted $first
	dbGetRow db rolodex $seqno
	set db(sorted,NAME)  $db(rolodex,NAME) 
	set db(sorted,STREET) $db(rolodex,STREET) 
	set db(sorted,CITY) $db(rolodex,CITY) 
	set db(sorted,STATE) $db(rolodex,STATE) 
	set db(sorted,ZIP) $db(rolodex,ZIP) 
	set db(sorted,PHONE) $db(rolodex,PHONE) 
	set db(sorted,FAX) $db(rolodex,FAX) 
	set db(sorted,CELL) $db(rolodex,CELL) 
	set db(sorted,COMPANY) $db(rolodex,COMPANY) 
	set db(sorted,C_STREET) $db(rolodex,C_STREET) 
	set db(sorted,C_CITY) $db(rolodex,C_CITY) 
	set db(sorted,C_STATE) $db(rolodex,C_STATE) 
	set db(sorted,C_ZIP) $db(rolodex,C_ZIP) 
	set db(sorted,C_PHONE) $db(rolodex,C_PHONE) 
	set db(sorted,C_FAX) $db(rolodex,C_FAX) 
	set db(sorted,C_CELL) $db(rolodex,C_CELL) 
	set db(sorted,EMAIL) $db(rolodex,EMAIL) 
	set db(sorted,PERSONALWEB) $db(rolodex,PERSONALWEB) 
	set db(sorted,WORKWEB) $db(rolodex,WORKWEB) 
	set db(sorted,PAGER) $db(rolodex,PAGER) 
	set db(sorted,PGPFINGERPRINT) $db(rolodex,PGPFINGERPRINT) 
	set db(sorted,PGPKEY) $db(rolodex,PGPKEY) 
	set db(sorted,NOTES) $db(rolodex,NOTES) 

	dbPutRow db sorted
	incr first
   }

   dbClose db
   file copy rolodex.idx rolobak.idx
   file copy rolodex.tbl rolobak.tbl
   file copy sorted.idx rolodex.idx
   file copy sorted.tbl rolodex.tbl
   file del sorted.idx
   file del sorted.tbl
	
   db_open
   set seqno 1
   dbGetRow db rolodex $seqno
#### this should be called by whatever function in client after db_sort
#   db_display_record
}


### the following functions are basically wrapper functions for
### manipulation of db.

#### ready for new row
proc db_getfield { fieldname } {
   global db
   return $db(rolodex,$fieldname)
}
### set the value for a single field of current row
proc db_setfield { fieldname value } {
   global db
   set db(rolodex,$fieldname) "[restore_space $value]"
}

proc db_new_row {} {
  global db
  dbNewRow db rolodex
}

proc db_put_row {} {
  global db
  dbPutRow db rolodex
}

proc db_search_string { type value } {
  global db
  dbuSearchString db rolodex $type $value 
}

proc db_get_row { seqno } {
  global db
  dbGetRow db rolodex $seqno
}

proc db_prev_row {} {
  global db
  dbPrevRow db rolodex
}

proc db_next_row {} {
  global db
  dbNextRow db rolodex
} 

proc db_last_row {} {
  global db
  dbLastRow db rolodex
}

proc db_del_row { seqno } {
  global db
  dbDelRow db rolodex $seqno
}

proc db_close {} {
  global db
  dbClose db
}


### replace "{}" back to space
proc restore_space { value } {
  if { $value == "null" } then {
     return ""
  }   
  regsub -all "{}" $value " " x
  return $x
}

start_server