Tcl/Tk Benchmark Suite And Tools
Artifact Content
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Artifact 36199d98499546014ee49398b8040893af182c1e:


#
# RCS: @(#) $Id: parse.bench,v 1.2 2004/12/29 23:16:19 hobbs Exp $
#

if {[catch {package require Tcl 8.0}]} {
    # requires namespace support
    return
}

if { [catch {string repeat "abc" 10}] } {
    proc str-repeat {str num} {
	set val {}
	for {set i 0} {$i < $num} {incr i} {
	    append val $str
	}
	set val
    }
} else {
    proc str-repeat {str num} {
	string repeat $str $num
    }
}

proc makeFile {file order} {
    set outfid [open $file w]
    fconfigure $outfid -translation binary
    set fid [open $::SCRIPT r]
    fconfigure $fid -translation binary
    if {[catch {read $fid [file size $::SCRIPT]} data]} {
	return -code error $data
    }
    close $fid
    set type "multipart/form-data; boundary=$::BOUND"
    while {$order} {
	puts $outfid "--$::BOUND\nContent-Disposition: form-data;\
		name=\"file$order\"; filename=\"file$order\"\n\n$data\n"
	incr order -1
    }
    puts $outfid "${::BOUND}--"
    close $outfid
}

# ensure the BOUND will have consistent size between runs
set ::BOUND [format "-----NEXT_PART_%012ld.%05ld" [clock sec] [pid]]
set ::SCRIPT [info script]
set ::LARGEFILE [bench_tmpfile].lrg
set ::SMALLFILE [bench_tmpfile].sml
makeFile $::LARGEFILE 250
makeFile $::SMALLFILE 2

proc ns_getform {file}  {
    set type "multipart/form-data; boundary=$::BOUND"
    # Spool content into a temporary read/write file.
    # ns_openexcl can fail, hence why we keep spinning
    set fp [open $file]
    set form [_ns_parseformfp $fp $type]
    close $fp
    return $form
}

#
# _ns_parseformfp --
#
#	Parse a multi-part form data file.
#

proc _ns_parseformfp {fp contentType} {
    # parse the boundary out of the content-type header

    regexp -nocase {boundary=(.*)$} $contentType 1 b
    set boundary "--$b"

    set form(create) $boundary

    while { ![eof $fp] } {
	# skip past the next boundary line
	if {![string match $boundary* [string trim [gets $fp]]]} {
	    continue
	}

	# fetch the disposition line and field name
	set disposition [string trim [gets $fp]]
	if {![string length $disposition]} {
	    break
	}

	set disposition [split $disposition \;]
	set name [string trim [lindex [split [lindex $disposition 1] =] 1] \"]

	# fetch and save any field headers
	
	while { ![eof $fp] } {
	    set line [string trim [gets $fp]]
	    if {![string length $line]} {
		break
	    }
	    set header [split $line :]
	    set key [string tolower [string trim [lindex $header 0]]]
	    set value [string trim [lindex $header 1]]
	    set form($name.$key) $value
	}

	if { [llength $disposition] == 3 } {
	    # uploaded file -- save the original filename as the value
	    set filename [string trim \
		    [lindex [split [lindex $disposition 2] =] 1] \"]
	    set form($name) $filename

	    # read lines of data until another boundary is found
	    set start [tell $fp]
	    set end $start
	    
	    while { ![eof $fp] } {
		if {[string match $boundary* [string trim [gets $fp]]]} {
		    break
		}
		set end [tell $fp]
	    }
	    set length [expr {$end - $start - 2}]

	    if { $length > 0 } {
		seek $fp $start
	    }

	    seek $fp $end
	    set form($name) "FILE $start $end"

	} else {
	    # ordinary field - read lines until next boundary
	    set first 1
	    set value ""
	    set start [tell $fp]

	    while { [gets $fp line] >= 0 } {
		set line [string trimright $line \r]
		if {[string match $boundary* $line]} {
		    break
		}
		if {$first} {
		    set first 0
		} else {
		    append value \n
		}
		append value $line
		set start [tell $fp]
	    }
	    seek $fp $start
	    set form($name) $value
	}
    }
    return [array get form]
}

set iter 20
bench -iter $iter -desc "PARSE html form upload ([file size $::SMALLFILE])" \
	-body {ns_getform $::SMALLFILE}
bench -iter $iter -desc "PARSE html form upload ([file size $::LARGEFILE])" \
	-body {ns_getform $::LARGEFILE}

bench_rm $::LARGEFILE $::SMALLFILE