#
# $Source: /home/nlfm/Zircon/plugins/Dcc/RCS/dccget.tcl,v $
# $Date: 1998/08/19 12:17:45 $
# $Revision: 1.18.1.10 $
#
package provide Dcc 1.18
#
switch -glob -- [info tclversion] 7.* {
#
proc startGet {sk net file usr leng posn} {
    global zircon
    zOut "! dccget $file $usr $leng $posn" $net
    if {[catch {fullName $file} fl]} {
	tellError {} {DCC error} "Cannot get full pathname for $file : $fl"
	return
    }
    if {[catch {open "|[file join $zircon(lib) plugins Dcc dccget] $file \
      00 $usr $leng $posn <@$sk 2>@$sk" r} fd]} {
	tellError {} {Prog error} "Cannot run DCC helper program dccget : $fd. Check your installation"
    } {
	upvar #0 Get$net Get
	catch {fconfigure $fd -buffering line -translation {lf lf}}
	fileevent $fd readable "handleInfo $net $fd"
	if {![info exists Get($usr)]} {$usr ref}
	lappend Get($usr) [list $fd $fl $fd]
	if {[winfo exists .@dls$net]} { buildDCCList $net }
	dccWindow $fd $usr Get $file
    }
    catch {close $sk}
}
} default {
#
proc startGet {sk net file usr leng posn} {
    fileevent $sk writable {}
    fconfigure $sk -buffering none -blocking 0 -translation binary -buffersize 4096
    set flags [list WRONLY CREAT]
    if {$posn == 0} { lappend flags TRUNC }
    if {[catch {fullName $file} fl]} {
	close $out
        endDCC Get $usr $sk $net "Cannot get full pathname for $file : $fl"
	return 0
    }
    if {![catch {open $file $flags 0600} out]} {
	if {$posn != 0} {
	    if {[catch {seek $out $posn start} msg]} {
	    	close $out
	    	endDCC Get $usr $sk $net "Cannot seek on $file : $msg"
		return 0
	    }
	    incr leng -$posn
	}
	uplevel #0 set tl($sk) 0
	fconfigure $out -translation binary 
	fileevent $sk readable "dccgevent $sk $out $leng $usr $net [clock seconds]"
	upvar #0 Get$net Get
	if {![info exists Get($usr)]} {$usr ref}
	lappend Get($usr) [list $sk $fl $sk]
	if {[winfo exists .@dls$net]} { buildDCCList $net }
	dccWindow $sk $usr Get $file
    } {
        endDCC Get $usr $sk $net "Cannot write $file : $out"
        return 0
    }
    return 1
}
#
proc dccgevent {in out leng who net st} {
    global tl
    set xc 0
    if {[eof $in]} {
        if {$tl($in) < $leng} {
	    set msg "Transfer Interrupted"
        } elseif {$tl($in) > $leng} {
   	    set msg "Too much data transferred!!"
        } {
    	    set sx s
	    if {[set st [expr {[clock seconds] - $st}]] == 0} {
	        set st 1
	        set sx {}
	    }
	    set xc 1
	    set msg "Transfer completed. [expr {$leng / ($st * 1000.0)}] Kbytes/sec"
        }
    } {
        if {![catch {set buffer [read $in]} msg]} {
            incr tl($in) [set l [string length $buffer]]
            if {[set dt [expr {[clock seconds] - $st}]] == 0 || $tl($in) == 0} {
                set elt 0
            } {
	        set elt [expr {($leng - $tl($in)) / ($tl($in) /([clock seconds] - $st))}]
	    }
	    if {$leng == 0} {
	    	set xt 0
	    } {
	        set xt [expr {($tl($in) * 100.0) / $leng}]
	    }
            dccProgress $in $tl($in) $xt [expr {$elt / 60}] [expr {$elt % 60}]
            if {![catch {puts -nonewline $out $buffer} msg]} {
	        if {![catch {puts -nonewline $in [binary format I1 $tl($in)]} msg]} {
	            return
	        }
	    }
	}
    }
    endDCC Get $who $in $net $msg $xc
    catch {close $out} 
}
}
