#!/usr/local/bin/wish8
##!/bin/sh
## \
#exec wish8 $0 $@

# NAME
#   H_cache - Maintain a URL cache for other processes
#
# SYNOPSIS
#   H_cache [Dir]
#
# DESCRIPTION	
#   This program accepts commands from other tk  processes  to  fetch
#   URLs  and  cache  them in a directory.  When the file is ready, a
#   message is sent to the processes notifying them of its path.
#
#   A client process requests a cached file via:
#     send H_cache Find <name> <URL> <command>
#   where <name> is the client's name and <URL> is the desired  file.
#   If  the  file is cached, its local pathname will be returned.  If
#   the file isn't in the cache, the return value will be  null,  and
#   we  remember  the  <name>  and  the  <command>.  When the file is
#   available in the cache, we do:
#     send <name> <command> <path> <URL>
#   to notify the client that the file is available.  Note that we add
#   the local path and the original URL to the command's list of args,
#   so the proc in the client should be expecting the extra args.
#
# ENVIRONMENT
#
#   CACHEDIR
#     This is used for the  cache  directory  if  not  given  on  the
#     command  line.  The default is TMPDIR, if that exists, or /tmp/
#     as a last resort.
#
# FILES
#
# BUGS
#
# SEE ALSO
#   w3cat(x)
#   html(3x)   
#
# AUTHOR
#   John Chambers <jc@trillian.mit.edu> <jc@ral1.zko.dec.com>

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
set myname [wm title .]
set me [lindex $myname 0]
if [regexp { } $myname] {
	puts "There is another \"$me\" already running."
	exit 1
}
set host [exec hostname]
wm title . "URL Cache"

if [info exists env(V_$me)] {set V $env(V_$me)} else {set V 1}
if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 3}
if [info exists env(R_$me)] {set R $env(R_$me)} else {set R ridge}
if {$V>1} {puts "$me: Started with V=\"$V\""}

if {$argc > 0} {                       set Dir [lindex $argv 0]
} elseif [info exists env(CACHEDIR)] { set Dir $env(CACHEDIR)
} elseif [info exists env(TMPDIR)  ] { set Dir $env(TMPDIR)/Cache
} else {                               set Dir /tmp/Cache
}
if ![file isdirectory $Dir] {exec mkdir -p $Dir}
if ![file isdirectory $Dir] {
	puts stderr "$me: Can't create directory \"$Dir\""
	exit 1
}
foreach d [split $env(PATH) :] {if [file exists $d/Source.tcl] {source $d/Source.tcl;break}}
Source Verbose.w
Source Help.w
Source txtWin.w

# Variables dealing with timings:
set now [clock seconds]
set N(save)     0	;# Save loop number.
set T(purge) 7200	;# Time between purges.
set T(purged) $now	;# Time of last purge.
set T(req)      0	;# Time of last request.
set T(save)   600	;# Time between saves.
set T(saved) $now	;# Time of last save.
set T(start) $now	;# When we started.

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This is called by a client to report a bad cached file.   For  now, #
# all  we  do  is  delete the cached file.  Maybe we should look into #
# re-fetching it.                                                     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Bad {clnt pth url err args} {
	global V me Dir File Path Stat Want Cmd T
	Msg "Bad {$clnt} {$pth} {$url} {$err} {$args}"
	if [file exists $pth] {
		if [catch {exec /bin/rm -f $pth} x] {
			Msg "Bad: Can't /bin/rm -f \"$pth\" ($x)"
		} else {
			Msg "Bad: Removed \"$pth\""
		}
	}
	if [info exists Stat($url)] {
		if {$V>1} {Msg "Bad URL \"$url\""}
		set File($url) {}
		set Path($url) {}
		set Stat($url) 0
	}
	return {}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This is called by a client to request a cached file.  If the URL is #
# in  our cache, we simply return the pathname for the file.  If not, #
# we return null, so that the client can go about its business. Then, #
# if the args are nonnull, we remember them and add the client to the #
# Want($url) list of who's interested in the url.                     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Find {clnt url args} {
	global V me Cmd Dir File Path Stat T Want
	Msg "Find {$clnt} {$url} {$args}"
	set T(req) [clock seconds]
	if ![info exists Stat($url)] {
		if {$V>1} {Msg "New URL \"$url\""}
		set File($url) {}
		set Path($url) {}
		set Stat($url) 0
	}
	if {$Stat($url) < 1} {
		if {$V>2} {Msg "Loading \"$url\" ..."}
		URLget $url
	}
	if {$args != {}} {
		if {$V>1} {Msg Client \"$clnt\" command ($args)"}
		if {$Stat($url) < 2} {	;# Load not finished.
			lappend Want($url) $clnt
			if {$V>1} {Msg "Clients {$Want($url)}"}
			if ![info exists Cmd($clnt:$url)] {
				set Cmd($clnt:$url) [list $args]
				if {$V>1} {Msg "Cmd($clnt:$url) = {$Cmd($clnt:$url)} saved."}
			}
			if {$V>1} {Msg "Cmd($clnt:$url) = {$Cmd($clnt:$url)}"}
		}
	}
	if {$V>0} {Msg "Path {$clnt} {$Path($url)}"}
	return $Path($url)
}

set Imgdly 0
set ndx    0
set pid    [pid]
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Start an asynchronous download of an image file  from  a  url.   We #
# write  it to a file in Tmpdir.  When the download finishes, we will #
# load the image into the specified widget, which is always  a  frame #
# at present.                                                         #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc URLget {u} {
	global V me Dir ndx pid File Pipe Proc Stat inHdr
	if {$V>4} {Msg "URLget: URL \"$u\""}
	if ![regexp {\.([-A-Za-z0-9_]+)$} $u {} suf] {set suf pic}
	incr ndx
	set dataf [format {%s/%06d.%06dD.%s} $Dir $pid $ndx $suf]
	set infof [format {%s/%06d.%06dU}    $Dir $pid $ndx]
	if {$V>4} {Msg "URLget: infof=\"$infof\" dataf=\"$dataf\""}
	set cmd "| w3cat +R -O$dataf \"$u\""
	if {$V>4} {Msg "URLget: cmd=\"$cmd\""}
	if [catch {open $infof w} uf] {
		Msg "Can't write \"$infof\" ($uf)"
		return
	}
	if [catch {puts $uf $u} err] {
		Msg "Can't write to \"$infof\" ($err)"
		exit 1
	}
	puts $uf [clock seconds]
	if [catch {open "$cmd" {RDWR NONBLOCK}} pf] {
		Msg "Can't run \"$cmd\" ($pf)"
		return
	}
	if {$V>1} {Msg "URLget: Loading pf=\"$pf\" cmd=\"$cmd\""}
	set File($u) $dataf
	set Pipe($u) $pf
	set Proc($u) [pid $pf]
	set Stat($u) 1;			# URL fetch started.
	if {$V>1} {Msg "URLget: Pipe $Pipe($u) is pid $Proc($u) to \"$cmd\""}
	fileevent $pf readable "Urdr {$pf} {$u} {$dataf} {$uf}"
	if {$V>1} {Msg "URLget: {Urdr $pf} running ..."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's a routine that ready asynchronously from a pipe to  a  w3cat #
# subprocess.   At  EOF,  we close the pipe down and check to see who #
# wanted the URL.  If a client gave us a list of  args  in  the  Find #
# call,  we  send them back together with the local path and the URL. #
# Then we forget about the client.                                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Urdr {fd u pf uf} {
	global C V me Path Proc Stat Want Cmd
	if {$V>5} {Msg "Urdr: fd=\"$fd\" pf=\"$pf\""}
	if ![eof $fd] {
		if {[gets $fd line] >= 0} {
			if {$V>1} {Msg "Urdr: $line"}
			Msg $line
			return
		}
	}
	if {$V>5} {Msg "EOF on $fd"}
	puts $uf [clock seconds]
	if [catch {close $fd} e] {Msg "close $fd gave $e"} else {if {$V>1} {Msg "Closed $fd"}}
	if [catch {close $uf} e] {Msg "close $uf gave $e"} else {if {$V>1} {Msg "Closed $uf"}}
	if {$V>2} {Msg "Urdr: pf=\"$pf\" u=\"$u\""}
	set Path($u) $pf
	set Stat($u) 2
	if [info exists Want($u)] {
		foreach c $Want($u) {
			if {$V>2} {Msg "Urdr: Client \"$c\" ..."}
			if [info exists Cmd($c:$u)] {
				if {[set cmd $Cmd($c:$u)] != {}} {
					if {$V>1} {Msg "Send {$c} $cmd $pf $u"}
					if {$cmd != {}} {
						if [catch {eval send {$c} $cmd $pf $u} x] {
							if {$V>0} {Msg "#### {$c} $cmd $pf $u ### Failed."; Msg "#### $x"}
						}
					}
					if {$V>1} {Msg "Cmd($c:$u) = {$Cmd($c:$u)}deleted."}
					unset Cmd($c:$u)
				}
			} else {
				if {$V>1} {Msg "Urdr: Cmd($c:$u) already done."}
			}
		}
		unset Want($u)
	}
	if {$V>4} {Msg "Urdr: Done."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Read in cache data from the "Contents" file in the cache directory. #
# This should tell us the origin of all the cached files.  We  should #
# add a routine to purge old and unknown files.                       #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc LoadCache {} {
	global C V me Dir Path Stat 
	set cfile "$Dir/Contents"
	Msg "LoadCache: File \"$cfile\""
	if [catch {open "$cfile" r} f] {
		Msg "LoadCache: Can't read \"$cfile\" ($f)"
		return
	}
	while {[gets $f line] >= 0} {
		if  [regexp {(.+)[ 	]+(.+)} $line {} p u] {
			if {$V>1} {Msg "$p	$u"}
			if [catch {file size $p} fs] {
				Msg LoadCache: \"$p\" $fs"
				set fs 0
			}
			if {$fs > 0} {
				set Path($u) $p
				set Stat($u) 2
			} else {
#				Msg "LoadCache: \"$p\" doesn't exist or is empty."
				set Path($u) {}
				set Stat($u) 0
			}
		}
	}
	close $f
	if {$V>4} {Msg "LoadCache: Done."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Clear out the text window.  We do this periodically, so as  not  to #
# gobble too much memory maintaining its contents.                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Purge {} {
	global V me T
	.t.txt delete 1.0 end
	set T(purged) [clock seconds]
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Write our current cache info out to a "Contents" file in the  cache #
# directory.  We should do this every so often, just to make sure its #
# on disk in case we die or reboot.                                   #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc SaveCache {} {
	global C V me Dir File Path Proc Stat Want Cmd T
	set cfile "$Dir/Contents"
	set now [clock seconds]
	if {$now - $T(purged) > $T(purge)} {Purge}
	Msg "SaveCache: File \"$cfile\""
	if [catch {open "$cfile" {WRONLY CREAT TRUNC}} f] {
		Msg "SaveCache: Can't write to \"$cfile\" ($f)"
		return
	}
	set T(saved) $now
	foreach u [array names Path] {
		set p $Path($u)
		if {$V>2} {Msg "SaveCache: $u	$p"}
		if {$u != {} && $p != {}} {
			puts $f "$p	$u"
		}
	}
	close $f
	if {$V>4} {Msg "SaveCache: Done."}
	LoadCache
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's the driver for a simple loop that saves the cached  data  to #
# disk  every  T(save) seconds.  The N(save) is used to note #
# when a new save loop is started via the Save button.                #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc SaveLoop n {
	global V me N T
	if {$V>4} {Msg "SaveLoop $n (N(save)=$N(save))"}
	if {$n != $N(save)} {return}
	SaveCache
	after $T(save)000 SaveLoop $n
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Write a message to the window.  Unlike puts, we accept  a  list  of #
# args, and put them out with spaces in between.  Maybe we should add #
# a check to see if .t is withdrawn.                                  #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Msg {args} {
	global V me
	if {$V>1} {puts "$args"}
	set c {}
	set tsy1 [lindex [set tsy [.t.s.y get]] 1]
	if {$V>5} {puts "$me/Msg: tsy={$tsy} tsy1={$tsy1}"}
	foreach a $args {.t.txt insert end $c$a; set c { }}
	.t.txt insert end \n
	if {$tsy1 == 1.0} {
		if {$V>5} {puts "$me/Msg: Scroll .t.txt to bottom"}
		.t.txt yview moveto 1.0
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

frame .b -bd $B -relief $R    ;# Holds folder selection menus/buttons
pack  .b -side top -fill x
Source Verbose.w
Verbose .b
frame .t -bd $B -relief $R
pack  .t -side top -expand 1 -fill both

menubutton .b.bCmds -text Cmds -menu .b.bCmds.menu -padx 0 -pady 0 -bd $B -relief $R
pack .b.bCmds -in .b -side left
menu .b.bCmds.menu
.b.bCmds.menu add command -label {Load Cache} -command LoadCache
.b.bCmds.menu add command -label {Save Cache} -command SaveCache
.b.bCmds.menu add command -label Quit         -command exit

frame .b.save -bd $B -relief $R
pack  .b.save -in .b -side left 
button .b.save.bSave -text Save -command {SaveLoop [incr N(save)]} -highlightthickness 0 -padx 0 -pady 0
entry  .b.save.bWhen -textvariable T(save) -highlightthickness 0 -width 0 -bd 0 
pack   .b.save.bSave .b.save.bWhen -in .b.save -side left
BindHelp .b.save {Save Contents}

frame .b.dir -bd $B -relief $R
pack  .b.dir -in .b -side left 
button .b.dir.bDir -text Dir -command LoadCache -highlightthickness 0 -padx 0 -pady 0
entry  .b.dir.bWhen -textvariable Dir -highlightthickness 0 -width 0 -bd 0 
pack   .b.dir.bDir .b.dir.bWhen -in .b.dir -side left
BindHelp .b.dir {Load Contents}

frame .t.s -width 10 -height 10 -bd 0
pack .t.s -in .t -side right -fill y
text .t.txt -width 60 -height 10 -bd 0 -relief ridge \
	-yscrollcommand ".t.s.y set" \
	-xscrollcommand ".t.sbx set" \
	-wrap none -bd $B -relief $R
scrollbar .t.s.y -command ".t.txt yview" -width 8 -orient vertical
scrollbar .t.sbx -command ".t.txt xview" -width 8 -orient horizontal
button    .t.s.x -command Purge -bd 0 -text * -padx 0 -pady 0
BindHelp  .t.s.x Clear
pack .t.s.x -in .t.s -side bottom -fill x
pack .t.s.y -in .t.s -side top -fill y -expand 1
pack .t.sbx -in .t -side bottom -fill x
pack .t.txt -in .t -side left -expand 1 -fill both

Msg "Point at somethine and press Help or F1 to get help."

update idletasks

LoadCache
after $T(save) SaveLoop $N(save)

Msg {Ready to accept commands ...}