Snapshot replication tool
Started by Dan Gowinalmost 27 years ago1 messages
Latest output that the Snapshot PostgreSQL replication tool outputs to
a borne shell script. PostgreSQL v6.4 needs to be installed. This script
can run alone on the command line or under CRON control. Snapshot
uses a named pipe to send output from "pg_dump" to "psql" and use
the environment variables to setup passwords and user id's.
<<t2.sh>>
Snapshot as developed in Tcl/Tk.
<<SNAPSHOT.TCL>>
Some example configuration files.
<<t2.snp>> <<t3.snp>> <<testcfg.snp>>
Opinions?
D. Gowin
Attachments:
SNAPSHOT.TCLapplication/octet-stream; name=SNAPSHOT.TCLDownload
#!/usr/bin/wish
#********************************************************
# Program....: snapshot.tcl
# Author.....: Dan Gowin
# Date.......: 12/17/98
# Notice.....: Copyright(c) 1998, , All Rights Reserved.
# Note.......: This is a scripting program designed to
# ...........: generate "borne" shell scripts for PostgreSQL
# ...........: replication processes. PostgreSQL client
# ...........: software must be loaded to execute the
# ...........: generated script.
# ...........:
#
#********************************************************
# Version
set SNVERS 0.7
set SNRELEASE "12/18/98"
set SNMAIL "kraken@blueriver.net"
set SNDOCS "http://www.coolsql.com"
set SNHTTP "http://www.coolsql.com"
# Dummy Data.
set from_server [list ]
set from_server_port [list ]
set from_user [list ]
set from_passwd [list ]
set from_database [list ]
set to_server [list ]
set to_server_port [list ]
set to_user [list ]
set to_passwd [list ]
set to_database [list ]
# Global data types.
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
# Setup the main application window.
set win .lstuser
frame $win
global win
global indx
# Initialize file system.
set initialdir [pwd]
global initialdir
set filename "Snap"
global filename
# Setup dialog window for editing.
set editwin .cruser
global editwin
# Open a file and source it.
proc file_open_get {} {
global initialdir
global filename
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set file_types {
{ "Snapshot File" { .snp } }
}
set filename [tk_getOpenFile \
-initialdir $initialdir \
-filetypes $file_types \
-title "Open Snapshot file - $filename" \
-parent .]
if {$filename != ""} {
set initialdir [file dirname $filename]
source $filename
Fill_all_list
}
}
# Save a file with the Tcl lists.
proc file_save_as {} {
global initialdir
global filename
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set file_types {
{ "Snapshot File" { .snp } }
}
set file_name [tk_getSaveFile \
-initialdir $initialdir \
-filetypes $file_types \
-title "Open Snapshot file - $filename" \
-parent .]
if {$filename != ""} {
set initialdir [file dirname $filename]
set filename "$file_name.snp"
save_all_lists $filename
}
}
# Check to see if there is a file to save.
proc file_save {} {
global filename
if {[string compare "Snap" $filename] == 0} {
file_save_as
} else {
save_all_lists $filename
}
}
# save the list data to a file
proc save_all_lists { file_name } {
global initialdir
global filename
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
# Create file if it doesn't exist, over write if it does.
set fh_name [open $file_name w]
puts -nonewline $fh_name "set from_server \[list "
foreach item $from_server {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set from_server_port \[list "
foreach item $from_server_port {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set from_user \[list "
foreach item $from_user {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set from_passwd \[list "
foreach item $from_passwd {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set from_database \[list "
foreach item $from_database {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set to_server \[list "
foreach item $to_server {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set to_server_port \[list "
foreach item $to_server_port {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set to_user \[list "
foreach item $to_user {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set to_passwd \[list "
foreach item $to_passwd {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
puts -nonewline $fh_name "set to_database \[list "
foreach item $to_database {puts -nonewline $fh_name "$item "}; puts $fh_name "\]"
close $fh_name
}
# Make shell script (bash).
proc make_file_as {} {
global initialdir
global filename
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set file_types {
{ "Shell File" { .sh } }
}
set file_name [tk_getSaveFile \
-initialdir $initialdir \
-filetypes $file_types \
-title "Create Snapshot shell file - $filename" \
-parent .]
if {$filename != ""} {
set initialdir [file dirname $filename]
set filename "$file_name.sh"
set fl_handle [open $filename w]
puts $fl_handle "#!/bin/sh"
puts $fl_handle "/sbin/mknod snap_pipe p"
set len [llength $from_server]
for {set i 0} {$i < $len} {incr i} {
# Set the recieving server.
puts $fl_handle "####################"
set temp_str [lindex $to_server $i]
puts $fl_handle "PGHOST=$temp_str"
set temp_str [lindex $to_server_port $i]
puts $fl_handle "PGPORT=$temp_str"
set temp_str [lindex $to_user $i]
puts $fl_handle "PGUSER=$temp_str"
set temp_str [lindex $to_passwd $i]
puts $fl_handle "PGPASSWORD=$temp_str"
set temp_str [lindex $to_database $i]
puts $fl_handle "PGDATABASE=$temp_str"
# Start recieving.
puts $fl_handle "psql -c < snap_pipe &"
# Set the sending server.
set temp_str [lindex $from_server $i]
puts $fl_handle "PGHOST=$temp_str"
set temp_str [lindex $from_server_port $i]
puts $fl_handle "PGPORT=$temp_str"
set temp_str [lindex $from_user $i]
puts $fl_handle "PGUSER=$temp_str"
set temp_str [lindex $from_passwd $i]
puts $fl_handle "PGPASSWORD=$temp_str"
set temp_str [lindex $from_database $i]
if {[string compare "All" $temp_str] == 0} {
puts $fl_handle "PGDATABASE=template1"
# Start sending.
puts $fl_handle "pg_dump_all > snap_pipe "
} else {
puts $fl_handle "PGDATABASE=$temp_str"
# Start sending.
puts $fl_handle "pg_dump > snap_pipe "
}
}
close $fl_handle
}
}
# The scroll list holds a list of the widgets
# to scroll. This must be a list. The args
# hold all the remaining arguments, which
# come from the scrollbar. All these are
# passed to each widget in the scroll_list.
#
proc multi_scroll { scroll_list args } {
# Get info on list of listboxes
set len [llength $scroll_list]
for {set i 0} {$i < $len} {incr i} {
set temp_list [lindex $scroll_list $i]
eval $temp_list yview $args
}
}
# Fill in list with various data.
#
proc FillList { listvar datalist} {
foreach item $datalist {
eval $listvar insert end {$item}
}
}
# Fill lists with data.
proc Fill_all_list {} {
global win
global from_server
global from_server_port
global from_database
global to_server
global to_server_port
$win.frame.frame1.list1 delete 0 end
$win.frame.frame2.list1 delete 0 end
$win.frame.frame3.list1 delete 0 end
$win.frame.frame5.list1 delete 0 end
$win.frame.frame6.list1 delete 0 end
FillList $win.frame.frame1.list1 $from_server
FillList $win.frame.frame2.list1 $from_database
FillList $win.frame.frame3.list1 $from_server_port
FillList $win.frame.frame5.list1 $to_server
FillList $win.frame.frame6.list1 $to_server_port
}
# Basic menu choices for file submenu.
# Clean out "New" the data.
proc New_list {} {
global win
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set from_server [list ]
set from_server_port [list ]
set from_user [list ]
set from_passwd [list ]
set from_database [list ]
set to_server [list ]
set to_server_port [list ]
set to_user [list ]
set to_passwd [list ]
set to_database [list ]
# Fill the screen
Fill_all_list
}
# Exit from the program.
proc tkmyexit {} {
set result [tk_messageBox -parent . \
-title {Quit} -type okcancel \
-icon question \
-message "Are you sure you want to quit?"]
if {[string compare "ok" $result] == 0} {
exit
}
}
# Test for the server.
proc test_server { fserv fport fuser fpasswd fdatabase tserv tport tuser tpasswd tdatabase } {
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set connres 0
# Test the "from" server.
#set connres [catch {set newdbc [pg_connect -conninfo "host=$fserv port=$fport dbname=$fdatabase user=$fuser password=$fpasswd"]} msg]
if {$connres} {
tk_messageBox -parent . \
-title {From Error} -type ok \
-icon warning \
-message "Error trying to connect to database \"$fdatabase\" on host $fserv\n\nPostgreSQL error message: $msg?"
} else {
#catch {pg_disconnect $dbc}
}
lappend from_server $fserv
lappend from_server_port $fport
lappend from_user $fuser
lappend from_passwd $fpasswd
lappend from_database $fdatabase
# Test the "to" server.
#set connres [catch {set newdbc [pg_connect -conninfo "host=$tserv port=$tport dbname=$tdatabase user=$tuser password=$tpasswd"]} msg]
if {$connres} {
tk_messageBox -parent . \
-title {To Error} -type ok \
-icon warning \
-message "Error trying to connect to database \"$tdatabase\" on host $tserv\n\nPostgreSQL error message: $msg?"
} else {
#catch {pg_disconnect $dbc}
}
lappend to_server $tserv
lappend to_server_port $tport
lappend to_user $tuser
lappend to_passwd $tpasswd
lappend to_database $tdatabase
Fill_all_list
}
# Test for the server and replace element in list.
proc repl_server { indx fserv fport fuser fpasswd fdatabase tserv tport tuser tpasswd tdatabase } {
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set connres 0
# Test the "from" server.
#set connres [catch {set newdbc [pg_connect -conninfo "host=$fserv port=$fport dbname=$fdatabase user=$fuser password=$fpasswd"]} msg]
if {$connres} {
tk_messageBox -parent . \
-title {From Error} -type ok \
-icon warning \
-message "Error trying to connect to database \"$fdatabase\" on host $fserv\n\nPostgreSQL error message: $msg?"
} else {
#catch {pg_disconnect $dbc}
}
# Test the "to" server.
#set connres [catch {set newdbc [pg_connect -conninfo "host=$tserv port=$tport dbname=$tdatabase user=$tuser password=$tpasswd"]} msg]
if {$connres} {
tk_messageBox -parent . \
-title {To Error} -type ok \
-icon warning \
-message "Error trying to connect to database \"$tdatabase\" on host $tserv\n\nPostgreSQL error message: $msg?"
} else {
#catch {pg_disconnect $dbc}
}
#lreplace $from_server $findx $findx $fserv
set len [llength $from_server]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_server $i]
}
set from_server [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_server [lindex $temp_list $i]
} else {
lappend from_server $fserv
}
}
#lreplace $from_server_port $findx $findx $fport
set len [llength $from_server_port]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_server_port $i]
}
set from_server_port [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_server_port [lindex $temp_list $i]
} else {
lappend from_server_port $fport
}
}
#lreplace $from_user $findx $findx $fuser
set len [llength $from_user]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_user $i]
}
set from_user [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_user [lindex $temp_list $i]
} else {
lappend from_user $fuser
}
}
#lreplace $from_passwd $findx $findx $fpasswd
set len [llength $from_passwd]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_passwd $i]
}
set from_passwd [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_passwd [lindex $temp_list $i]
} else {
lappend from_passwd $fpasswd }
}
#lreplace $from_database $findx $findx $fdatabase
set len [llength $from_database]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_database $i]
}
set from_database [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_database [lindex $temp_list $i]
} else {
lappend from_database $fdatabase }
}
#lreplace $to_server $findx $findx $tserv
set len [llength $to_server]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_server $i]
}
set to_server [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_server [lindex $temp_list $i]
} else {
lappend to_server $tserv }
}
#lreplace $to_server_port $findx $findx $tport
set len [llength $to_server_port]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_server_port $i]
}
set to_server_port [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_server_port [lindex $temp_list $i]
} else {
lappend to_server_port $tport }
}
#lreplace $to_user $findx $findx $tuser
set len [llength $to_user]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_user $i]
}
set to_user [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_user [lindex $temp_list $i]
} else {
lappend to_user $tuser }
}
#lreplace $to_passwd $findx $findx $tpasswd
set len [llength $to_passwd]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_passwd $i]
}
set to_passwd [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_passwd [lindex $temp_list $i]
} else {
lappend to_passwd $tpasswd }
}
#lreplace $to_database $findx $findx $tdatabase
set len [llength $to_database]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_database $i]
}
set to_database [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_database [lindex $temp_list $i]
} else {
lappend to_database $tdatabase }
}
Fill_all_list
}
# Test for the server and replace element in list.
proc delete_server { indx } {
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
set len [llength $from_server]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_server $i]
}
set from_server [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_server [lindex $temp_list $i]
}
}
set len [llength $from_server_port]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_server_port $i]
}
set from_server_port [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_server_port [lindex $temp_list $i]
}
}
set len [llength $from_user]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_user $i]
}
set from_user [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_user [lindex $temp_list $i]
}
}
set len [llength $from_passwd]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_passwd $i]
}
set from_passwd [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_passwd [lindex $temp_list $i]
}
}
set len [llength $from_database]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $from_database $i]
}
set from_database [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend from_database [lindex $temp_list $i]
}
}
set len [llength $to_server]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_server $i]
}
set to_server [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_server [lindex $temp_list $i]
}
}
set len [llength $to_server_port]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_server_port $i]
}
set to_server_port [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_server_port [lindex $temp_list $i]
}
}
set len [llength $to_user]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_user $i]
}
set to_user [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_user [lindex $temp_list $i]
}
}
set len [llength $to_passwd]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_passwd $i]
}
set to_passwd [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_passwd [lindex $temp_list $i]
}
}
set len [llength $to_database]; set temp_list {}
for {set i 0} {$i < $len} {incr i} {
lappend temp_list [lindex $to_database $i]
}
set to_database [list ]
for {set i 0} {$i < $len} {incr i} {
if { $i != $indx } {
lappend to_database [lindex $temp_list $i]
}
}
Fill_all_list
}
# Edit menu.
# Add to lists.
proc add_lists {} {
global editwin
toplevel $editwin
wm title $editwin {Add Definition}
focus $editwin
grab $editwin
# set a main window
frame $editwin.topmain -bd 0
# From Database server?
frame $editwin.topmain.fr -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.fr.from -text "FROM"
label $editwin.topmain.fr.fromserver -text "SERVER"
label $editwin.topmain.fr.server -text "Host: "
entry $editwin.topmain.fr.servername -width 20 -textvariable fromserver
label $editwin.topmain.fr.port -text "Port: "
entry $editwin.topmain.fr.portname -width 5 -textvariable fromport
label $editwin.topmain.fr.db -text "Database: "
entry $editwin.topmain.fr.dbname -width 20 -textvariable fromdb
label $editwin.topmain.fr.user -text "User: "
entry $editwin.topmain.fr.username -width 20 -textvariable fromuser
label $editwin.topmain.fr.passwd -text "Password: "
entry $editwin.topmain.fr.passwdname -width 20 -textvariable frompasswd -show "*"
grid config $editwin.topmain.fr.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.fr.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.fr.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.fr.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.fr.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.fr.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.fr.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.fr.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.fr.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.fr.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.fr.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.fr.passwdname -column 1 -row 5 -sticky snew
# To Database server?
frame $editwin.topmain.to -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.to.from -text "TO"
label $editwin.topmain.to.fromserver -text "SERVER"
label $editwin.topmain.to.server -text "Host: "
entry $editwin.topmain.to.servername -width 20 -textvariable toserver
label $editwin.topmain.to.port -text "Port: "
entry $editwin.topmain.to.portname -width 5 -textvariable toport
label $editwin.topmain.to.db -text "Database: "
entry $editwin.topmain.to.dbname -width 20 -textvariable todb
label $editwin.topmain.to.user -text "User: "
entry $editwin.topmain.to.username -width 20 -textvariable touser
label $editwin.topmain.to.passwd -text "Password: "
entry $editwin.topmain.to.passwdname -width 20 -textvariable topasswd -show "*"
grid config $editwin.topmain.to.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.to.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.to.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.to.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.to.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.to.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.to.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.to.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.to.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.to.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.to.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.to.passwdname -column 1 -row 5 -sticky snew
# Default settings.
$editwin.topmain.fr.portname delete 0 end
$editwin.topmain.fr.portname insert end "5432"
$editwin.topmain.to.portname delete 0 end
$editwin.topmain.to.portname insert end "5432"
$editwin.topmain.fr.dbname delete 0 end
$editwin.topmain.fr.dbname insert end "All"
$editwin.topmain.to.dbname delete 0 end
$editwin.topmain.to.dbname insert end "template1"
# Cancel OK buttons.
frame $editwin.the_frame -bd 0
button $editwin.the_frame.ok -text "OK" \
-command { test_server $fromserver $fromport $fromuser \
$frompasswd $fromdb $toserver $toport $touser $topasswd $todb ;destroy $editwin}
button $editwin.the_frame.cancel -text "Cancel" -command {destroy $editwin}
pack $editwin.the_frame.ok $editwin.the_frame.cancel -side left -padx 5 -pady 5
pack $editwin.topmain.fr -side left -fill x -ipady 6 -ipadx 4
pack $editwin.topmain.to -side right -fill x -ipady 6 -ipadx 4
pack $editwin.topmain -side top -fill x -ipady 6 -ipadx 4
pack $editwin.the_frame -side bottom
tkwait window .cruser
}
# Edit menu.
# Edit lists.
proc edit_lists {} {
global win
global editwin
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
global indx
toplevel $editwin
wm title $editwin {Edit Definition}
focus $editwin
grab $editwin
# set a main window
frame $editwin.topmain -bd 0
# From Database server?
frame $editwin.topmain.fr -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.fr.from -text "FROM"
label $editwin.topmain.fr.fromserver -text "SERVER"
label $editwin.topmain.fr.server -text "Host: "
entry $editwin.topmain.fr.servername -width 20 -textvariable fromserver
label $editwin.topmain.fr.port -text "Port: "
entry $editwin.topmain.fr.portname -width 5 -textvariable fromport
label $editwin.topmain.fr.db -text "Database: "
entry $editwin.topmain.fr.dbname -width 20 -textvariable fromdb
label $editwin.topmain.fr.user -text "User: "
entry $editwin.topmain.fr.username -width 20 -textvariable fromuser
label $editwin.topmain.fr.passwd -text "Password: "
entry $editwin.topmain.fr.passwdname -width 20 -textvariable frompasswd -show "*"
grid config $editwin.topmain.fr.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.fr.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.fr.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.fr.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.fr.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.fr.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.fr.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.fr.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.fr.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.fr.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.fr.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.fr.passwdname -column 1 -row 5 -sticky snew
# To Database server?
frame $editwin.topmain.to -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.to.from -text "TO"
label $editwin.topmain.to.fromserver -text "SERVER"
label $editwin.topmain.to.server -text "Host: "
entry $editwin.topmain.to.servername -width 20 -textvariable toserver
label $editwin.topmain.to.port -text "Port: "
entry $editwin.topmain.to.portname -width 5 -textvariable toport
label $editwin.topmain.to.db -text "Database: "
entry $editwin.topmain.to.dbname -width 20 -textvariable todb
label $editwin.topmain.to.user -text "User: "
entry $editwin.topmain.to.username -width 20 -textvariable touser
label $editwin.topmain.to.passwd -text "Password: "
entry $editwin.topmain.to.passwdname -width 20 -textvariable topasswd -show "*"
grid config $editwin.topmain.to.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.to.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.to.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.to.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.to.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.to.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.to.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.to.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.to.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.to.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.to.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.to.passwdname -column 1 -row 5 -sticky snew
# Default settings.
# Get the index from a mouse click.
set indx [$win.frame.frame1.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame2.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame3.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame5.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame6.list1 curselection]
if { $indx == "" } {
tk_messageBox -parent . \
-title {Edit Error} -type ok \
-icon warning \
-message "Please choose a record to edit."
destroy $editwin
return
}
}
}
}
}
# Set the screen.
# From List
$editwin.topmain.fr.servername delete 0 end
$editwin.topmain.fr.servername insert end [lindex $from_server $indx ]
$editwin.topmain.fr.portname delete 0 end
$editwin.topmain.fr.portname insert end [lindex $from_server_port $indx ]
$editwin.topmain.fr.dbname delete 0 end
$editwin.topmain.fr.dbname insert end [lindex $from_database $indx ]
$editwin.topmain.fr.username delete 0 end
$editwin.topmain.fr.username insert end [lindex $from_user $indx ]
$editwin.topmain.fr.passwdname delete 0 end
$editwin.topmain.fr.passwdname insert end [lindex $from_passwd $indx ]
# To list
$editwin.topmain.to.servername delete 0 end
$editwin.topmain.to.servername insert end [lindex $to_server $indx ]
$editwin.topmain.to.portname delete 0 end
$editwin.topmain.to.portname insert end [lindex $to_server_port $indx ]
$editwin.topmain.to.dbname delete 0 end
$editwin.topmain.to.dbname insert end [lindex $to_database $indx ]
$editwin.topmain.to.username delete 0 end
$editwin.topmain.to.username insert end [lindex $to_user $indx ]
$editwin.topmain.to.passwdname delete 0 end
$editwin.topmain.to.passwdname insert end [lindex $to_passwd $indx ]
# Cancel OK buttons.
frame $editwin.the_frame -bd 0
button $editwin.the_frame.ok -text "OK" \
-command { repl_server $indx $fromserver $fromport $fromuser \
$frompasswd $fromdb $toserver $toport $touser $topasswd $todb ;destroy $editwin}
button $editwin.the_frame.cancel -text "Cancel" -command {destroy $editwin}
pack $editwin.the_frame.ok $editwin.the_frame.cancel -side left -padx 5 -pady 5
pack $editwin.topmain.fr -side left -fill x -ipady 6 -ipadx 4
pack $editwin.topmain.to -side right -fill x -ipady 6 -ipadx 4
pack $editwin.topmain -side top -fill x -ipady 6 -ipadx 4
pack $editwin.the_frame -side bottom
tkwait window .cruser
}
# Edit menu.
# Delete element in lists.
proc delete_lists {} {
global win
global editwin
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
global indx
toplevel $editwin
wm title $editwin {Delete Definition}
focus $editwin
grab $editwin
# set a main window
frame $editwin.topmain -bd 0
# From Database server?
frame $editwin.topmain.fr -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.fr.from -text "FROM"
label $editwin.topmain.fr.fromserver -text "SERVER"
label $editwin.topmain.fr.server -text "Host: "
entry $editwin.topmain.fr.servername -width 20 -textvariable fromserver
label $editwin.topmain.fr.port -text "Port: "
entry $editwin.topmain.fr.portname -width 5 -textvariable fromport
label $editwin.topmain.fr.db -text "Database: "
entry $editwin.topmain.fr.dbname -width 20 -textvariable fromdb
label $editwin.topmain.fr.user -text "User: "
entry $editwin.topmain.fr.username -width 20 -textvariable fromuser
label $editwin.topmain.fr.passwd -text "Password: "
entry $editwin.topmain.fr.passwdname -width 20 -textvariable frompasswd -show "*"
grid config $editwin.topmain.fr.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.fr.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.fr.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.fr.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.fr.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.fr.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.fr.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.fr.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.fr.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.fr.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.fr.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.fr.passwdname -column 1 -row 5 -sticky snew
# To Database server?
frame $editwin.topmain.to -borderwidth 1 -relief raised
# Data entry fields.
label $editwin.topmain.to.from -text "TO"
label $editwin.topmain.to.fromserver -text "SERVER"
label $editwin.topmain.to.server -text "Host: "
entry $editwin.topmain.to.servername -width 20 -textvariable toserver
label $editwin.topmain.to.port -text "Port: "
entry $editwin.topmain.to.portname -width 5 -textvariable toport
label $editwin.topmain.to.db -text "Database: "
entry $editwin.topmain.to.dbname -width 20 -textvariable todb
label $editwin.topmain.to.user -text "User: "
entry $editwin.topmain.to.username -width 20 -textvariable touser
label $editwin.topmain.to.passwd -text "Password: "
entry $editwin.topmain.to.passwdname -width 20 -textvariable topasswd -show "*"
grid config $editwin.topmain.to.from -column 0 -row 0 -sticky e
grid config $editwin.topmain.to.fromserver -column 1 -row 0 -sticky e
grid config $editwin.topmain.to.server -column 0 -row 1 -sticky e
grid config $editwin.topmain.to.servername -column 1 -row 1 -sticky snew
grid config $editwin.topmain.to.port -column 0 -row 2 -sticky e
grid config $editwin.topmain.to.portname -column 1 -row 2 -sticky snew
grid config $editwin.topmain.to.db -column 0 -row 3 -sticky e
grid config $editwin.topmain.to.dbname -column 1 -row 3 -sticky snew
grid config $editwin.topmain.to.user -column 0 -row 4 -sticky e
grid config $editwin.topmain.to.username -column 1 -row 4 -sticky snew
grid config $editwin.topmain.to.passwd -column 0 -row 5 -sticky e
grid config $editwin.topmain.to.passwdname -column 1 -row 5 -sticky snew
# Default settings.
# Get the index from a mouse click.
set indx [$win.frame.frame1.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame2.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame3.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame5.list1 curselection]
if { $indx == "" } {
set indx [$win.frame.frame6.list1 curselection]
if { $indx == "" } {
tk_messageBox -parent . \
-title {Edit Error} -type ok \
-icon warning \
-message "Please choose a record to edit."
destroy $editwin
return
}
}
}
}
}
# Set the screen.
# From List
$editwin.topmain.fr.servername delete 0 end
$editwin.topmain.fr.servername insert end [lindex $from_server $indx ]
$editwin.topmain.fr.portname delete 0 end
$editwin.topmain.fr.portname insert end [lindex $from_server_port $indx ]
$editwin.topmain.fr.dbname delete 0 end
$editwin.topmain.fr.dbname insert end [lindex $from_database $indx ]
$editwin.topmain.fr.username delete 0 end
$editwin.topmain.fr.username insert end [lindex $from_user $indx ]
$editwin.topmain.fr.passwdname delete 0 end
$editwin.topmain.fr.passwdname insert end [lindex $from_passwd $indx ]
# To list
$editwin.topmain.to.servername delete 0 end
$editwin.topmain.to.servername insert end [lindex $to_server $indx ]
$editwin.topmain.to.portname delete 0 end
$editwin.topmain.to.portname insert end [lindex $to_server_port $indx ]
$editwin.topmain.to.dbname delete 0 end
$editwin.topmain.to.dbname insert end [lindex $to_database $indx ]
$editwin.topmain.to.username delete 0 end
$editwin.topmain.to.username insert end [lindex $to_user $indx ]
$editwin.topmain.to.passwdname delete 0 end
$editwin.topmain.to.passwdname insert end [lindex $to_passwd $indx ]
# Cancel OK buttons.
frame $editwin.the_frame -bd 0
button $editwin.the_frame.ok -text "Delete" \
-command {delete_server $indx ;destroy $editwin}
button $editwin.the_frame.cancel -text "Cancel" -command {destroy $editwin}
pack $editwin.the_frame.ok $editwin.the_frame.cancel -side left -padx 5 -pady 5
pack $editwin.topmain.fr -side left -fill x -ipady 6 -ipadx 4
pack $editwin.topmain.to -side right -fill x -ipady 6 -ipadx 4
pack $editwin.topmain -side top -fill x -ipady 6 -ipadx 4
pack $editwin.the_frame -side bottom
tkwait window .cruser
}
## tkConAbout - gives about info for SNAPSHOT
##
;proc tkConAbout {} {
global tk_patchLevel tcl_patchLevel tcl_platform
global SNVERS SNMAIL SNRELEASE SNDOCS SNHTTP
global w1
set w1 .about
toplevel $w1
wm title $w1 "About Snapshot v$SNVERS"
button $w1.b -text Dismiss -command [list wm withdraw $w1]
text $w1.text -height 9 -bd 1 -width 60
pack $w1.b -fill x -side bottom
pack $w1.text -fill both -side left -expand 1
$w1.text tag config center -justify center
if {[string compare unix $tcl_platform(platform)] \
|| [info tclversion] >= 8} {
$w1.text tag config title -justify center -font {Courier 18 bold}
} else {
$w1.text tag config title -justify center -font *Courier*Bold*18*
}
$w1.text insert 1.0 "About Snapshot v$SNVERS\n\n" title \
"Copyright (c) 1998, Emerald City Solutions, Ltd.\
\nCopyright (c) 1998, RakeKniven Internet Technologies \
\nE-Mail:$SNMAIL\
\n$SNHTTP\
\nRelease Date: v$SNVERS, $SNRELEASE \
\nDocumentation available at:\n$SNDOCS\
\nUsing: Tcl v$tcl_patchLevel / Tk v$tk_patchLevel" center
$w1.text config -state disabled
}
##############################################################################
# Main screen
#
# Build the listbox frames with column headers.
proc snmain {} {
global win
global from_server
global from_server_port
global from_user
global from_passwd
global from_database
global to_server
global to_server_port
global to_user
global to_passwd
global to_database
frame $win.frame -borderwidth 1 -relief raised
frame $win.frame.frame1
label $win.frame.frame1.label -text "From Server" -relief raised
listbox $win.frame.frame1.list1 \
-borderwidth 1 \
-relief raised \
-selectmode single \
-yscrollcommand ".lstuser.frame.scrl set" -relief sunken
frame $win.frame.frame2
label $win.frame.frame2.label -text "Database" -relief raised
listbox $win.frame.frame2.list1 \
-borderwidth 1 \
-relief raised \
-selectmode single \
-yscrollcommand ".lstuser.frame.scrl set" -relief sunken
frame $win.frame.frame3
label $win.frame.frame3.label -text "Port" -relief raised
listbox $win.frame.frame3.list1 \
-borderwidth 1 \
-relief raised \
-selectmode single \
-yscrollcommand ".lstuser.frame.scrl set" -relief sunken
frame $win.frame.frame4
label $win.frame.frame4.label -text "->"
frame $win.frame.frame5
label $win.frame.frame5.label -text "To Server" -relief raised
listbox $win.frame.frame5.list1 \
-borderwidth 1 \
-relief raised \
-selectmode single \
-yscrollcommand ".lstuser.frame.scrl set" -relief sunken
frame $win.frame.frame6
label $win.frame.frame6.label -text "Port" -relief raised
listbox $win.frame.frame6.list1 \
-borderwidth 1 \
-relief raised \
-selectmode single \
-yscrollcommand ".lstuser.frame.scrl set" -relief sunken
# Fill lists with data.
Fill_all_list
# Pack the lists and labels together.
pack $win.frame.frame1.label $win.frame.frame1.list1 -fill x
pack $win.frame.frame2.label $win.frame.frame2.list1 -fill x
pack $win.frame.frame3.label $win.frame.frame3.list1 -fill x
pack $win.frame.frame4.label
pack $win.frame.frame5.label $win.frame.frame5.list1 -fill x
pack $win.frame.frame6.label $win.frame.frame6.list1 -fill x
pack $win.frame.frame1 $win.frame.frame2 \
$win.frame.frame3 $win.frame.frame4 \
$win.frame.frame5 $win.frame.frame6 -side left
scrollbar .lstuser.frame.scrl -command \
{ multi_scroll { .lstuser.frame.frame1.list1 \
.lstuser.frame.frame2.list1 \
.lstuser.frame.frame3.list1 \
.lstuser.frame.frame5.list1 \
.lstuser.frame.frame6.list1 } \
}
pack $win.frame.scrl -side right -fill y
# Build the menu system.
# Menu file.
frame $win.the_menu -borderwidth 1 -relief raised
menubutton $win.the_menu.file -text "File" -menu $win.the_menu.file.menu
pack $win.the_menu.file -side left
menu $win.the_menu.file.menu -tearoff 0
$win.the_menu.file.menu add command -label "New" -command {New_list }
$win.the_menu.file.menu add command -label "Open" -command {file_open_get}
$win.the_menu.file.menu add command -label "Save" -command {file_save}
$win.the_menu.file.menu add command -label "Save As" -command {file_save_as}
$win.the_menu.file.menu add separator
$win.the_menu.file.menu add command -label "Print" -command {set aa "a"}
$win.the_menu.file.menu add separator
$win.the_menu.file.menu add command -label "Exit" -command {tkmyexit}
# Menu edit.
menubutton $win.the_menu.edit -text "Edit" -menu $win.the_menu.edit.menu
pack $win.the_menu.edit -side left
menu $win.the_menu.edit.menu -tearoff 0
$win.the_menu.edit.menu add command -label "Add" -command {add_lists }
$win.the_menu.edit.menu add command -label "Edit" -command {edit_lists }
$win.the_menu.edit.menu add command -label "Delete" -command {delete_lists}
$win.the_menu.edit.menu add separator
$win.the_menu.edit.menu add command -label "Make" -command {make_file_as}
$win.the_menu.edit.menu add command -label "Run" -command {set aa "a"}
# Menu help.
menubutton $win.the_menu.help -text "Help" -menu $win.the_menu.help.about
pack $win.the_menu.help -side right
menu $win.the_menu.help.about -tearoff 0
$win.the_menu.help.about add command -label "About" -command {tkConAbout}
frame $win.the_frame -bd 0
button $win.the_frame.add -text "Add" -command {add_lists }
button $win.the_frame.edit -text "Edit" -command {edit_lists }
button $win.the_frame.delete -text "Delete" -command {delete_lists}
button $win.the_frame.make -text "Make" -command {make_file_as}
button $win.the_frame.run -text "Run" -command {set aa "a"}
button $win.the_frame.print -text "Print" -command {set aa "a"}
#pack $win.the_frame.left.ok -side left -padx 5 -pady 5
pack $win.the_frame.add \
$win.the_frame.edit \
$win.the_frame.delete \
$win.the_frame.make \
$win.the_frame.run \
$win.the_frame.print -side left -padx 2 -pady 2
pack $win.the_menu -side top -anchor w -fill x
pack $win.the_frame -anchor w
pack $win.frame -fill x -ipady 6 -ipadx 4
pack $win
}
# Load the PostgreSQL libraries
global tcl_platform
if {[string toupper $tcl_platform(platform)]=="WINDOWS"} {
#load libpgtcl.dll
} else {
#load libpgtcl.so
}
snmain