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.