Index by: file name |
procedure name |
procedure call |
annotation
gscope_upload.tcl
(annotations | original source)
#rR taken from http://wiki.tcl.tk/13675
# Provide multipart/form-data for http
catch {
package provide form-data 1.0
package require mime
}
namespace eval form-data {}
proc form-data::compose {partv {type multipart/form-data}} {
upvar 1 $partv parts
set mime [mime::initialize -canonical $type -parts $parts]
set packaged [mime::buildmessage $mime]
foreach part $parts {
mime::finalize $part
}
mime::finalize $mime
return $packaged
}
proc form-data::add_binary {partv name filename value type} {
upvar 1 $partv parts
set disposition "form-data; name=\"${name}\"; filename=\"$filename\""
lappend parts [mime::initialize -canonical $type \
-string $value \
-encoding binary \
-header [list Content-Disposition $disposition]]
}
proc form-data::add_field {partv name value} {
upvar 1 $partv parts
set disposition "form-data; name=\"${name}\""
lappend parts [mime::initialize -canonical text/plain -string $value \
-header [list Content-Disposition $disposition]]
}
proc form-data::format {name filename value type args} {
set parts {}
foreach {n v} $args {
add_field parts $n $v
}
add_binary parts $name $filename $value $type
return [compose parts]
}
proc TestUpload {{Fichier ""}} {
if {$Fichier==""} { set Fichier "[HomeRipp]/images/TintinEtBD/pirogue.gif" }
set Queue [file tail $Fichier]
# format a gif file upload according to the following form:
#<FORM METHOD="POST" ENCTYPE="multipart/form-data" ACTION="upload.php">
#<INPUT TYPE="HIDDEN" NAME="MAX_FILE_SIZE" VALUE=" ">
#<INPUT TYPE="HIDDEN" NAME="action" VALUE="1">
#<INPUT TYPE="FILE" NAME="file1">
#<INPUT TYPE="SUBMIT" VALUE="Host It"> <br>
#<INPUT TYPE="text" NAME="img_resize" SIZE="4" MAXLENGTH="4">
#</FORM>
# get contents of the gif
set fd [open $Fichier]
fconfigure $fd -translation binary
set image [read $fd]
close $fd
# set up other fields
array set fields {
MAX_FILE_SIZE " "
action 1
img_resize "100%"
}
# format the image and form
puts [form-data::format file1 $Queue $image image/gif {*}[array get fields]]
}
Index by: file name |
procedure name |
procedure call |
annotation
File generated 2022-04-05 at 12:55.