summaryrefslogtreecommitdiff
path: root/web/src/cgi.tcl-1.10/example/upload.cgi
blob: 9841aa97ed825c3d1065aeda772e4a5ece3ab19b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
#!/depot/path/tclsh

# This is a CGI script that demonstrates file uploading.

package require cgi

cgi_eval {
    source example.tcl

    proc showfile {v} {
	catch {
	    set server [cgi_import_file -server $v]
	    set client [cgi_import_file -client $v]
	    set type   [cgi_import_file -type $v]
	    if {[string length $client]} {
		h4 "Uploaded: $client"
		if {0 != [string compare $type ""]} {
		    h4 "Content-type: $type"
		}
		cgi_import showList
		foreach show $showList {
		    switch $show {
			"od -c" - "cat" {
			    h5 "Contents shown using $show"
			    cgi_preformatted {puts [eval exec $show [list $server]]}
			}
		    }
		}
	    }
	    exec /bin/rm -f $server
	}
    }

    cgi_input

    cgi_head {
	cgi_title "File upload demo"
    }
    cgi_body {
	if {[info tcl] < 8.1} {
	    h4 "Warning: This script can not perform binary uploads because the server is running a pre-8.1 Tcl ([info tcl])."
	}

	showfile file1
	showfile file2

	cgi_form upload enctype=multipart/form-data {
	    p "Select up to two files to upload"
	    cgi_file_button file1; br
	    cgi_file_button file2; br
	    checkbox "showList=cat" checked;
	    put "show contents using cat"   ;br
	    checkbox "showList=od -c"
	    put "show contents using od -c" ;br
	    cgi_submit_button =Upload
	}
    }
}