diff -durN MT-2.661-full-lib/extlib/CGI.pm MT/extlib/CGI.pm --- MT-2.661-full-lib/extlib/CGI.pm Mon Dec 22 19:06:32 2003 +++ MT/extlib/new/CGI.pm Mon Dec 29 19:32:01 2003 @@ -18,22 +18,29 @@ # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.55 2001/09/26 02:15:52 lstein Exp $'; -$CGI::VERSION='2.78'; +$CGI::revision = '$Id: CGI.pm,v 1.88 2003/02/11 14:13:18 lstein Exp $'; +$CGI::VERSION='2.91'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. # $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; @@ -66,6 +73,16 @@ # 2) CGI::private_tempfiles(1); $PRIVATE_TEMPFILES = 0; + # Set this to 1 to cause files uploaded in multipart documents + # to be closed, instead of caching the file handle + # or: + # 1) use CGI qw(:close_upload_files) + # 2) $CGI::close_upload_files(1); + # Uploads with many files run out of file handles. + # Also, for performance, since the file is already on disk, + # it can just be renamed, instead of read and written. + $CLOSE_UPLOAD_FILES = 0; + # Set this to a positive value to limit the size of a POSTing # to a certain number of bytes: $POST_MAX = -1; @@ -82,9 +99,9 @@ # 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 +141,14 @@ $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; @@ -141,7 +160,8 @@ # on the paltform. $SL = { UNIX=>'/', OS2=>'\\', EPOC=>'/', - WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/' + WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/', + CYGWIN=>'/', }->{$OS}; # This no longer seems to be necessary @@ -150,13 +170,19 @@ $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) { + eval "require Apache::compat"; + } else { + eval "require Apache"; + } + } + # Turn on special checking for ActiveState's PerlEx $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; @@ -188,6 +214,9 @@ 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 +232,19 @@ ':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; @@ -372,8 +401,11 @@ $fh = to_filehandle($initializer) if $initializer; - # set charset to the safe ISO-8859-1 - $self->charset('ISO-8859-1'); + # set charset to UTF-8 + $self->charset('UTF-8'); + + # set autoescaping to on + $self->{'escape'} = 1; METHOD: { @@ -546,6 +578,7 @@ 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); @@ -578,15 +611,14 @@ my ($self,$tagname) = @_; my $func = qq( sub $tagname { - shift if \$_[0] && - (ref(\$_[0]) && - (substr(ref(\$_[0]),0,3) eq 'CGI' || - UNIVERSAL::isa(\$_[0],'CGI'))); - my(\$attr) = ''; - if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { - my(\@attr) = make_attributes(shift()||undef,1); - \$attr = " \@attr" if \@attr; - } + my (\$q,\$a,\@rest) = self_or_default(\@_); + my(\$attr) = ''; + if (ref(\$a) && ref(\$a) eq 'HASH') { + my(\@attr) = make_attributes(\$a,\$q->{'escape'}); + \$attr = " \@attr" if \@attr; + } else { + unshift \@rest,\$a; + } ); if ($tagname=~/start_(\w+)/i) { $func .= qq! return "<\L$1\E\$attr>";} !; @@ -597,7 +629,7 @@ return \$XHTML ? "\L<$tagname\E\$attr />" : "\L<$tagname\E\$attr>" unless \@_; my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L\E"); my \@result = map { "\$tag\$_\$untag" } - (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; + (ref(\$rest[0]) eq 'ARRAY') ? \@{\$rest[0]} : "\@rest"; return "\@result"; }#; } @@ -652,11 +684,29 @@ 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$/; @@ -668,6 +718,7 @@ $XHTML=0, next if /^[:-]no_?xhtml$/; $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/; $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; + $CLOSE_UPLOAD_FILES++, next if /^[:-]close_upload_files$/; $EXPORT{$_}++, next if /^[:-]any$/; $compile++, next if /^[:-]compile$/; $NO_UNDEF_PARAMS++, next if /^[:-]no_undef_params$/; @@ -689,6 +740,7 @@ } } _compile_all(keys %EXPORT) if $compile; + @SAVED_SYMBOLS = @_; } sub charset { @@ -742,9 +794,15 @@ 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()); + my @to_delete = ref($name) eq 'ARRAY' ? @$name : ($name); + my %to_delete; + foreach my $name (@to_delete) + { + CORE::delete $self->{$name}; + CORE::delete $self->{'.fieldnames'}->{$name}; + $to_delete{$name}++; + } + @{$self->{'.parameters'}}=grep { !exists($to_delete{$_}) } $self->param(); return wantarray ? () : undef; } END_OF_FUNC @@ -967,7 +1025,9 @@ '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 +1081,20 @@ sub Dump { my($self) = self_or_default(@_); my($param,$value,@result); - return '' unless $self->param; - push(@result,""); return join("\n",@result); } END_OF_FUNC @@ -1185,11 +1245,11 @@ return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE; - my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,@other) = + my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) = rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'], 'STATUS',['COOKIE','COOKIES'],'TARGET', 'EXPIRES','NPH','CHARSET', - 'ATTACHMENT'],@p); + 'ATTACHMENT','P3P'],@p); $nph ||= $NPH; if (defined $charset) { @@ -1202,12 +1262,11 @@ # need to fix it up a little. foreach (@other) { next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/; - ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e; - $header = ucfirst($header); + ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e; } $type ||= 'text/html' unless defined($type); - $type .= "; charset=$charset" if $type ne '' and $type =~ m!^text/! and $type !~ /\bcharset\b/; + $type .= "; charset=$charset" if $type ne '' and $type =~ m!^text/! and $type !~ /\bcharset\b/ and $charset ne ''; # Maybe future compatibility. Maybe not. my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; @@ -1216,6 +1275,10 @@ push(@header,"Status: $status") if $status; push(@header,"Window-Target: $target") if $target; + if ($p3p) { + $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY'; + push(@header,qq(P3P: policyref="/w3c/p3p.xml" CP="$p3p")); + } # push all the cookies -- there may be several if ($cookie) { my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie; @@ -1280,7 +1343,7 @@ unshift(@o,'-Target'=>$target) if $target; unshift(@o,'-Cookie'=>$cookie) if $cookie; unshift(@o,'-Type'=>''); - return $self->header(@o); + return $self->header(map {$self->unescapeHTML($_)} @o); } END_OF_FUNC @@ -1298,11 +1361,11 @@ # $script -> (option) Javascript code (-script) # $no_script -> (option) Javascript