From 2e4e8698f87145469e45afe37bc30307dafc2cf0 Mon Sep 17 00:00:00 2001 From: "terry%netscape.com" <> Date: Wed, 16 Sep 1998 22:08:06 +0000 Subject: Get rid of .tcl files; we're a perl app now. --- CGI.tcl | 349 ---------------------------------------------------------------- 1 file changed, 349 deletions(-) delete mode 100755 CGI.tcl (limited to 'CGI.tcl') diff --git a/CGI.tcl b/CGI.tcl deleted file mode 100755 index b2c839865..000000000 --- a/CGI.tcl +++ /dev/null @@ -1,349 +0,0 @@ -# -*- Mode: tcl; indent-tabs-mode: nil -*- -# -# The contents of this file are subject to the Mozilla Public License -# Version 1.0 (the "License"); you may not use this file except in -# compliance with the License. You may obtain a copy of the License at -# http://www.mozilla.org/MPL/ -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the -# License for the specific language governing rights and limitations -# under the License. -# -# The Original Code is the Bugzilla Bug Tracking System. -# -# The Initial Developer of the Original Code is Netscape Communications -# Corporation. Portions created by Netscape are Copyright (C) 1998 -# Netscape Communications Corporation. All Rights Reserved. -# -# Contributor(s): Terry Weissman - -source "globals.tcl" - -proc url_decode {buf} { - regsub -all {\\(.)} $buf {\1} buf ; regsub -all {\\} $buf {\\\\} buf ; - regsub -all { } $buf {\ } buf ; regsub -all {\+} $buf {\ } buf ; - regsub -all {\$} $buf {\$} buf ; regsub -all \n $buf {\n} buf ; - regsub -all {;} $buf {\;} buf ; regsub -all {\[} $buf {\[} buf ; - regsub -all \" $buf \\\" buf ; regsub ^\{ $buf \\\{ buf ; - regsub -all -nocase {%([a-fA-F0-9][a-fA-F0-9])} $buf {[format %c 0x\1]} buf - eval return \"$buf\" -} - -proc url_quote {var} { - regsub -all { } "$var" {%20} var - regsub -all {=} "$var" {%3d} var - regsub -all "\n" "$var" {%0a} var - return $var -} - -proc lookup { a key } { - global $a - set ref [format %s(%s) $a $key] - if { [ info exists $ref] } { - eval return \$$ref - } else { - return "" - } -} - -proc ProcessFormFields {buffer} { - global FORM MFORM - catch {unset FORM} - catch {unset MFORM} - set remaining $buffer - while {![cequal $remaining ""]} { - if {![regexp {^([^&]*)&(.*)$} $remaining foo item remaining]} { - set item $remaining - set remaining "" - } - if {![regexp {^([^=]*)=(.*)$} $item foo name value]} { - set name $item - set value "" - } - set value [url_decode $value] - if {![cequal $value ""]} { - append FORM($name) $value - lappend MFORM($name) $value - } else { - set isnull($name) 1 - } - } - if {[info exists isnull]} { - foreach name [array names isnull] { - if {![info exists FORM($name)]} { - set FORM($name) "" - set MFORM($name) "" - } - } - } -} - -proc FormData { field } { - global FORM - return $FORM($field) -} - -if { [info exists env(REQUEST_METHOD) ] } { - if { $env(REQUEST_METHOD) == "GET" } { - set buffer [lookup env QUERY_STRING] - } else { set buffer [ read stdin $env(CONTENT_LENGTH) ] } - ProcessFormFields $buffer -} - -proc html_quote { var } { - regsub -all {&} "$var" {\&} var - regsub -all {<} "$var" {\<} var - regsub -all {>} "$var" {\>} var - return $var -} -proc value_quote { var } { - regsub -all {&} "$var" {\&} var - regsub -all {"} "$var" {\"} var - regsub -all {<} "$var" {\<} var - regsub -all {>} "$var" {\>} var - return $var -} - -proc value_unquote { var } { - regsub -all {"} $var "\"" var - regsub -all {<} $var "<" var - regsub -all {>} $var ">" var - regsub -all {&} $var {\&} var - return $var -} - -foreach pair [ split [lookup env HTTP_COOKIE] ";" ] { - set pair [string trim $pair] - set eq [string first = $pair ] - if {$eq == -1} { - set COOKIE($pair) "" - } else { - set COOKIE([string range $pair 0 [expr $eq - 1]]) [string range $pair [expr $eq + 1] end] - } -} - -proc navigation_header {} { - global COOKIE FORM next_bug - set buglist [lookup COOKIE BUGLIST] - if { $buglist != "" } { - set bugs [split $buglist :] - set cur [ lsearch -exact $bugs $FORM(id) ] - puts "Bug List: ([expr $cur + 1] of [llength $bugs])" - puts "First" - puts "Last" - if { $cur > 0 } { - puts "Prev" - } else { - puts "Prev" - } - if { $cur < [expr [ llength $bugs ] - 1] } { - set next_bug [lindex $bugs [expr $cur + 1]] - puts "Next" - } else { - puts "Next" - } - } - puts "     Query page" - puts "     Enter new bug" -} - -proc make_options { src default {isregexp 0} } { - set last "" ; set popup "" ; set found 0 - foreach item $src { - if {$item == "-blank-" || $item != $last} { - if { $item == "-blank-" } { set item "" } - set last $item - if {$isregexp ? [regexp $default $item] : [cequal $default $item]} { - append popup "