Listing 2: AdminLogDB

#!/usr/local/bin/wish -f

# -----------------------------------------------------
# AdminLogDB                         September 28, 1995
# Scott A. Tarvainen
# -----------------------------------------------------
# This TCL/TK wish program is a modification of the
# tkdb program written by Norman Walsh.  The AdminLogDB
# program is a graphical System Administrator Log
# program to allow system administration staff members
# to share information of technical/historical
# importance on a daily basis.
# Note:  The tkdb code is reprinted with Mr. Walsh's
#        consent.
# -----------------------------------------------------

#
# tkdb is a simple "database" editor.  A database is a collection of
# records with text fields.
#
# Copyright (C) 1994 by Norman Walsh
#
# In order to use tkdb, you must first create the database file headers
# with another editor.  Database files have the following format: line 1
# holds the database title, line 2 holds the field specification, and lines
# 3 through eof each hold a single record.
#
# The database field specification consists of an arbitrary number of fields.
# Each field consists of a fieldname and a length.  For example, "Name 30"
# identifies a field called "Name" that is 30 characters long.  Field names
# must not have imbeded commas (,) or semicolons (;).
#
# Fields that are seperated by commas are presented horizontally on the same
# line.  Fields that are seperated by semicolons are presented on seperate
# lines.
#
# Here's an example of a simple database of names and addresses
#
# Names and Addresses
# Name 30;Addr1 30;Addr2 30;City 25,State 2,Zip 10
#
# When displayed, it looks something like this:
#
# +----------------------------------------+
# |         Names and Addresses            |
# |                                        |
# | Name __________________________        |
# | Addr1 __________________________       |
# | Addr2 __________________________       |
# | City ____________ State __ Zip _______ |
# |                                        |
# +----------------------------------------+
#
#########################################################################

# Get the dbName from the arguments, use ~/.tkdbfile if
# none is provided
set arglist [ split $argv " " ]
if { [ llength $arglist ] > 0 } {
set dbName [ lindex $arglist 0 ]
} else {
set dbName "~/.tkdbfile"
}

# Make sure the database exists
if [ file exists "$dbName" ] {
set f [ open "$dbName" ]
} else {
puts stderr "The database file $dbName does not exist."
exit 1
}

# Read the database title and pack it into the frame
gets $f DatabaseTitle
label .title  -text "$DatabaseTitle" \
-font "-*-times-bold-r-*-*-*-180-*" \
-relief ridge

pack  .title -side top -padx 3m -pady 3m

# Load the field specification
if { [ gets $f FieldSpec ] < 0 } {
puts stderr "Cannot read field specification from $dbName."
exit 1
}

# In this context, linecount is lines in the window...
set linecount 0

set FieldCount 0

# Find the widest first field on the line
set ffWidth 0
# Parse the field specification
foreach line [ split $FieldSpec ";" ] {
set field [ lindex [ split $line "," ] 0 ]
if { [ regexp {(.*) ([0-9]+)} "$field" \
fmatch fname flength ] } {
if { [ string length $fname ] > $ffWidth } {
set ffWidth [ string length $fname ]
}
}
}

# Parse the field specification
foreach line [ split $FieldSpec ";" ] {
set linecount [incr linecount]
eval frame .line_$linecount

foreach field [ split $line "," ] {
set FieldCount [incr FieldCount]

if { [ regexp {(.*) ([0-9]+)} "$field" \
fmatch fname flength ] } {
eval label .lf$FieldCount \
-text {$fname} \
-width $ffWidth \
-anchor w
eval entry .ef$FieldCount -relief sunken \
-textvariable Fields($FieldCount) \
-width $flength

eval pack  .lf$FieldCount \
-side left -padx 1m \
-in .line_$linecount
eval pack  .ef$FieldCount \
-side left \
-padx 1m \
-in .line_$linecount
} else {
puts stderr "Error: bad field: $field";
exit 1;
}
}

eval pack .line_$linecount -side top -pady .5m -fill x
}

# Add the buttons and the "Record n of m" line to the
# bottom of the window

#------------------------------------------------------------#
# Print and Delete buttons added by Scott Tarvainen, CTI     #
# to be used in the System Administrator Log Program         #
#------------------------------------------------------------#

frame .crframe
frame .buttons
button .save -text "Save" -command "save"
button .quit -text "Quit" -command "quit"
button .print -text "Print" -command "print"
button .delete -text "Delete" -command "delete"
button .next -text "Next" -command "next 1"
button .prev -text "Prev" -command "next -1"
button .new  -text "New"  -command "new_rec"
pack .save .quit .print .delete .next .prev .new \
-in .buttons \
-side left -padx 1m
pack .buttons \
-side left \
-pady 1m \
-padx 5m \
-in .crframe

set RecNum 1
label .cr_record  -text "Record "
label .cr_current -textvariable RecNum
label .cr_of      -text " of "
label .cr_count   -textvariable RecordCount
pack  .cr_record .cr_current .cr_of .cr_count \
-side left \
-in .crframe

pack .crframe -side top

# We begin at record 1, so disable the "prev" button
.prev configure -state disabled

# Load all the records
set RecordCount 0
while { [ gets $f line ] >= 0 } {
set RecordCount [incr RecordCount]
set Records($RecordCount) "$line"
}

# If there's only one record, disable the "next" button
if { $RecordCount < 2 } {
.next configure -state disabled
}

# we don't need the database file anymore...
close $f

#------------------------------------------------------------#
# set input focus and keystroke bindings to allow carriage   #
# returns                                                    #
#------------------------------------------------------------#

focus .ef1

bind .ef1 <Return> {focus .ef2}
bind .ef2 <Return> {focus .ef3}
bind .ef3 <Return> {focus .ef4}
bind .ef4 <Return> {focus .ef5}
bind .ef5 <Return> {focus .ef6}
bind .ef6 <Return> {focus .ef7}
bind .ef7 <Return> {focus .ef8}
bind .ef8 <Return> {focus .ef9}
bind .ef9 <Return> {focus .ef10}
bind .ef10 <Return> {focus .ef11}
bind .ef11 <Return> {focus .ef12}
bind .ef12 <Return> {focus .ef1}

proc get_rec { } {
# Copy the contents of the current record into
# the Fields()
global Records RecordCount RecNum
global Fields FieldCount

for { set fieldcount 1 } \
{ $fieldcount <= $FieldCount } \
{ incr fieldcount } {
set Fields($fieldcount) ""
}

set fieldcount 0
set line $Records($RecNum)

foreach field [ split $line "|" ] {
set fieldcount [incr fieldcount]
eval set Fields($fieldcount) { $field }

if { $fieldcount == $FieldCount } break
}
}

proc set_rec { } {
# Copy the contents of the Fields() into
# the current record
global Records RecordCount RecNum
global Fields FieldCount
global Changed

set fieldcount 0
set line ""

for { set fieldcount 1 } \
{ $fieldcount <= $FieldCount } \
{ incr fieldcount } {
if { "$line" != "" } {
set line "$line|"
}
set line "$line$Fields($fieldcount)"
}

# Check to see if the record has been modified
if { "$Records($RecNum)" != "$line" } {
set Changed 1
}

set Records($RecNum) "$line"
}

proc save { } {
# Save the database
global DatabaseTitle FieldSpec
global Records RecordCount
global Changed
global dbName

set_rec

set f [ open "$dbName" "w" ]

puts $f "$DatabaseTitle"
puts $f "$FieldSpec"

for { set i 1 } { $i <= $RecordCount } { incr i } {
puts $f "$Records($i)"
}

close $f
set Changed 0
}

proc quit { } {
# Quit, making sure we don't accidentally lose
# any changes
global Changed

set_rec

set really_quit 1
if { $Changed } {
set really_quit [ confirm_quit ]
}

if { $really_quit } {
destroy .
exit 0
}
}

proc confirm_quit {} {
# Do you *really* want to lose those changes?
set reply [ tk_dialog .d "Are you sure?" \
"There are unsaved changes that will be lost, \
are you sure you want to quit?" \
warning 0 "Save" "Cancel" "Discard changes" ]

if { $reply == 0 } {
save
return 1
}

if { $reply == 2 } {
return 1
}

return 0
}

#------------------------------------------------------------#
# Procedure print_records added by Scott Tarvainen, CTI to   #
# create an ASCII output file that can be queued to the      #
# printer.  This ASCII file will be created and named        #
# "/tmp/printfile".  The last line of this procedure is an   #
# exec call to lpr to print to your printer.  This assumes   #
# the default printer 'lp' is set in your /etc/printcap file.#
#------------------------------------------------------------#

proc print_records {} {

global dbName
global Records RecordCount RecNum

set PrintFile "/tmp/printfile"
set f [ open "$PrintFile" "w" ]

if [ file exists "$dbName" ] {
set e [ open "$dbName" "r" ]
} else {
puts stderr "The database file $dbName does not exist."
exit 1
}

set count 0
while { [ gets $e line ] >= 0 } {
set count [ incr count ]
if { $count == 1 } {
puts $f "               ============================================"
puts $f "              $line"
puts $f "               ============================================"
puts $f ""
}

if { $count > 2 } {
set fieldcount 0
foreach field [ split $line "|" ] {
set fieldcount [ incr fieldcount ]
set MYFields($fieldcount) "$field"
}
puts $f "               Time           Administrator"
puts $f "               ----           -------------"
puts $f "               $MYFields(2)          $MYFields(1)"
puts $f ""

for { set j 3 } { $j <= $fieldcount } { incr j } {
if { $MYFields($j) != "" } {
puts $f "               $MYFields($j)"
}
}
puts $f ""
puts $f "               ############################################"
puts $f ""
}
}
close $e
close $f
exec lpr /tmp/printfile
}

#------------------------------------------------------------#
# Procedure print added by Scott Tarvainen, CTI to allow the #
# user the option to Save and Print the Sysadmin Log, Ignore #
# Changes and Print, or to Cancel.                           #
#------------------------------------------------------------#

proc print {} {

global DatabaseTitle FieldSpec dbName
global Records RecordCount RecNum
global Fields FieldCount Changed

set_rec

if { $Changed } {
set reply [ tk_dialog .d "Print Option" \
"There are unsaved changes \
to the database" \
warning 0 "Save Changes & Print" \
"Ignore Changes & Print" "Cancel" ]

if { $reply == 0 } {
save
print_records

} elseif { $reply == 1 } {
print_records

} else {
}
} else {
print_records
}
}

#------------------------------------------------------------#
# Procedure delete added by Scott Tarvainen, CTI to give the #
# user the option to delete a record from the Sysadmin Log.  #
#------------------------------------------------------------#

proc delete {} {

global DatabaseTitle FieldSpec dbName
global Records RecordCount RecNum
global Fields FieldCount Changed

if { $RecordCount < 2 } {
for { set fieldcount 1 } \
{ $fieldcount <= $FieldCount } \
{ incr fieldcount } {
set Fields($fieldcount) ""
}
.next configure -state disabledd
set Changed 1

} else {
if { $RecNum == $RecordCount } {
set RecNum [ incr RecNum -1 ]
set RecordCount [ incr RecordCount -1 ]
get_rec
.next configure -state disabled
set Changed 1

} else {
set MinusCount [ incr RecordCount -1 ]
for { set i $RecNum } { $i <= $MinusCount } \
{incr i 1 } {
set j $i
set NextRecord [ incr j 1 ]
set Records($i) "$Records($NextRecord)"
}

if { $RecNum > 1 } {
set RecNum [ incr RecNum -1 ]
get_rec
} else {
set RecNum 1
get_rec
.prev configure -state disabled
}
set Changed 1
}
}

if { $RecNum == $RecordCount } {
.next configure -state disabled
}
if { $RecNum < 2 } {
.prev configure -state disabled
}
}

proc next direction {
# Move forward or backward, updating the buttons
global RecNum RecordCount

set_rec

set nextrec [ incr RecNum $direction ]

if { $nextrec == 1 } {
.prev configure -state disabled
} else {
.prev configure -state active
}

if { $nextrec == $RecordCount } {
.next configure -state disabled
} else {
.next configure -state active
}

set RecNum $nextrec

get_rec
}

proc new_rec {} {
# Create a new record
global RecNum RecordCount Records
global Changed

if { $RecordCount > 0 } {
set_rec
}

set RecordCount [ incr RecordCount ]
set RecNum $RecordCount

set Records($RecNum) ""

get_rec

.prev configure -state disabled
.next configure -state disabled

if { $RecNum > 1 } {
.prev configure -state active
}

set Changed 1
}

# If there are no records, create one
if { $RecordCount == 0 } {
new_rec
}

set Changed 0

get_rec

# "wish" will take over here and begin processing
# button and entry events..

# End of File