X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCGI.pm;h=a53fbb51444b8cb95fd133bd0c5123eb0b23cf1d;hb=fd20da51661b685c54940aeb116a97beabf44d0f;hp=1c9d2d466121ac16dd9129b11fa1fa3c06baed7e;hpb=ba05675547134d242d93611530d62f98d944bc27;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/CGI.pm b/lib/CGI.pm index 1c9d2d4..a53fbb5 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,22 +18,25 @@ use Carp 'croak'; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.49 2001/02/04 23:08:39 lstein Exp $'; -$CGI::VERSION='2.752'; +$CGI::revision = '$Id: CGI.pm,v 1.62 2002/04/10 19:36:01 lstein Exp $'; +$CGI::VERSION='2.81'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. -# $TempFile::TMPDIRECTORY = '/usr/tmp'; +# $CGITempFile::TMPDIRECTORY = '/usr/tmp'; use CGI::Util qw(rearrange make_attributes unescape escape expires); -use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN', - 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd']; +#use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN', +# 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd']; + +use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN', + 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd']; # >>>>> Here are some globals that you might want to adjust <<<<<< sub initialize_globals { # Set this to 1 to enable copious autoloader debugging messages $AUTOLOAD_DEBUG = 0; - + # Set this to 1 to generate XTML-compatible output $XHTML = 1; @@ -82,6 +85,10 @@ sub initialize_globals { # separate the name=value pairs by semicolons rather than ampersands $USE_PARAM_SEMICOLONS = 1; + # Do not include undefined params parsed from query string + # use CGI qw(-no_undef_params); + $NO_UNDEF_PARAMS = 0; + # Other globals that you shouldn't worry about. undef $Q; $BEEN_THERE = 0; @@ -136,8 +143,8 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; # The path separator is a slash, backslash or semicolon, depending # on the paltform. $SL = { - UNIX=>'/', OS2=>'\\', EPOC=>'/', - WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' + UNIX=>'/', OS2=>'\\', EPOC=>'/', + WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' }->{$OS}; # This no longer seems to be necessary @@ -184,6 +191,9 @@ if ($needs_binmode) { input Select option comment charset escapeHTML/], ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param embed basefont style span layer ilayer font frameset frame script small big/], + ':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe + ins label legend noframes noscript object optgroup Q + thead tbody tfoot/], ':netscape'=>[qw/blink fontsize center/], ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group submit reset defaults radio_group popup_menu button autoEscape @@ -199,10 +209,10 @@ if ($needs_binmode) { ':ssl' => [qw/https/], ':imagemap' => [qw/Area Map/], ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/], - ':html' => [qw/:html2 :html3 :netscape/], - ':standard' => [qw/:html2 :html3 :form :cgi/], + ':html' => [qw/:html2 :html3 :html4 :netscape/], + ':standard' => [qw/:html2 :html3 :html4 :form :cgi/], ':push' => [qw/multipart_init multipart_start multipart_end multipart_final/], - ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/] + ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/] ); # to import symbols into caller @@ -210,8 +220,8 @@ sub import { my $self = shift; # This causes modules to clash. -# undef %EXPORT_OK; -# undef %EXPORT; + undef %EXPORT_OK; + undef %EXPORT; $self->_setup_symbols(@_); my ($callpack, $callfile, $callline) = caller; @@ -542,6 +552,8 @@ sub parse_params { my($param,$value); foreach (@pairs) { ($param,$value) = split('=',$_,2); + next unless defined $param; + next if $NO_UNDEF_PARAMS and not defined $value; $value = '' unless defined $value; $param = unescape($param); $value = unescape($value); @@ -647,11 +659,29 @@ sub _compile { return "$pack\:\:$func_name"; } +sub _selected { + my $self = shift; + my $value = shift; + return '' unless $value; + return $XHTML ? qq( selected="selected") : qq( selected); +} + +sub _checked { + my $self = shift; + my $value = shift; + return '' unless $value; + return $XHTML ? qq( checked="checked") : qq( checked); +} + sub _reset_globals { initialize_globals(); } sub _setup_symbols { my $self = shift; my $compile = 0; + + # to avoid reexporting unwanted variables + undef %EXPORT; + foreach (@_) { $HEADERS_ONCE++, next if /^[:-]unique_headers$/; $NPH++, next if /^[:-]nph$/; @@ -665,6 +695,7 @@ sub _setup_symbols { $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; $EXPORT{$_}++, next if /^[:-]any$/; $compile++, next if /^[:-]compile$/; + $NO_UNDEF_PARAMS++, next if /^[:-]no_undef_params$/; # This is probably extremely evil code -- to be deleted some day. if (/^[-]autoload$/) { @@ -1015,20 +1046,20 @@ END_OF_FUNC sub Dump { my($self) = self_or_default(@_); my($param,$value,@result); - return '' unless $self->param; - push(@result,""); return join("\n",@result); } END_OF_FUNC @@ -1197,6 +1228,7 @@ sub header { foreach (@other) { next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/; ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e; + $header = ucfirst($header); } $type ||= 'text/html' unless defined($type); @@ -1225,7 +1257,7 @@ sub header { push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph; push(@header,"Pragma: no-cache") if $self->cache(); push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment; - push(@header,@other); + push(@header,map {ucfirst $_} @other); push(@header,"Content-Type: $type") if $type ne ''; my $header = join($CRLF,@header)."${CRLF}${CRLF}"; @@ -1291,17 +1323,20 @@ END_OF_FUNC # $script -> (option) Javascript code (-script) # $no_script -> (option) Javascript