# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.18 1999/06/09 14:52:45 lstein Exp $';
-$CGI::VERSION='2.53';
+$CGI::revision = '$Id: CGI.pm,v 1.19 1999/08/31 17:04:37 lstein Exp $';
+$CGI::VERSION='2.56';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
$OS = 'WINDOWS';
} elsif ($OS=~/vms/i) {
$OS = 'VMS';
+} elsif ($OS=~/bsdos/i) {
+ $OS = 'UNIX';
} elsif ($OS=~/dos/i) {
$OS = 'DOS';
} elsif ($OS=~/^MacOS$/i) {
# if we get called more than once, we want to initialize
# ourselves from the original query (which may be gone
# if it was read from STDIN originally.)
- if (defined(@QUERY_PARAM) && !defined($initializer)) {
+ if (@QUERY_PARAM && !defined($initializer)) {
foreach (@QUERY_PARAM) {
$self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
}
# We now have the query string in hand. We do slightly
# different things for keyword lists and parameter lists.
- if ($query_string ne '') {
+ if (defined $query_string && $query_string) {
if ($query_string =~ /=/) {
$self->parse_params($query_string);
} else {
# unescape URL-encoded data
sub unescape {
- shift() if ref($_[0]) || $_[0] eq $DefaultClass;
+ shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
my $todecode = shift;
return undef unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
# URL-encode data
sub escape {
- shift() if ref($_[0]) || $_[0] eq $DefaultClass;
- my $toencode = shift;
- return undef unless defined($toencode);
- $toencode=~s/ /+/g;
- $toencode=~s/([^a-zA-Z0-9_.+-])/uc sprintf("%%%02x",ord($1))/eg;
- return $toencode;
+ shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
+ my $toencode = shift;
+ return undef unless defined($toencode);
+ $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+ return $toencode;
}
sub save_request {
sub keywords {
my($self,@values) = self_or_default(@_);
# If values is provided, then we set it.
- $self->{'keywords'}=[@values] if defined(@values);
+ $self->{'keywords'}=[@values] if @values;
my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : ();
@result;
}
# with Steve Brenner's cgi-lib.pl routines
'Vars' => <<'END_OF_FUNC',
sub Vars {
+ my $q = shift;
my %in;
- tie(%in,CGI);
+ tie(%in,CGI,$q);
return %in if wantarray;
return \%in;
}
'TIEHASH' => <<'END_OF_FUNC',
sub TIEHASH {
- return $Q || new CGI;
+ return $_[1] if defined $_[1];
+ return $Q || new shift;
}
END_OF_FUNC
'endform' => <<'END_OF_FUNC',
sub endform {
my($self,@p) = self_or_default(@_);
- return ($self->get_fields,"</FORM>");
+ return wantarray ? ($self->get_fields,"</FORM>") :
+ $self->get_fields ."\n</FORM>";
}
END_OF_FUNC
# rearrange into a pretty table
$result = "<TABLE>";
my($row,$column);
- unshift(@$colheaders,'') if defined(@$colheaders) && defined(@$rowheaders);
- $result .= "<TR>" if defined(@{$colheaders});
+ unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
+ $result .= "<TR>" if @$colheaders;
foreach (@{$colheaders}) {
$result .= "<TH>$_</TH>";
}
for ($row=0;$row<$rows;$row++) {
$result .= "<TR>";
- $result .= "<TH>$rowheaders->[$row]</TH>" if defined(@$rowheaders);
+ $result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
for ($column=0;$column<$columns;$column++) {
$result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>"
if defined($elements[$column*$rows + $row]);
$name=$self->escapeHTML($name);
foreach (@value) {
- $_=$self->escapeHTML($_);
+ $_ = defined($_) ? $self->escapeHTML($_) : '';
push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
}
return wantarray ? @result : join('',@result);
# strip query string
substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0;
# and path
- substr($script_name,$index) = '' if $path and ($index = rindex($script_name,$path)) >= 0;
+ substr($script_name,$index) = '' if exists($ENV{PATH_INFO})
+ and ($index = rindex($script_name,$ENV{PATH_INFO})) >= 0;
} else {
$script_name = $self->script_name;
}
# If no filename specified, then just read the data and assign it
# to our parameter list.
- unless ($filename) {
+ if ( !defined($filename) || $filename eq '' ) {
my($value) = $buffer->readBody;
push(@{$self->{$param}},$value);
next;
for (my $cnt=10;$cnt>0;$cnt--) {
next unless $tmpfile = new TempFile($seqno);
$tmp = $tmpfile->as_string;
- last if $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES);
+ last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
$seqno += int rand(100);
}
die "CGI open of tmpfile: $!\n" unless $filehandle;
# Save some information about the uploaded file where we can get
# at it later.
- $self->{'.tmpfiles'}->{$filename}= {
+ $self->{'.tmpfiles'}->{fileno($filehandle)}= {
name => $tmpfile,
info => {%header},
};
'tmpFileName' => <<'END_OF_FUNC',
sub tmpFileName {
my($self,$filename) = self_or_default(@_);
- return $self->{'.tmpfiles'}->{$filename}->{name} ?
- $self->{'.tmpfiles'}->{$filename}->{name}->as_string
+ return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ?
+ $self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string
: '';
}
END_OF_FUNC
'uploadInfo' => <<'END_OF_FUNC',
sub uploadInfo {
my($self,$filename) = self_or_default(@_);
- return $self->{'.tmpfiles'}->{$filename}->{info};
+ return $self->{'.tmpfiles'}->{fileno($filename)}->{info};
}
END_OF_FUNC
sub asString {
my $self = shift;
# get rid of package name
- (my $i = $$self) =~ s/^\*(\w+::)+//;
+ (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//;
$i =~ s/\\(.)/$1/g;
return $i;
# BEGIN DEAD CODE
sub new {
my($pack,$name,$file,$delete) = @_;
require Fcntl unless defined &Fcntl::O_RDWR;
- ++$FH;
- my $ref = \*{'Fh::' . quotemeta($name)};
+ my $ref = \*{'Fh::' . ++$FH . quotemeta($name)};
sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
unlink($file) if $delete;
CORE::delete $Fh::{$FH};
$file = $query->upload('uploaded_file');
if (!$file && $query->cgi_error) {
- print $query->header(-status->$query->cgi_error);
+ print $query->header(-status=>$query->cgi_error);
exit 0;
}
-rows=>10,
-columns=>50);
- print "<P>",$query->Reset;
+ print "<P>",$query->reset;
print $query->submit('Action','Shout');
print $query->submit('Action','Scream');
print $query->endform;