#/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

set read_count 0
set last_read_count 0
set semvar 1
set retry_count 0

proc Debug { s m } {
  global windows stuff

  if { $stuff(debug) == 0 } {
    return
  }

  set t [clock seconds]
  set date [clock format $t -format "%Y-%m-%d"]
  set utc [clock format $t -format "%H:%M"]
  set d "$date $utc"

  puts "$d $s $m"
}



proc Spool_file_Open { } {
  global stuff

  set t [clock seconds]
  set date [clock format $t -format "%Y-%m-%d"]
  set utc [clock format $t -format "%H%M%S"]
 set stuff(spool_name) "./pserver.$date$utc"

  Debug "Spool_file_Open" "Opening Spool File"
  if { [ catch { set stuff(spoolfid) [ open $stuff(spool_name) w ] } ] } {
    Debug "Spool_file_Open" "Cannot open $stuff(spool_name)"
  } 
fconfigure $stuff(spoolfid) -translation binary
}

#--------------------------------------------
proc Spool_file_to_printer { } {

global stuff
  Debug "Spool_file_to_printer" "Opening Spool File"
  if { [ catch { set spoolfid [ open $stuff(spool_name) r ] } ] } {
    Debug "Spool_file_to_printer" "Cannot open $stuff(spool_name)"
	}

  if { [ catch { set lprfid [ open $stuff(lpr_name) w ] } ] } {
    Debug "Spool_file_to_printer" "Cannot open $stuff(lpr_name)"
	}
fconfigure $spoolfid -translation binary
fconfigure $lprfid -translation binary

while { 1 >  [eof $spoolfid] } {
  if { 1 > [ catch { gets $spoolfid bug } ] } {
      puts  $lprfid $bug
    }
  }

close $spoolfid
close $lprfid

# file delete -force $stuff(spool_name)

}
#--------------------------------------------
proc Spool_file_Close { } {
  global stuff

 Debug "Spool_file_Close" "Closing $stuff(spool_name)"

  if { [ info exists stuff(spoolfid) ] } {
    close $stuff(spoolfid)
    unset stuff(spoolfid)
	Spool_file_to_printer
  }
  Spool_file_Open
}
#--------------------------------------------
proc Init { } {
  global stuff tcl_platform

  set stuff(debug) 0

  switch -exact -- $tcl_platform(os) {
    "Linux" {
	set stuff(port) "9100"
	set stuff(spool_name) "./spoolfile"
	set stuff(lpr_name) "LPT1"
    }
    "Darwin" {
	set stuff(port) "9100"
	set stuff(spool_name) "./spoolfile"
	set stuff(lpr_name) "LPT1:"
    }
    default {
	set stuff(port) "9100"
	set stuff(spool_name) "./spoolfile"
	set stuff(lpr_name) "LPT1:"
    }
  }

  set stuff(spoolfid) ""
}
#--------------------------------------------
proc check_data { } {
global read_count last_read_count semvar retry_count

if { 0 < $read_count && $read_count == $last_read_count } {
	incr retry_count
	if { 4 < $retry_count } {
		Spool_file_Close
		set read_count 0
		set retry_count 0
		}
	}
set last_read_count $read_count
set semvar 1
}
#--------------------------------------------
proc drop {cid} {
    global Client 

    close $cid
    Spool_file_Close
    return ""
}
#--------------------------------------------
proc server_handle {cid} {
  global stuff
    set request ""
    gets $cid request
    if {[eof $cid] } {
        drop $cid
        } else {
# copy request out to spool file
	  Debug "Writing Spool File" "$request"
        puts $stuff(spoolfid) $request
        }
        
}
#--------------------------------------------
proc server_accept {cid addr port} {
    global Client 
    fileevent $cid readable "server_handle $cid"
    fconfigure $cid -translation binary
}
#--------------------------------------------
proc start {{port} } {
global Server

    if {[catch {socket -server server_accept $port} Server]} {
        puts "Unable to bind port  $port"
        exit
    } 
    
}
#--------------------------------------------


Init

if { [ file readable "pserver.ini" ] } {
  source "pserver.ini"
}

Spool_file_Open
start [ set stuff(port) ]
set xyz 0

set semvar 1
while { 1 < 2 } {
	after 1000 check_data
	set semvar 0
	vwait semvar
}