view release on metacpan or  search on metacpan

lib/Apache/ASP/CGI.pm  view on Meta::CPAN

				   'env'       =>    "\%",
				   'filename'  =>    "\$",
				   'get_basic_auth_pw' => "\$",
				   'headers_in' =>    "Apache::ASP::CGI::Table",
				   'headers_out'=>    "Apache::ASP::CGI::Table",
				   'err_headers_out' => "Apache::ASP::CGI::Table",
				   'subprocess_env'  => "Apache::ASP::CGI::Table",
				   'method'    =>    "\$",
				   'sent_header' =>  "\$",
				   'OUT'    =>    "\$",
			       }
			       );
    }

    # create struct
    my $self = new();
    if(defined $ENV{GATEWAY_INTERFACE} and $ENV{GATEWAY_INTERFACE} =~ /^CGI/) {
	# nothing, don't need CGI object anymore
    } else {
	# command line
	my %args = @args;
	$ENV{QUERY_STRING} = join('&', map { "$_=$args{$_}" } keys %args);
    }
    
    $self->connection(Apache::ASP::CGI::connection->new);
    $self->dir_config(Apache::ASP::CGI::Table->new);
    $self->err_headers_out(Apache::ASP::CGI::Table->new);
    $self->headers_out(Apache::ASP::CGI::Table->new);
    $self->headers_in(Apache::ASP::CGI::Table->new);
    $self->subprocess_env(Apache::ASP::CGI::Table->new);

    my $env = $self->subprocess_env;
    %$env = %ENV;

    $self->filename($filename);
    $self->connection->remote_ip($ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR} || '0.0.0.0');
    $self->connection->aborted(0);
    $self->current_callback('PerlHandler');

    # $self->headers_in->set('Cookie', $ENV{HTTP_COOKIE});
    for my $env_key ( sort keys %ENV ) {
	if($env_key =~ /^HTTP_(.+)$/ or $env_key =~ /^(CONTENT_TYPE|CONTENT_LENGTH)$/) {
	    my $env_header_in = $1;
	    my $header_key = join('-', map { ucfirst(lc($_)) } split(/\_/, $env_header_in));
	    $self->headers_in->set($header_key, $ENV{$env_key});
	}
    }

    # we kill the state for now stuff for now, as it's just leaving .state
    # directories everywhere you run this stuff
    defined($self->dir_config->get('NoState')) || $self->dir_config->set('NoState', 1);

    $self->method($ENV{REQUEST_METHOD} || 'GET');

    for my $env_key ( keys %ENV ) {
	$self->env($env_key, $ENV{$env_key});
    }
    $self->env('SCRIPT_NAME') || $self->env('SCRIPT_NAME', $filename);

    # fix truncated output in standalone CGI mode under Win32
    binmode(STDOUT);

    bless $self, $class;
}

sub init_dir_config {
    my($self, %config) = @_;
    my $dir_config = $self->dir_config;
    %$dir_config = %config;
    $dir_config;
}

sub status { 
    my($self, $status) = @_;
    if(defined($status)) {
	$self->headers_out->set('status', $status);
    } else {
	$self->headers_out->get('status');
    }
}

sub cgi_env { %{$_[0]->env} ; }

sub send_http_header {
    my($self) = @_;
    my($k, $v, $header);
    
    $self->sent_header(1);
    $header = "Content-Type: " .$self->content_type()."\n";
    
    for my $headers ($self->headers_out, $self->err_headers_out) {
        while(($k, $v) = each %$headers) {
	    next if ($k =~ /^content\-type$/i);
	    if(ref $v) {
		# if ref, then we have an array for cgi_header_out for cookies
		for my $value (@$v) {
		    $value ||= '';
		    $header .= "$k: $value\n";
		}
	    } else {
		$v ||= '';
		$header .= "$k: $v\n";	    
	    }
	}
    }

    $header .= "\n";
 	
    $self->print($header);
}

sub send_cgi_header {
    my($self, $header) = @_;

    $self->sent_header(1);
    my(@left);
    for(split(/\n/, $header)) {
	my($name, $value) = split(/\:\s*/, $_, 2);
	if($name =~ /content-type/i) {
	    $self->content_type($value);
	} else {