#!/usr/freeware/bin/wish -f
# ok, here's my attempt to make a tcl/tk script for controlling an
# autoloader.  this is what I think it should do:
#
# mtx -f /dev/changer status ; mtx -f /dev/changer status
# (note: the wankiness of the above command is to accommodate irix weirdness)
#
# parse this to get number of data transfer elements (i.e. robot arms), 
# number of drives, and number of tape slots
#
# lay out main tape panel based on this; each elememt (robot arm, tape slot,
# drive) should be laid out a big fat button that will be 'depressed' to 
# indicate status -- i.e. a loaded drive will be down/unloaded will be up,
# the tape slot that's currently loaded in the drive will be down, a slot 
# w/o a tape will be represented as (n) where n is the slot number 
# instead of as just n...  ok, so that's not really on the button topic, but 
# it's related.
#
# right click each "button" to bring up a list of actions: unload drive, 
# load slot, move tape, etc.  well, I guess I can't do right click with Tcl/Tk
# buttons, so clicking the button will just pop up a little menu.  ha.
# update 11 oct 2000: yay for me!  I got right-click to work.
#
# well, that should be complicated enough for starters...
#
# This code (c) 2000 by Dan Wright.  Licensed under the GPL; see
# http://www.gnu.org/copyleft/gpl.html for details.
#
# one further note: I disclaim all responsibilty for anything this program
# does.  It works for me, but if it breaks your shit and/or causes the
# end of the world...well, caveat emptor.
#
# e-mail xy@evilblobbie.com (that's me) with questions and/or praise.  flames
# > /dev/null, please.

######################## USER CONFIGURABLE VARIABLES #########################
set mtx "/usr/freeware/bin/mtx -f /dev/changer"  
                               # set this to your mtx command
set mtxprecmd "( $mtx status > /dev/null 2>&1 ) ; " 
#set mtxprecmd ""
                               # use this if you need to execute something to
                               # tell your changer to work right
array set tapedevs {1 /dev/nrtape}
                               # this array should be set to your tape drive
															 # devices; the array is specified like
															 # {1 /dev/tape1 2 /dev/tape2 3 /dev/tape3 ...}
set mt "/sbin/mt -f "
                               # set this to your system's mt command, 
															 # minus the tape device.
set defdrive 1
                               # set this to the your default drive number
															 # (i.e. the drive you use the most)

###################### END USER CONFIGURABLE VARIABLES #######################

global mtx mtxprecmd mt tapedevs

append cmd $mtxprecmd
append cmd $mtx
append cmd " status"
set status [exec /bin/sh -c "$cmd"]

# ok, now we need to parse the status output.

regexp {:[0-9]+[ ]Drives} $status drives
regexp {[0-9]+} $drives numdrives

regexp {[0-9]+[ ]Slots} $status slots
regexp {[0-9]+} $slots numslots

regexp {[0-9]+[ ]Import/Export} $status imptexpt
regexp {[0-9]+} $imptexpt numimptexpt

global numdrives numslots numimptexpt

# now we have number of drives, number of tape slots, and number of 
# import/export slots.  now decide status of these changer parts.

if {$numdrives>0} {
	for {set i 1} {$i<=$numdrives} {incr i} {
		set pattern "Data Transfer Element [expr $i-1]:Full \\(Storage Element \[0-9\]+ Loaded\\)"
		puts $pattern
		if { [regexp $pattern $status loaded] } {
			regexp {[0-9]+ Loaded} $loaded temp
			regexp {[0-9]+} $temp drivestat($i)
			# note: this may be broken.  since my autoloader has only one drive,
			# I don't know how status output for multiple drives would look, 
			# therefore it probably won't parse right for multiple drives.
		} else { set drivestat($i) 0 }
	}
}

global drivestat

# find slot status.
if {$numslots>0} {
	for {set i 1} {$i<=$numslots} {incr i} {
		set pattern "Storage Element $i:Full"
		set result [regexp $pattern $status slotfull]
		if { $result } {
			set slotstat($i) 1
		} else {
			set slotstat($i) 0
		}
	}
}

global slotstat

if {$numimptexpt>0} {
	# do nothing for now.  I don't know what should be done with an 
	# import/export slot anyway, since I don't have one.
}

# now I guess we need to lay out the window and stuff.

wm title . "Autoloader Interface"
wm resizable . 0 0
frame .mbar -relief raised -bd 2
frame .dummy -width 10
pack .mbar .dummy -side top -fill x

menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu
menubutton .mbar.session -text Session -underline 0 -menu .mbar.session.menu
pack .mbar.file -side left
pack .mbar.session -side left

menu .mbar.file.menu -tearoff 0
.mbar.file.menu add command -label Exit -command exit

menu .mbar.session.menu -tearoff 0
.mbar.session.menu add command -label "Tape Status" -command "Tape_Status {1}"
.mbar.session.menu add command -label "Changer Status" -command Changer_Status
.mbar.session.menu add command -label "Refresh" -command Refresh_Main

tk_menuBar .mbar .mbar.file .mbar.session
focus .mbar

set ncols [expr ($numslots-1) / 10]
incr ncols
frame .tapeslots -width [expr $ncols*200] -height [expr $numslots*50] -relief groove -borderwidth 2
frame .drives -width [expr $ncols*200] -height [expr $numdrives*50] -relief groove -borderwidth 2
#frame .imptexpt -width 200 -height [expr $numimptexpt*50] -relief groove -borderwidth 2
pack .tapeslots .drives -side top -fill x

for {set i 1} {$i<=$numslots} {incr i} {
	if {$slotstat($i)==1} { 
		menubutton .tapeslots.button$i -text "$i" -height 2 -state normal -direction right -relief raised -menu .tapeslots.button$i.menu
	} else {
		menubutton .tapeslots.button$i -text "($i)" -height 2 -state disabled -direction right -relief raised -menu .tapeslots.button$i.menu
	}

	menu .tapeslots.button$i.menu -tearoff 0
	.tapeslots.button$i.menu add command -label "Load tape to default drive" -command "Load_Drive {$i} {$defdrive}"
	.tapeslots.button$i.menu add cascade -label "Load tape to drive" -menu .tapeslots.button$i.menu.drivenums$i
	.tapeslots.button$i.menu add cascade -label "Transfer tape to slot" -menu .tapeslots.button$i.menu.slotnums$i

	menu .tapeslots.button$i.menu.drivenums$i -tearoff 0
	menu .tapeslots.button$i.menu.slotnums$i -tearoff 0
	for {set j 1} {$j<=$numdrives} {incr j} {
		.tapeslots.button$i.menu.drivenums$i add command -label "$j " -command "Load_Drive {$i} {$j}"
	}
	for {set j 1} {$j<=$numslots} {incr j} {
		if {$j!=$i} {
			.tapeslots.button$i.menu.slotnums$i add command -label "$j " -command "Move_Tape {$i} {$j}"
		}
	}

	pack .tapeslots.button$i -side top -fill x
}

for {set i 1} {$i<=$numdrives} {incr i} {
	if {$drivestat($i)>0} {
		menubutton .drives.button$i -text "Drive $i: Tape $drivestat($i) Loaded" -height 2 -state normal -direction right -relief raised -menu .drives.button$i.menu
	} else {
		menubutton .drives.button$i -text "Drive $i: Not Loaded" -height 2 -state disabled -direction right -relief raised -menu .drives.button$i.menu
	}

	menu .drives.button$i.menu -tearoff 0
	.drives.button$i.menu add command -label "Unload drive" -command "Unload_Drive {$i}"
	.drives.button$i.menu add cascade -label "Unload drive to slot" -menu .drives.button$i.menu.slots$i

	menu .drives.button$i.menu.slots$i -tearoff 0
	for {set j 1} {$j<=$numslots} {incr j} {
		.drives.button$i.menu.slots$i add command -label "$j " -command "Unload_Drive_to_N {$j} {$i}"
	}
	
	pack .drives.button$i -side top -fill x
}

# let's try this right click thing...
# ok, the right click thing works.  I wonder if we can use window events 
# to make status output work too?  nope.  damn.  maybe I have to use another
# interpreter or something.
for {set i 1} {$i<=$numslots} {incr i} {
	bind .tapeslots.button$i <Button-3> "Popup_Menu_If slot $i %X %Y"
	bind .tapeslots.button$i <<WORKING-SLOT$i>> ".tapeslots.button$i configure -text 'Working...'"
}

for {set i 1} {$i<=$numdrives} {incr i} {
	bind .drives.button$i <Button-3> "Popup_Menu_If drive $i %X %Y"
	bind .tapeslots.button$i <<WORKING-DRIVE$i>> ".drives.button$i configure -text 'Working...'"
}

#
# ok, so that completes the window layout.  now I need to write a bunch of 
# functions to make the window useful!
#

proc Tape_Status {n} {
	global mtx mtxprecmd mt tapedevs drivestat
  toplevel .tapestat
  wm title .tapestat "Tape Status"
  wm resizable .tapestat 0 0
  set font ""

  # get our tape info
	append cmd $mt
	append cmd $tapedevs($n)
	append cmd " stat"
 	set p [exec /bin/sh -c "$cmd" |& cat -]
	# I'm sure you're wondering about that weird cat thing above.  Well, it's 
	# there because IRIX's mt prints all information to stderr, and that's the
	# best way I could figure to do the redirection in Tcl.

  frame .tapestat.disp -relief groove -borderwidth 2
  label .tapestat.disp.text -justify left -text $p
  frame .tapestat.bottom -relief groove -borderwidth 2
  button .tapestat.ok -text "OK" -command {destroy .tapestat}
  pack .tapestat.disp .tapestat.disp.text .tapestat.bottom .tapestat.ok -side top -fill x
}

proc Changer_Status { } {
	global mtx mtxprecmd mt tapedevs
  toplevel .changerstat
  wm title .changerstat "Changer Status"
  wm resizable .changerstat 0 0
  set font ""

  # get our tape info
	append cmd $mtxprecmd
	append cmd $mtx
	append cmd " status"
  set p [exec /bin/sh -c "$cmd"]

  frame .changerstat.disp -relief groove -borderwidth 2
  label .changerstat.disp.text -justify left -text $p
  frame .changerstat.bottom -relief groove -borderwidth 2
  button .changerstat.ok -text "OK" -command {destroy .changerstat}
  pack .changerstat.disp .changerstat.disp.text .changerstat.bottom .changerstat.ok -side top -fill x	
}

proc Unload_Drive {drive} {
	global drivestat
	Unload_Drive_to_N $drivestat($drive) $drive
}

proc Unload_Drive_to_N {slot drive} {
	global mtx mtxprecmd mt tapedevs drivestat slotstat
	# this unloads the specified drive.

	if {$slotstat($slot)==1} {
    toplevel .sloterror
    wm title .sloterror "problem loading slot"
    wm resizable .sloterror 0 0
    set font ""
    frame .sloterror.disp -relief groove -borderwidth 2
    label .sloterror.disp.text -justify left -text "ERROR: Destination slot already full!\n(perhaps you should send the tape to an empty slot?)"
    frame .sloterror.disp.bottom -relief groove -borderwidth 2
    button .sloterror.ok -text "OK" -command {destroy .sloterror}
    pack .sloterror.disp .sloterror.disp.text .sloterror.disp.bottom .sloterror.ok -side top -fill x
  }
  if {$slotstat($slot)==1} { return }

	append cmd $mt
	append cmd $tapedevs($drive)
	append cmd " unload && ( "
	append cmd $mtxprecmd
	append cmd $mtx
	append cmd " unload $slot [expr $drive-1] > /dev/null 2>&1 )"
	# output must go to /dev/null because "mtx unload" spits out info on stderr,
	# which tcl interprets as an error condition and won't continue.

	# let's give some indication that we're doing something...
	event generate .tapeslots.button$slot <<WORKING-SLOT$slot>>
	event generate .drives.button$drive <<WORKING-DRIVE$drive>>

	exec /bin/sh -c "$cmd"

	# now update the main window to reflect the new state.

	set loaded $drivestat($drive)
	set drivestat($drive) 0

	.drives.button$drive configure -state disabled -text "Drive $drive: Not Loaded"
	.tapeslots.button$slot configure -state normal -text "$slot"
}

proc Load_Drive {slot drive} {
  global mtx mtxprecmd mt tapedevs drivestat slotstat
	# this function loads the specified drive from the specified slot.

	# if the drive's already full...then I guess you're screwed.
	if {$drivestat($drive)>0} {
		toplevel .driveerror
		wm title .driveerror "problem loading drive"
		wm resizable .driveerror 0 0
		set font ""
		frame .driveerror.disp -relief groove -borderwidth 2
		label .driveerror.disp.text -justify left -text "ERROR: Destination drive already full!"
		frame .driveerror.disp.bottom -relief groove -borderwidth 2
		button .driveerror.ok -text "OK" -command {destroy .driveerror}
		pack .driveerror.disp .driveerror.disp.text .driveerror.disp.bottom .driveerror.ok -side top -fill x
	}
	if {$drivestat($drive)>0} {
		return
	}

	append cmd $mtxprecmd
	append cmd $mtx
	append cmd " load $slot [expr $drive-1]"
	# ok, so indexing drives from 1 works well everywhere but here, because mtx
	# indexes drives from 0.  So, drive has to be $n-1.

	# working indication.
	event generate .tapeslots.button$slot <<WORKING-SLOT$slot>>
	event generate .drives.button$drive <<WORKING-DRIVE$drive>>

	exec /bin/sh -c "$cmd"

	# now update main window.

	set drivestat($drive) $slot
	set slotstat($slot) 0

	.drives.button$drive configure -state normal -text "Drive $drive: Tape $slot Loaded"
	.tapeslots.button$slot configure -state disabled -text "($slot)"
}

proc Move_Tape {source dest} {
	# this will move a tape between slots
	global mtx mtxprecmd mt tapedevs drivestat slotstat numslots
	
	if {$slotstat($source)==0 || $slotstat($dest)==1} {
    toplevel .sloterror
    wm title .sloterror "problem loading slot"
    wm resizable .sloterror 0 0
    set font ""
    frame .sloterror.disp -relief groove -borderwidth 2
    label .sloterror.disp.text -justify left -text "ERROR: Destination slot already full, or source slot empty!"
    frame .sloterror.disp.bottom -relief groove -borderwidth 2
    button .sloterror.ok -text "OK" -command {destroy .sloterror}
    pack .sloterror.disp .sloterror.disp.text .sloterror.disp.bottom .sloterror.ok -side top -fill x
	}
	if {$slotstat($source)==0 || $slotstat($dest)==1} { return }

	# if there's no problem, let's keep going.

	append cmd $mtxprecmd
	append cmd $mtx
	append cmd " transfer $source $dest"

	event generate .tapeslots.button$source <<WORKING-SLOT$source>>
	event generate .tapeslots.button$dest <<WORKING-SLOT$dest>>

	exec /bin/sh -c "$cmd"

	set slotstat($source) 0
	set slotstat($dest) 1
	.tapeslots.button$source configure -state disabled -text "($source)"
	.tapeslots.button$dest configure -state normal -text "$dest"
}

proc Refresh_Main { } {
	# this will refresh the main display window, in case something was externally
	# modified.
	# called from the session menu.

	global mt mtx mtxprecmd numdrives numslots numimptexpt drivestat slotstat
	
	append cmd $mtxprecmd
	append cmd $mtx
	append cmd " status"

	set status [exec /bin/sh -c "$cmd"]

	# decide status of the changer parts.

	if {$numdrives>0} {
  	for {set i 1} {$i<=$numdrives} {incr i} {
    	if { [regexp {\(Storage[ ]Element[ ][0-9]+[ ]Loaded\)} $status loaded] } {
      	regexp {[0-9]+} $loaded drivestat($i)
      	# note: this may be broken.  since my autoloader has only one drive,
      	# I don't know how status output for multiple drives would look,
      	# therefore it probably won't parse right for multiple drives.
    	} else { set drivestat($i) 0 }
  	}
	}

	# find slot status.
	if {$numslots>0} {
  	for {set i 1} {$i<=$numslots} {incr i} {
    	set pattern "Storage Element $i:Full"
    	set result [regexp $pattern $status slotfull]
    	if { $result } {
      	set slotstat($i) 1
    	} else {
      	set slotstat($i) 0
    	}
  	}
	}

	for {set i 1} {$i<=$numdrives} {incr i} {
  	if {$drivestat($i)>0} {
    	.drives.button$i configure -text "Drive $i: Tape $drivestat($i) Loaded" -state normal
  	} else {
    	.drives.button$i configure -text "Drive $i: Not Loaded" -state disabled 
  	}
	}

	for {set i 1} {$i<=$numslots} {incr i} {
		if {$slotstat($i)==1} {
			.tapeslots.button$i configure -text "$i" -state normal
		} else {
			.tapeslots.button$i configure -text "($i)" -state disabled
		}
	}
}

proc Popup_Menu_If {type n x y} {
	global slotstat drivestat
	if {![string compare $type slot]} {
		set statvar "slotstat"
		set menu "tapeslots"
	} elseif {![string compare $type drive]} {
		set statvar "drivestat"
		set menu "drives"
	} else { return }

	if {[set ${statvar}($n)]} {
		tk_popup .$menu.button$n.menu $x $y
	}
}
