From: Jarkko Hietaniemi Date: Sat, 12 Jan 2002 06:01:29 +0000 (+0000) Subject: Upgrade to CGI.pm 2.80. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2371fea9e14a724e668c4f56ab57c9078e9bdee5;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm 2.80. p4raw-id: //depot/perl@14211 --- diff --git a/lib/CGI.pm b/lib/CGI.pm index 292e262..c07625d 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,8 +18,8 @@ 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.56 2001/12/09 21:36:23 lstein Exp $'; -$CGI::VERSION='2.79'; +$CGI::revision = '$Id: CGI.pm,v 1.58 2002/01/12 02:44:56 lstein Exp $'; +$CGI::VERSION='2.80'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -36,7 +36,7 @@ use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN', 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; @@ -85,9 +85,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; @@ -662,14 +662,14 @@ sub _selected { my $self = shift; my $value = shift; return '' unless $value; - return $XHTML ? qq( selected="1") : qq( selected); + return $XHTML ? qq( selected="selected") : qq( selected); } sub _checked { my $self = shift; my $value = shift; return '' unless $value; - return $XHTML ? qq( checked="1") : qq( checked); + return $XHTML ? qq( checked="checked") : qq( checked); } sub _reset_globals { initialize_globals(); } @@ -2057,7 +2057,7 @@ sub radio_group { my($other) = @other ? " @other" : ''; foreach (@values) { - my($checkit) = $checked eq $_ ? qq/ checked="1"/ : ''; + my($checkit) = $checked eq $_ ? qq/ checked="checked"/ : ''; my($break); if ($linebreak) { $break = $XHTML ? "
" : "
"; @@ -2123,7 +2123,7 @@ sub popup_menu { $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); my($value) = $self->escapeHTML($_); $label=$self->escapeHTML($label,1); - $result .= "\n"; + $result .= "$label\n"; } $result .= ""; @@ -2177,7 +2177,7 @@ sub scrolling_list { $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); $label=$self->escapeHTML($label); my($value)=$self->escapeHTML($_,1); - $result .= "\n"; + $result .= "$label\n"; } $result .= ""; $self->register_parameter($name); @@ -2287,25 +2287,22 @@ sub url { my ($relative,$absolute,$full,$path_info,$query,$base) = rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p); my $url; - $full++ if $base || !($relative || $absolute); + $full++ if $base || !($relative || $absolute); my $path = $self->path_info; my $script_name = $self->script_name; -# If anybody knows why I ever wrote this please tell me! -# if (exists($ENV{REQUEST_URI})) { -# my $index; -# $script_name = $ENV{REQUEST_URI}; -# # strip query string -# substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0; -# # and path -# if (exists($ENV{PATH_INFO})) { -# (my $encoded_path = $ENV{PATH_INFO}) =~ s!([^a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;; -# substr($script_name,$index) = '' if ($index = rindex($script_name,$encoded_path)) >= 0; -# } -# } else { -# $script_name = $self->script_name; -# } + # for compatibility with Apache's MultiViews + if (exists($ENV{REQUEST_URI})) { + my $index; + $script_name = $ENV{REQUEST_URI}; + $script_name =~ s/\?.+$//; # strip query string + # and path + if (exists($ENV{PATH_INFO})) { + (my $encoded_path = $ENV{PATH_INFO}) =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg; + $script_name =~ s/$encoded_path$//i; + } + } if ($full) { my $protocol = $self->protocol(); @@ -2331,7 +2328,7 @@ sub url { $url .= $path if $path_info and defined $path; $url .= "?" . $self->query_string if $query and $self->query_string; $url = '' unless defined $url; - $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/uc sprintf("%%%02x",ord($1))/eg; + $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg; return $url; } @@ -3366,6 +3363,11 @@ $MAXTRIES = 5000; # %OVERLOAD = ('""'=>'as_string'); *CGITempFile::AUTOLOAD = \&CGI::AUTOLOAD; +sub DESTROY { + my($self) = @_; + unlink $$self; # get rid of the file +} + ############################################################################### ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### ############################################################################### @@ -3387,13 +3389,6 @@ sub new { } END_OF_FUNC -'DESTROY' => <<'END_OF_FUNC', -sub DESTROY { - my($self) = @_; - unlink $$self; # get rid of the file -} -END_OF_FUNC - 'as_string' => <<'END_OF_FUNC' sub as_string { my($self) = @_; diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm index a3b8b40..dbb78c8 100644 --- a/lib/CGI/Carp.pm +++ b/lib/CGI/Carp.pm @@ -318,10 +318,10 @@ sub set_message { return $CGI::Carp::CUSTOM_MSG; } -sub confess { CGI::Carp::die Carp::longmess \@_; } -sub croak { CGI::Carp::die Carp::shortmess \@_; } -sub carp { CGI::Carp::warn Carp::shortmess \@_; } -sub cluck { CGI::Carp::warn Carp::longmess \@_; } +sub confess { CGI::Carp::die Carp::longmess @_; } +sub croak { CGI::Carp::die Carp::shortmess @_; } +sub carp { CGI::Carp::warn Carp::shortmess @_; } +sub cluck { CGI::Carp::warn Carp::longmess @_; } # We have to be ready to accept a filehandle as a reference # or a string. diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t index 612e2e1..a6a90a6 100755 --- a/lib/CGI/t/form.t +++ b/lib/CGI/t/form.t @@ -85,30 +85,30 @@ is(checkbox(-name => 'weather', -label => 'forecast', -checked => 1, -override => 1), - qq(forecast), + qq(forecast), "checkbox()"); is(checkbox(-name => 'weather', -value => 'dull', -label => 'forecast'), - qq(forecast), + qq(forecast), "checkbox()"); is(radio_group(-name => 'game'), - qq(chess ). + qq(chess ). qq(checkers), 'radio_group()'); is(radio_group(-name => 'game', -labels => {'chess' => 'ping pong'}), - qq(ping pong ). + qq(ping pong ). qq(checkers), 'radio_group()'); is(checkbox_group(-name => 'game', -Values => [qw/checkers chess cribbage/]), - qq(checkers ). - qq(chess ). + qq(checkers ). + qq(chess ). qq(cribbage), 'checkbox_group()'); @@ -117,7 +117,7 @@ is(checkbox_group(-name => 'game', '-defaults' => ['cribbage'],-override=>1), qq(checkers ). qq(chess ). - qq(cribbage), + qq(cribbage), 'checkbox_group()'); is(popup_menu(-name => 'game', @@ -126,9 +126,9 @@ is(popup_menu(-name => 'game', -override => 1)."\n", < - - - + + + END