X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCGI.pm;h=bd9c3354f7290faac2c15d0d09e6418b04fc2c08;hb=3b0db4f96671dacfd3421850abb588b84e2ce6da;hp=3e8ed35be48fa69e63a790c3acd12655bd050deb;hpb=69c89ae7c8e657da80c1a551520c53d86073f166;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/CGI.pm b/lib/CGI.pm index 3e8ed35..bd9c335 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,22 +18,29 @@ 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.51 2001/08/07 12:28:43 lstein Exp $'; -$CGI::VERSION='2.77'; +$CGI::revision = '$Id: CGI.pm,v 1.75 2002/10/16 17:48:37 lstein Exp $'; +$CGI::VERSION='2.89'; # 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']; + +$TAINTED = substr("$0$^X",0,0); + +my @SAVED_SYMBOLS; # >>>>> 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,9 +89,9 @@ 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; + # 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; @@ -124,12 +131,14 @@ if ($OS =~ /^MSWin/i) { $OS = 'OS2'; } elsif ($OS =~ /^epoc/i) { $OS = 'EPOC'; +} elsif ($OS =~ /^cygwin/i) { + $OS = 'CYGWIN'; } else { $OS = 'UNIX'; } # Some OS logic. Binary mode enabled on DOS, NT and VMS -$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin)/; +$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin|CYGWIN)/; # This is the default class for the CGI object to use when all else fails. $DefaultClass = 'CGI' unless defined $CGI::DefaultClass; @@ -140,8 +149,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 => '/', CYGWIN => '/', + WINDOWS => '\\', DOS => '\\', MACINTOSH => ':', VMS => '/' }->{$OS}; # This no longer seems to be necessary @@ -150,13 +159,19 @@ $SL = { $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; # Turn on special checking for Doug MacEachern's modperl -if (exists $ENV{'GATEWAY_INTERFACE'} - && +if (exists $ENV{'GATEWAY_INTERFACE'} + && ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) -{ + { $| = 1; - require Apache; -} + require mod_perl; + if ($mod_perl::VERSION >= 1.99) { + require Apache::compat; + } else { + require Apache; + } + } + # Turn on special checking for ActiveState's PerlEx $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; @@ -188,6 +203,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 @@ -203,19 +221,19 @@ 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 sub import { my $self = shift; -# This causes modules to clash. -# undef %EXPORT_OK; -# undef %EXPORT; + # This causes modules to clash. + undef %EXPORT_OK; + undef %EXPORT; $self->_setup_symbols(@_); my ($callpack, $callfile, $callline) = caller; @@ -375,6 +393,9 @@ sub init { # set charset to the safe ISO-8859-1 $self->charset('ISO-8859-1'); + # set autoescaping to on + $self->{'escape'} = 1; + METHOD: { # avoid unreasonably large postings @@ -546,6 +567,7 @@ 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); @@ -652,11 +674,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$/; @@ -689,6 +729,7 @@ sub _setup_symbols { } } _compile_all(keys %EXPORT) if $compile; + @SAVED_SYMBOLS = @_; } sub charset { @@ -741,11 +782,12 @@ END_OF_FUNC #### sub delete { my($self,@p) = self_or_default(@_); - my($name) = rearrange([NAME],@p); - CORE::delete $self->{$name}; - CORE::delete $self->{'.fieldnames'}->{$name}; - @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); - return wantarray ? () : undef; + my(@names) = rearrange([NAME],@p); + for my $name (@names) { + CORE::delete $self->{$name}; + CORE::delete $self->{'.fieldnames'}->{$name}; + @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); + } } END_OF_FUNC @@ -967,7 +1009,9 @@ EOF 'autoEscape' => <<'END_OF_FUNC', sub autoEscape { my($self,$escape) = self_or_default(@_); - $self->{'dontescape'}=!$escape; + my $d = $self->{'escape'}; + $self->{'escape'} = $escape; + $d; } END_OF_FUNC @@ -1021,20 +1065,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 @@ -1298,17 +1342,20 @@ END_OF_FUNC # $script -> (option) Javascript code (-script) # $no_script -> (option) Javascript