diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CGI')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CGI/Carp.pm | 41 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CGI/Cookie.pm | 245 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CGI/Pretty.pm | 2 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CGI/Push.pm | 4 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CGI/Util.pm | 25 |
5 files changed, 170 insertions, 147 deletions
diff --git a/Master/tlpkg/tlperl/lib/CGI/Carp.pm b/Master/tlpkg/tlperl/lib/CGI/Carp.pm index 5f9911b32e5..9d644d9c94c 100644 --- a/Master/tlpkg/tlperl/lib/CGI/Carp.pm +++ b/Master/tlpkg/tlperl/lib/CGI/Carp.pm @@ -116,7 +116,7 @@ occur in the early compile phase will be seen. Nonfatal errors will still be directed to the log file only (unless redirected with carpout). -Note that fatalsToBrowser does B<not> work with mod_perl version 2.0 +Note that fatalsToBrowser may B<not> work well with mod_perl version 2.0 and higher. =head2 Changing the default message @@ -183,6 +183,28 @@ attempting to set SIG{__DIE__} yourself, you may interfere with this module's functionality, or this module may interfere with your module's functionality. +=head2 SUPPRESSING PERL ERRORS APPEARING IN THE BROWSER WINDOW + +A problem sometimes encountered when using fatalsToBrowser is +when a C<die()> is done inside an C<eval> body or expression. +Even though the +fatalsToBrower support takes precautions to avoid this, +you still may get the error message printed to STDOUT. +This may have some undesireable effects when the purpose of doing the +eval is to determine which of several algorithms is to be used. + +By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing the C<die> messages +but without all of the complexity of using C<set_die_handler>. +You can localize this effect to inside C<eval> bodies if this is desireable: +For example: + + eval { + local $CGI::Carp::TO_BROWSER = 0; + die "Fatal error messages not sent browser" + } + # $@ will contain error message + + =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS It is now also possible to make non-fatal errors appear as HTML @@ -245,6 +267,8 @@ non-overridden program name =head1 CHANGE LOG +3.51 Added $CGI::Carp::TO_BROWSER + 1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp not behaving correctly in an eval() context. @@ -321,9 +345,10 @@ use File::Spec; $main::SIG{__WARN__}=\&CGI::Carp::warn; -$CGI::Carp::VERSION = '3.45'; +$CGI::Carp::VERSION = '3.51'; $CGI::Carp::CUSTOM_MSG = undef; $CGI::Carp::DIE_HANDLER = undef; +$CGI::Carp::TO_BROWSER = 1; # fancy import routine detects and handles 'errorWrap' specially. @@ -421,23 +446,27 @@ sub ineval { } sub die { - my ($arg,@rest) = @_; + # if no argument is passed, propagate $@ like + # the real die + my ($arg,@rest) = @_ ? @_ + : $@ ? "$@\t...propagated" + : "Died" + ; &$DIE_HANDLER($arg,@rest) if $DIE_HANDLER; + # the "$arg" is done on purpose! # if called as die( $object, 'string' ), # all is stringified, just like with # the real 'die' $arg = join '' => "$arg", @rest if @rest; - $arg ||= 'Died'; - my($file,$line,$id) = id(1); $arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/; realdie $arg if ineval(); - &fatalsToBrowser($arg) if $WRAP; + &fatalsToBrowser($arg) if ($WRAP and $CGI::Carp::TO_BROWSER); $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL}; diff --git a/Master/tlpkg/tlperl/lib/CGI/Cookie.pm b/Master/tlpkg/tlperl/lib/CGI/Cookie.pm index 7bc090d4186..df344ff348f 100644 --- a/Master/tlpkg/tlperl/lib/CGI/Cookie.pm +++ b/Master/tlpkg/tlperl/lib/CGI/Cookie.pm @@ -12,23 +12,20 @@ use warnings; # Copyright 1995-1999, Lincoln D. Stein. All rights reserved. # It may be used and modified freely, but I do request that this copyright -# notice remain attached to the file. You may modify this module as you +# notice remain attached to the file. You may modify this module as you # wish, but if you redistribute a modified version, please attach a note # listing the modifications you have made. -$CGI::Cookie::VERSION='1.29'; +our $VERSION='1.30'; use CGI::Util qw(rearrange unescape escape); -use CGI; -use overload '""' => \&as_string, - 'cmp' => \&compare, - 'fallback'=>1; +use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1; my $PERLEX = 0; # Turn on special checking for ActiveState's PerlEx $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; -# Turn on special checking for Doug MacEachern's modperl +# Turn on special checking for mod_perl # PerlEx::DBI tries to fool DBI by setting MOD_PERL my $MOD_PERL = 0; if (exists $ENV{MOD_PERL} && ! $PERLEX) { @@ -60,20 +57,14 @@ sub fetch { my($key,$value); my @pairs = split("[;,] ?",$raw_cookie); - foreach (@pairs) { - s/\s*(.*?)\s*/$1/; - if (/^([^=]+)=(.*)/) { - $key = $1; - $value = $2; - } - else { - $key = $_; - $value = ''; - } - $results{$key} = $value; - } - return \%results unless wantarray; - return %results; + for my $pair ( @pairs ) { + $pair =~ s/^\s+|\s+$//g; # trim leading trailing whitespace + my ( $key, $value ) = split "=", $pair; + + $value = defined $value ? $value : ''; + $results{$key} = $value; + } + return wantarray ? %results : \%results; } sub get_raw_cookie { @@ -93,11 +84,15 @@ sub get_raw_cookie { sub parse { my ($self,$raw_cookie) = @_; + return wantarray ? () : {} unless $raw_cookie; + my %results; my @pairs = split("[;,] ?",$raw_cookie); - foreach (@pairs) { - s/\s*(.*?)\s*/$1/; + for (@pairs) { + s/^\s+//; + s/\s+$//; + my($key,$value) = split("=",$_,2); # Some foreign cookies are not in name=value format, so ignore @@ -113,49 +108,37 @@ sub parse { # appear. The FIRST one in HTTP_COOKIE is the most recent version. $results{$key} ||= $self->new(-name=>$key,-value=>\@values); } - return \%results unless wantarray; - return %results; + return wantarray ? %results : \%results; } sub new { - my $class = shift; - $class = ref($class) if ref($class); - # Ignore mod_perl request object--compatability with Apache::Cookie. - shift if ref $_[0] - && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') }; - my($name,$value,$path,$domain,$secure,$expires,$httponly) = - rearrange([ 'NAME', ['VALUE','VALUES'], qw/ PATH DOMAIN SECURE EXPIRES - HTTPONLY / ], @_); - - # Pull out our parameters. - my @values; - if (ref($value)) { - if (ref($value) eq 'ARRAY') { - @values = @$value; - } elsif (ref($value) eq 'HASH') { - @values = %$value; - } - } else { - @values = ($value); - } - - bless my $self = { - 'name'=>$name, - 'value'=>[@values], - },$class; - - # IE requires the path and domain to be present for some reason. - $path ||= "/"; - # however, this breaks networks which use host tables without fully qualified - # names, so we comment it out. - # $domain = CGI::virtual_host() unless defined $domain; - - $self->path($path) if defined $path; - $self->domain($domain) if defined $domain; - $self->secure($secure) if defined $secure; - $self->expires($expires) if defined $expires; - $self->httponly($httponly) if defined $httponly; -# $self->max_age($expires) if defined $expires; + my ( $class, @params ) = @_; + $class = ref( $class ) || $class; + # Ignore mod_perl request object--compatibility with Apache::Cookie. + shift if ref $params[0] + && eval { $params[0]->isa('Apache::Request::Req') || $params[0]->isa('Apache') }; + my ( $name, $value, $path, $domain, $secure, $expires, $max_age, $httponly ) + = rearrange( + [ + 'NAME', [ 'VALUE', 'VALUES' ], + 'PATH', 'DOMAIN', + 'SECURE', 'EXPIRES', + 'MAX-AGE','HTTPONLY' + ], + @params + ); + return undef unless defined $name and defined $value; + my $self = {}; + bless $self, $class; + $self->name( $name ); + $self->value( $value ); + $path ||= "/"; + $self->path( $path ) if defined $path; + $self->domain( $domain ) if defined $domain; + $self->secure( $secure ) if defined $secure; + $self->expires( $expires ) if defined $expires; + $self->max_age($expires) if defined $max_age; + $self->httponly( $httponly ) if defined $httponly; return $self; } @@ -163,23 +146,24 @@ sub as_string { my $self = shift; return "" unless $self->name; - my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly); + no warnings; # some things may be undefined, that's OK. + + my $name = escape( $self->name ); + my $value = join "&", map { escape($_) } $self->value; + my @cookie = ( "$name=$value" ); - push(@constant_values,"domain=$domain") if $domain = $self->domain; - push(@constant_values,"path=$path") if $path = $self->path; - push(@constant_values,"expires=$expires") if $expires = $self->expires; - push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age; - push(@constant_values,"secure") if $secure = $self->secure; - push(@constant_values,"HttpOnly") if $httponly = $self->httponly; + push @cookie,"domain=".$self->domain if $self->domain; + push @cookie,"path=".$self->path if $self->path; + push @cookie,"expires=".$self->expires if $self->expires; + push @cookie,"max-age=".$self->max_age if $self->max_age; + push @cookie,"secure" if $self->secure; + push @cookie,"HttpOnly" if $self->httponly; - my($key) = escape($self->name); - my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value)); - return join("; ",$cookie,@constant_values); + return join "; ", @cookie; } sub compare { - my $self = shift; - my $value = shift; + my ( $self, $value ) = @_; return "$self" cmp $value; } @@ -194,6 +178,7 @@ sub bake { if ($r) { $r->headers_out->add('Set-Cookie' => $self->as_string); } else { + require CGI; print CGI::header(-cookie => $self); } @@ -201,70 +186,56 @@ sub bake { # accessors sub name { - my $self = shift; - my $name = shift; + my ( $self, $name ) = @_; $self->{'name'} = $name if defined $name; return $self->{'name'}; } sub value { - my $self = shift; - my $value = shift; - if (defined $value) { - my @values; - if (ref($value)) { - if (ref($value) eq 'ARRAY') { - @values = @$value; - } elsif (ref($value) eq 'HASH') { - @values = %$value; - } - } else { - @values = ($value); - } - $self->{'value'} = [@values]; - } - return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0] + my ( $self, $value ) = @_; + if ( defined $value ) { + my @values + = ref $value eq 'ARRAY' ? @$value + : ref $value eq 'HASH' ? %$value + : ( $value ); + $self->{'value'} = [@values]; + } + return wantarray ? @{ $self->{'value'} } : $self->{'value'}->[0]; } sub domain { - my $self = shift; - my $domain = shift; + my ( $self, $domain ) = @_; $self->{'domain'} = lc $domain if defined $domain; return $self->{'domain'}; } sub secure { - my $self = shift; - my $secure = shift; + my ( $self, $secure ) = @_; $self->{'secure'} = $secure if defined $secure; return $self->{'secure'}; } sub expires { - my $self = shift; - my $expires = shift; + my ( $self, $expires ) = @_; $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires; return $self->{'expires'}; } sub max_age { - my $self = shift; - my $expires = shift; - $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires; - return $self->{'max-age'}; + my ( $self, $max_age ) = @_; + $self->{'max-age'} = CGI::Util::expire_calc($max_age)-time() if defined $max_age; + return $self->{'max-age'}; } sub path { - my $self = shift; - my $path = shift; + my ( $self, $path ) = @_; $self->{'path'} = $path if defined $path; return $self->{'path'}; } sub httponly { # HttpOnly - my $self = shift; - my $httponly = shift; + my ( $self, $httponly ) = @_; $self->{'httponly'} = $httponly if defined $httponly; return $self->{'httponly'}; } @@ -273,7 +244,7 @@ sub httponly { # HttpOnly =head1 NAME -CGI::Cookie - Interface to Netscape Cookies +CGI::Cookie - Interface to HTTP Cookies =head1 SYNOPSIS @@ -281,23 +252,23 @@ CGI::Cookie - Interface to Netscape Cookies use CGI::Cookie; # Create new cookies and send them - $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456); - $cookie2 = new CGI::Cookie(-name=>'preferences', + $cookie1 = CGI::Cookie->new(-name=>'ID',-value=>123456); + $cookie2 = CGI::Cookie->new(-name=>'preferences', -value=>{ font => Helvetica, size => 12 } ); print header(-cookie=>[$cookie1,$cookie2]); # fetch existing cookies - %cookies = fetch CGI::Cookie; + %cookies = CGI::Cookie->fetch; $id = $cookies{'ID'}->value; # create cookies returned from an external source - %cookies = parse CGI::Cookie($ENV{COOKIE}); + %cookies = CGI::Cookie->parse($ENV{COOKIE}); =head1 DESCRIPTION -CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an +CGI::Cookie is an interface to HTTP/1.1 cookies, an innovation that allows Web servers to store persistent information on the browser's side of the connection. Although CGI::Cookie is intended to be used in conjunction with CGI.pm (and is in fact used by @@ -305,7 +276,9 @@ it internally), you can use this module independently. For full information on cookies see - http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt + http://tools.ietf.org/html/rfc2109 + http://tools.ietf.org/html/rfc2965 + http://tools.ietf.org/html/draft-ietf-httpstate-cookie =head1 USING CGI::Cookie @@ -332,7 +305,7 @@ the user quits the browser. This is a partial or complete domain name for which the cookie is valid. The browser will return the cookie to any host that matches the partial domain name. For example, if you specify a domain name -of ".capricorn.com", then Netscape will return the cookie to +of ".capricorn.com", then the browser will return the cookie to Web servers running on any of the machines "www.capricorn.com", "ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names must contain at least two periods to prevent attempts to match @@ -355,24 +328,25 @@ that all scripts at your site will receive the cookie. If the "secure" attribute is set, the cookie will only be sent to your script if the CGI request is occurring on a secure channel, such as SSL. -=item B<4. httponly flag> +=item B<5. httponly flag> If the "httponly" attribute is set, the cookie will only be accessible through HTTP Requests. This cookie will be inaccessible via JavaScript (to prevent XSS attacks). -But, currently this feature only used and recognised by -MS Internet Explorer 6 Service Pack 1 and later. +This feature is only supported by recent browsers like Internet Explorer +6 Service Pack 1, Firefox 3.0 and Opera 9.5 (and later of course). -See this URL for more information: +See these URLs for more information: -L<http://msdn.microsoft.com/en-us/library/ms533046%28VS.85%29.aspx> + http://msdn.microsoft.com/en-us/library/ms533046.aspx + http://www.owasp.org/index.php/HTTPOnly#Browsers_Supporting_HTTPOnly =back =head2 Creating New Cookies - my $c = new CGI::Cookie(-name => 'foo', + my $c = CGI::Cookie->new(-name => 'foo', -value => 'bar', -expires => '+3M', -domain => '.capricorn.com', @@ -390,6 +364,14 @@ B<-expires> accepts any of the relative or absolute date formats recognized by CGI.pm, for example "+3M" for three months in the future. See CGI.pm's documentation for details. +B<-max-age> accepts the same data formats as B<< -expires >>, but sets a +relative value instead of an absolute like B<< -expires >>. This is intended to be +more secure since a clock could be changed to fake an absolute time. In +practice, as of 2011, C<< -max-age >> still does not enjoy the widespread support +that C<< -expires >> has. You can set both, and browsers that support +C<< -max-age >> should ignore the C<< Expires >> header. The drawback +to this approach is the bit of bandwidth for sending an extra header on each cookie. + B<-domain> points to a domain name or to a fully qualified host name. If not specified, the cookie will be returned only to the Web server that created it. @@ -409,7 +391,7 @@ For compatibility with Apache::Cookie, you may optionally pass in a mod_perl request object as the first argument to C<new()>. It will simply be ignored: - my $c = new CGI::Cookie($r, + my $c = CGI::Cookie->new($r, -name => 'foo', -value => ['bar','baz']); @@ -420,6 +402,10 @@ method: $c->bake; +This will print the Set-Cookie HTTP header to STDOUT using CGI.pm. CGI.pm +will be loaded for this purpose if it is not already. Otherwise CGI.pm is not +required or used by this module. + Under mod_perl, pass in an Apache request object: $c->bake($r); @@ -428,7 +414,7 @@ If you want to set the cookie yourself, Within a CGI script you can send a cookie to the browser by creating one or more Set-Cookie: fields in the HTTP header. Here is a typical sequence: - my $c = new CGI::Cookie(-name => 'foo', + my $c = CGI::Cookie->new(-name => 'foo', -value => ['bar','baz'], -expires => '+3M'); @@ -456,14 +442,14 @@ representation. You may call as_string() yourself if you prefer: =head2 Recovering Previous Cookies - %cookies = fetch CGI::Cookie; + %cookies = CGI::Cookie->fetch; B<fetch> returns an associative array consisting of all cookies returned by the browser. The keys of the array are the cookie names. You can iterate through the cookies this way: - %cookies = fetch CGI::Cookie; - foreach (keys %cookies) { + %cookies = CGI::Cookie->fetch; + for (keys %cookies) { do_something($cookies{$_}); } @@ -479,13 +465,16 @@ You may also retrieve cookies that were stored in some external form using the parse() class method: $COOKIES = `cat /usr/tmp/Cookie_stash`; - %cookies = parse CGI::Cookie($COOKIES); + %cookies = CGI::Cookie->parse($COOKIES); If you are in a mod_perl environment, you can save some overhead by passing the request object to fetch() like this: CGI::Cookie->fetch($r); +If the value passed to parse() is undefined, an empty array will returned in list +contact, and an empty hashref will be returned in scalar context. + =head2 Manipulating Cookies Cookie objects have a series of accessor methods to get and set cookie @@ -546,4 +535,6 @@ This section intentionally left blank. L<CGI::Carp>, L<CGI> +L<RFC 2109|http://www.ietf.org/rfc/rfc2109.txt>, L<RFC 2695|http://www.ietf.org/rfc/rfc2965.txt> + =cut diff --git a/Master/tlpkg/tlperl/lib/CGI/Pretty.pm b/Master/tlpkg/tlperl/lib/CGI/Pretty.pm index 356747824d5..869fe0cdf2e 100644 --- a/Master/tlpkg/tlperl/lib/CGI/Pretty.pm +++ b/Master/tlpkg/tlperl/lib/CGI/Pretty.pm @@ -252,7 +252,7 @@ now produces the following output: =head2 Recommendation for when to use CGI::Pretty CGI::Pretty is far slower than using CGI.pm directly. A benchmark showed that -it could be about 10 times slower. Adding newslines and spaces may alter the +it could be about 10 times slower. Adding newlines and spaces may alter the rendered appearance of HTML. Also, the extra newlines and spaces also make the file size larger, making the files take longer to download. diff --git a/Master/tlpkg/tlperl/lib/CGI/Push.pm b/Master/tlpkg/tlperl/lib/CGI/Push.pm index 9e72abda550..2af7d794da1 100644 --- a/Master/tlpkg/tlperl/lib/CGI/Push.pm +++ b/Master/tlpkg/tlperl/lib/CGI/Push.pm @@ -16,7 +16,7 @@ package CGI::Push; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::Push::VERSION='1.04'; +$CGI::Push::VERSION='1.05'; use CGI; use CGI::Util 'rearrange'; @ISA = ('CGI'); @@ -214,7 +214,7 @@ itself should have exactly the same calling conventions as the This optional parameter indicates the content type of each page. It defaults to "text/html". Normally the module assumes that each page -is of a homogenous MIME type. However if you provide either of the +is of a homogeneous MIME type. However if you provide either of the magic values "heterogeneous" or "dynamic" (the latter provided for the convenience of those who hate long parameter names), you can specify the MIME type -- and other header fields -- on a per-page basis. See diff --git a/Master/tlpkg/tlperl/lib/CGI/Util.pm b/Master/tlpkg/tlperl/lib/CGI/Util.pm index eb639e40d59..ef95c9f0189 100644 --- a/Master/tlpkg/tlperl/lib/CGI/Util.pm +++ b/Master/tlpkg/tlperl/lib/CGI/Util.pm @@ -1,15 +1,16 @@ package CGI::Util; use strict; -use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A); +use vars qw($VERSION @EXPORT_OK @ISA @A2E @E2A); require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); -$VERSION = '3.48'; +$VERSION = '3.51'; + +use constant EBCDIC => "\t" ne "\011"; -$EBCDIC = "\t" ne "\011"; # (ord('^') == 95) for codepage 1047 as on os390, vmesa @A2E = ( 0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15, @@ -48,7 +49,7 @@ $EBCDIC = "\t" ne "\011"; 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159 ); -if ($EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set +if (EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set $A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74; $A2E[123] = 251; $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95; $A2E[162] = 176; $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186; @@ -61,7 +62,7 @@ if ($EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character se $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125; $E2A[255] = 126; } -elsif ($EBCDIC && ord('^') == 176) { # as in codepage 037 on os400 +elsif (EBCDIC && ord('^') == 176) { # as in codepage 037 on os400 $A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176; $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173; @@ -210,10 +211,10 @@ sub unescape { my $todecode = shift; return undef unless defined($todecode); $todecode =~ tr/+/ /; # pluses become spaces - if ($EBCDIC) { + if (EBCDIC) { $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge; } else { - # handle surrogate pairs first -- dankogai + # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2 $todecode =~ s{ %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo @@ -272,11 +273,12 @@ EOR } sub escape { + # If we being called in an OO-context, discard the first argument. shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass)); my $toencode = shift; return undef unless defined($toencode); utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode)); - if ($EBCDIC) { + if (EBCDIC) { $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg; } else { $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",ord($1))/eg; @@ -340,7 +342,8 @@ sub expire_calc { } else { return $time; } - return (time+$offset); + my $cur_time = time; + return ($cur_time+$offset); } sub ebcdic2ascii { @@ -373,7 +376,7 @@ no public subroutines =head1 AUTHOR INFORMATION -Copyright 1995-1998, Lincoln D. Stein. All rights reserved. +Copyright 1995-1998, Lincoln D. Stein. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -383,7 +386,7 @@ bug reports, please provide the version of CGI.pm, the version of Perl, the name and version of your Web server, and the name and version of the operating system you are using. If the problem is even remotely browser dependent, please provide information about the -affected browers as well. +affected browsers as well. =head1 SEE ALSO |