#!/usr/local/bin/tclsh
###########################################################
#PUTPIC.CGI BY PIERRE-MIKAEL LEGRIS #
# #
#MUST BE USED WITH PUSH.CGI #
###########################################################
if {[info commands "unsupported0"] == "unsupported0"} {
rename unsupported0 copychannel
}
if {[info commands "copychannel"] == ""} {
proc copychannel {in out} {
fcopy $in $out
}
}
###########################
proc putpic { path } {
global copychannel bound
set in [open $path]
puts "Content-Type: image/gif"
puts "Content-Length: [file size $path]"
puts ""
fconfigure $in -translation binary
fconfigure stdout -translation binary
copychannel $in stdout
close $in
puts "\n--apa"
exec sleep 1
}
###########################
set date_list ""
proc tri_picts {} {
global date_list picta pict_path
set picts [glob $pict_path]
set picta(0) "0"
foreach pict $picts {
set pict_date [file mtime $pict]
set date_list "$date_list $pict_date"
set same_date [array get picta "$pict_date"]
if {$same_date != "" } {
set picta($pict_date) "$picta($pict_date) $pict"
} else {
set picta($pict_date) "$pict"
}
}
set date_list [lsort -integer $date_list]
}
###########################
proc seq_pict {d_deb d_fin ssleep} {
global date_list ofile picta
set previous_date 0
foreach date_value $date_list {
if {($date_value >= $d_deb) && ($date_value <= $d_fin)} {
if {$date_value != $previous_date} {
set ofile [array get picta "$date_value"]
foreach pfile [lindex $ofile 1] {
#puts "
[clock format [lindex $ofile 0]]"
#puts "$pfile"
putpic $pfile
exec sleep $ssleep
}
}
set previous_date $date_value
}
}
}
############################
proc live_pict {ssleep} {
global date_list ofile picta
set newest_date 0
set ofile ""
set newest_file ""
set loop_forever 1
while {$loop_forever} {
tri_picts
foreach date_value $date_list {
if {$date_value > $newest_date} {
set newest_date $date_value
set ofile [array get picta "$date_value"]
set ofile [lindex [lindex $ofile 1] 0]
}
}
if {$newest_file != $ofile} {
set newest_file $ofile
putpic $newest_file
}
exec sleep $ssleep
}
}
##################
puts "HTTP/1.0 200 OK"
puts "Content-type: multipart/x-mixed-replace;boundary=apa\n"
puts "\n--apa"
#puts "Content-type: text/html\n\n"
####################
#set argv "Visite/ jpg live 1"
set path [lindex $argv 0]
set type_of_pict [lindex $argv 1]
set pict_path "$path*.$type_of_pict"
tri_picts
set type [lindex $argv 2]
set ssleep [lindex $argv 3]
if {$type == "seq"} {
set d_deb [lindex $argv 4]
set d_fin [lindex $argv 5]
seq_pict $d_deb $d_fin $ssleep
} else {
live_pict $ssleep
}
#puts "$pict_path
$type
$ssleep
$d_deb
$d_fin
"