From 094ca96844842928810f14844413109fc6cdd890 Mon Sep 17 00:00:00 2001
From: Eduardo Chappa <echappa@gmx.com>
Date: Sun, 3 Feb 2013 00:59:38 -0700
Subject: Initial Alpine Version

---
 web/src/cgi.tcl-1.10/example/upload.cgi | 59 +++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100755 web/src/cgi.tcl-1.10/example/upload.cgi

(limited to 'web/src/cgi.tcl-1.10/example/upload.cgi')

diff --git a/web/src/cgi.tcl-1.10/example/upload.cgi b/web/src/cgi.tcl-1.10/example/upload.cgi
new file mode 100755
index 00000000..9841aa97
--- /dev/null
+++ b/web/src/cgi.tcl-1.10/example/upload.cgi
@@ -0,0 +1,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
+	}
+    }
+}
+
-- 
cgit v1.2.3-54-g00ecf