view release on metacpan or  search on metacpan

Dynagzip.pm  view on Meta::CPAN

	my $chunkBody = '';
	my $lbr = Compress::LeadingBlankSpaces->new();

	while (defined($buf = <$fh>)){
		$buf = $lbr->squeeze_string ($buf);
		if (length($buf) > 0){
			$chunkBody .= $buf;
		}
		if (length($chunkBody) > $minChunkSizePP){ # send it...
			$body .= $chunkBody;
			print (chunk_out($chunkBody));
			$chunkBody = '';
		}
	}
	if (length($chunkBody) > 0){ # send it...
		$body .= $chunkBody;
		print (chunk_out($chunkBody));
		$chunkBody = '';
	}
	return $body;
}

sub chunkable { # call model: $var = chunkable($r);
	# Check if the response could be chunked
	#
	my $r = shift;
	my $result = undef;
	# this is to downgrade to HTTP/1.0 for MSIE requests over SSL
	# works in conjunction with this snippet from httpd.conf:
	# SetEnvIf User-Agent ".*MSIE.*" \
	# nokeepalive ssl-unclean-shutdown \
	# downgrade-1.0 force-response-1.0
	#
	if ( $ENV{'downgrade-1.0'} or $ENV{'force-response-1.0'} ) {
		$result = 0;
	} elsif ($r->protocol =~ /http\/1\.(\d+)/io) {
		# any HTTP/1.X is OK, just X==0 will be evaluated to FALSE in result
		$result = $1;
	}
	return $result;
}

sub chunk_out { # call model: my $chunk = chunk_out ($string);
	my $HttpEol = "\015\012";  # HTTP end of line marker (see RFC 2068)
	my $source = shift;
	return  sprintf("%x",length($source)).$HttpEol.$source.$HttpEol;
}

sub kill_over_env { # just to clean up the unnessessary environment
	delete($ENV{HISTSIZE});
	delete($ENV{HOSTNAME});
	delete($ENV{LOGNAME});
	delete($ENV{HISTFILESIZE});
	delete($ENV{SSH_TTY});
	delete($ENV{MAIL});
	delete($ENV{MACHTYPE});
	delete($ENV{TERM});
	delete($ENV{HOSTTYPE});
	delete($ENV{OLDPWD});
	delete($ENV{HOME});
	delete($ENV{INPUTRC});
	delete($ENV{SUDO_GID});
	delete($ENV{SHELL});
	delete($ENV{SUDO_UID});
	delete($ENV{USER});
	delete($ENV{SUDO_USER});
	delete($ENV{SSH_CLIENT});
	delete($ENV{OSTYPE});
	delete($ENV{PWD});
	delete($ENV{SHLVL});
	delete($ENV{SUDO_COMMAND});
	delete($ENV{_});
	delete($ENV{HTTP_CONNECTION});
}

sub cgi_headers_from_script {
	# boolin function to determine whether it was configured to retrieve CGI headers from script, or not.
	# 
	# Could it be possible to have Content-Type coming from the previous filter?
	# call model: my $condition = cgi_headers_from_script($r);
	my $r = shift;
	my $res = lc $r->dir_config('UseCGIHeadersFromScript') eq 'on';
	return $res;
}

sub handler { # it is supposed to be only a dispatcher since now...

	my $r = shift;
	my $HttpEol = "\015\012";  # HTTP end of line marker (see RFC 2068)
	my $fh = undef; # will be the reference to the incoming data stream

	my $qualifiedName = join(' ', __PACKAGE__, 'default_content_handler');

	# make sure to dispatch the request appropriately:
	# I serve Perl & Java streams through the Apache::Filter Chain only.
	my $filter = lc $r->dir_config('Filter') eq 'on';
	my $binaryCGI = undef; # It might be On when Filter is Off ONLY.
	unless ($filter){
		$binaryCGI = lc $r->dir_config('BinaryCGI') eq 'on';
	}
	# I assume the Light Compression Off as default:
	my $light_compression = lc $r->dir_config('LightCompression') eq 'on';

	# There are no way to compress and/or chunk the response to internally redirected request.
	# No safe support could be provided for the server-side caching in this case.
	# No way to send back the Content-Length even when one exists for the plain file...
	# Just send back the content assuming it is text/html (or whatever is declared by the main response):
	unless ($r->is_main){
		# this is rdirected request;
		# No control over the HTTP headers:
		my $message = ' No control over the chunks is provided. Light Compression is ';
		if ($light_compression) {
			$message .= 'On.';
		} else {
			$message .= 'Off.';
		}
		$message .= ' Source comes from ';
		if ($filter) {
			$message .= 'Filter Chain.';
		} elsif ($binaryCGI) {
			$message .= 'Binary CGI.';