package CGI;
require 5.001;

# See the bottom of this file for the POD documentation.  Search for the
# string '=head'.

# You can run this file through either pod2man or pod2html to produce pretty
# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).

# Copyright 1995-1997 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 
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

# The most recent version and complete docs are available at:
#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/

# Set this to 1 to enable copious autoloader debugging messages
$AUTOLOAD_DEBUG=0;

# Set this to 1 to enable NPH scripts
# or: 
#    1) use CGI qw(:nph)
#    2) $CGI::nph(1)
#    3) print header(-nph=>1)
$NPH=0;

# Set this to 1 to make the temporary files created
# during file uploads safe from prying eyes
# or do...
#    1) use CGI qw(:private_tempfiles)
#    2) $CGI::private_tempfiles(1);
$PRIVATE_TEMPFILES=0;

$CGI::revision = '$Id: CGI.pm,v 1.1.1.1 1997/05/17 21:40:50 neeri Exp $';
$CGI::VERSION='2.36';

# OVERRIDE THE OS HERE IF CGI.pm GUESSES WRONG
# $OS = 'UNIX';
# $OS = 'MACINTOSH';
# $OS = 'WINDOWS';
# $OS = 'VMS';
# $OS = 'OS2';

# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
# $TempFile::TMPDIRECTORY = '/usr/tmp';

# ------------------ START OF THE LIBRARY ------------

# FIGURE OUT THE OS WE'RE RUNNING UNDER
# Some systems support the $^O variable.  If not
# available then require() the Config library
unless ($OS) {
    unless ($OS = $^O) {
	require Config;
	$OS = $Config::Config{'osname'};
    }
}
if ($OS=~/Win/i) {
    $OS = 'WINDOWS';
} elsif ($OS=~/vms/i) {
    $OS = 'VMS';
} elsif ($OS=~/Mac/i) {
    $OS = 'MACINTOSH';
} elsif ($OS=~/os2/i) {
    $OS = 'OS2';
} else {
    $OS = 'UNIX';
}

# Some OS logic.  Binary mode enabled on DOS, NT and VMS
$needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;

# This is the default class for the CGI object to use when all else fails.
$DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
# This is where to look for autoloaded routines.
$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;

# The path separator is a slash, backslash or semicolon, depending
# on the paltform.
$SL = {
    UNIX=>'/',
    OS2=>'\\',
    WINDOWS=>'\\',
    MACINTOSH=>':',
    VMS=>'\\'
    }->{$OS};

# Turn on NPH scripts by default when running under IIS server!
$NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;

# Turn on special checking for Doug MacEachern's modperl
if (defined($ENV{'GATEWAY_INTERFACE'}) && ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/)) {
    $NPH++;
    $| = 1;
    $SEQNO = 1;
}

# This is really "\r\n", but the meaning of \n is different
# in MacPerl, so we resort to octal here.
$CRLF = "\015\012";

if ($needs_binmode) {
    $CGI::DefaultClass->binmode(main::STDOUT);
    $CGI::DefaultClass->binmode(main::STDIN);
    $CGI::DefaultClass->binmode(main::STDERR);
}

# Cute feature, but it broke when the overload mechanism changed...
# %OVERLOAD = ('""'=>'as_string');

%EXPORT_TAGS = (
	      ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em
			 tt i b blockquote pre img a address cite samp dfn html head
			 base body link nextid title meta kbd start_html end_html
			 input Select option/],
	      ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont style span/],
	      ':netscape'=>[qw/blink frameset frame script font fontsize center/],
	      ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group 
		       submit reset defaults radio_group popup_menu button autoEscape
		       scrolling_list image_button start_form end_form startform endform
		       start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
	      ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
		       raw_cookie request_method query_string accept user_agent remote_host 
		       remote_addr referer server_name server_software server_port server_protocol
		       virtual_host remote_ident auth_type http use_named_parameters
		       remote_user user_name header redirect import_names put/],
	      ':ssl' => [qw/https/],
	      ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
	      ':html' => [qw/:html2 :html3 :netscape/],
	      ':standard' => [qw/:html2 :form :cgi/],
	      ':all' => [qw/:html2 :html3 :netscape :form :cgi/]
	 );

# to import symbols into caller
sub import {
    my $self = shift;
    my ($callpack, $callfile, $callline) = caller;
    foreach (@_) {
	$NPH++, next if $_ eq ':nph';
	$PRIVATE_TEMPFILES++, next if $_ eq ':private_tempfiles';
	foreach (&expand_tags($_)) {
	    tr/a-zA-Z0-9_//cd;  # don't allow weird function names
	    $EXPORT{$_}++;
	}
    }
    # To allow overriding, search through the packages
    # Till we find one in which the correct subroutine is defined.
    my @packages = ($self,@{"$self\:\:ISA"});
    foreach $sym (keys %EXPORT) {
	my $pck;
	my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass;
	foreach $pck (@packages) {
	    if (defined(&{"$pck\:\:$sym"})) {
		$def = $pck;
		last;
	    }
	}
	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
    }
}

sub expand_tags {
    my($tag) = @_;
    my(@r);
    return ($tag) unless $EXPORT_TAGS{$tag};
    foreach (@{$EXPORT_TAGS{$tag}}) {
	push(@r,&expand_tags($_));
    }
    return @r;
}

#### Method: new
# The new routine.  This will check the current environment
# for an existing query string, and initialize itself, if so.
####
sub new {
    my($class,$initializer) = @_;
    my $self = {};
    bless $self,ref $class || $class || $DefaultClass;
    $CGI::DefaultClass->_reset_globals() if $MOD_PERL;
    $initializer = to_filehandle($initializer) if $initializer;
    $self->init($initializer);
    return $self;
}

# We provide a DESTROY method so that the autoloader
# doesn't bother trying to find it.
sub DESTROY { }

#### Method: param
# Returns the value(s)of a named parameter.
# If invoked in a list context, returns the
# entire list.  Otherwise returns the first
# member of the list.
# If name is not provided, return a list of all
# the known parameters names available.
# If more than one argument is provided, the
# second and subsequent arguments are used to
# set the value of the parameter.
####
sub param {
    my($self,@p) = self_or_default(@_);
    return $self->all_parameters unless @p;
    my($name,$value,@other);

    # For compatibility between old calling style and use_named_parameters() style, 
    # we have to special case for a single parameter present.
    if (@p > 1) {
	($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
	my(@values);

	if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
	    @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
	} else {
	    foreach ($value,@other) {
		push(@values,$_) if defined($_);
	    }
	}
	# If values is provided, then we set it.
	if (@values) {
	    $self->add_parameter($name);
	    $self->{$name}=[@values];
	}
    } else {
	$name = $p[0];
    }

    return () unless defined($name) && $self->{$name};
    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}

#### Method: delete
# Deletes the named parameter entirely.
####
sub delete {
    my($self,$name) = self_or_default(@_);
    delete $self->{$name};
    delete $self->{'.fieldnames'}->{$name};
    @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
    return wantarray ? () : undef;
}

sub self_or_default {
    return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI');
    unless (defined($_[0]) && 
	    ref($_[0]) &&
	    (ref($_[0]) eq 'CGI' ||
	     eval "\$_[0]->isaCGI()")) { # optimize for the common case
	$CGI::DefaultClass->_reset_globals() 
	    if defined($Q) && $MOD_PERL && $CGI::DefaultClass->_new_request();
	$Q = $CGI::DefaultClass->new unless defined($Q);
	unshift(@_,$Q);
    }
    return @_;
}

sub _new_request {
    return undef unless (defined(Apache->seqno()) or eval { require Apache });
    if (Apache->seqno() != $SEQNO) {
	$SEQNO = Apache->seqno();
	return 1;
    } else {
	return undef;
    }
}

sub _reset_globals {
    undef $Q;
    undef @QUERY_PARAM;
}

sub self_or_CGI {
    local $^W=0;                # prevent a warning
    if (defined($_[0]) &&
	(substr(ref($_[0]),0,3) eq 'CGI' 
	 || eval "\$_[0]->isaCGI()")) {
	return @_;
    } else {
	return ($DefaultClass,@_);
    }
}

sub isaCGI {
    return 1;
}

#### Method: import_names
# Import all parameters into the given namespace.
# Assumes namespace 'Q' if not specified
####
sub import_names {
    my($self,$namespace) = self_or_default(@_);
    $namespace = 'Q' unless defined($namespace);
    die "Can't import names into 'main'\n"
	if $namespace eq 'main';
    my($param,@value,$var);
    foreach $param ($self->param) {
	# protect against silly names
	($var = $param)=~tr/a-zA-Z0-9_/_/c;
	$var = "${namespace}::$var";
	@value = $self->param($param);
	@{$var} = @value;
	${$var} = $value[0];
    }
}

#### Method: use_named_parameters
# Force CGI.pm to use named parameter-style method calls
# rather than positional parameters.  The same effect
# will happen automatically if the firs