Apache-SdnFw

 view release on metacpan or  search on metacpan

lib/Apache/SdnFw.pm  view on Meta::CPAN

		if ($r->protocol =~ /1\.1/) {
			my %vary = map {$_,1} qw(Accept-Encoding User-Agent);
			if (my @vary = $r->header_out('Vary')) {
				@vary{@vary} = ();
			}
			$r->header_out('Vary' => join ',', keys %vary);
		}
		$r->content_encoding('gzip');
	}

	$r->content_type($s->{r}{content_type});
	$r->headers_out->add('Content-Disposition' => "filename=$s->{r}{filename}")
		if ($s->{r}{filename});

	if (defined($s->{r}{headers})) {
		foreach my $k (keys %{$s->{r}{headers}}) {
			$r->headers_out->add($k => $s->{r}{headers}{$k});
		}
	}

	$r->send_http_header;

	if ($s->{r}{file_path}) {
		# send a raw file
		open(FILE, $s->{r}{file_path});
		$r->send_fd( \*FILE );
		close(FILE);
	} else {
		# or just send back content

		wrap_template($s) if ($s->{r}{content_type} eq 'text/html' && !$s->{raw_html});

		if ($s->{save_static}) {
			my $fname = "$s->{object}_$s->{function}.html";
			open F, ">/data/$s->{obase}/content/$fname";
			print F $s->{r}{content};
			close F;
		}

		if ($gzip) {
			$r->print(Compress::Zlib::memGzip($s->{r}{content}));
		} else {
			$r->print($s->{r}{content});
		
		}
	}

	return HTTP_OK;
}

sub wrap_template {
	my $s = shift;

	my $favicon = qq(<link rel="shortcut icon" href="/favicon.ico">)
		if (-e "/data/$s->{obase}/content/favicon.ico");

	$s->{r}{content} = <<END;
<!DOCTYPE html>
<html lang="en">
<head>
	<meta charset="utf-8" />
	$favicon
$s->{r}{head}
</head>
<body $s->{r}{body}>
$s->{r}{content}
</body>
</html>
END

}

sub _start_dbdebug {
	my $options = shift;

	$options->{dbdbst} = time;
	$options->{dbdbdata} = "!!!$options->{dbdbst}|$options->{uri}\t";
}

sub _end_dbdebug {
	my $s = shift;

	my $elapse = sprintf "%.4f", time-$s->{dbdbst};

	$s->{dbdbdata} .= "###($elapse)";

	my $sock = IO::Socket::INET->new(
		PeerAddr => '127.0.0.1',
		PeerPort => 11271,
		Proto => 'udp',
		Blocking => 0,
		);
	
	print $sock $s->{dbdbdata};
	$sock->close();
}

sub error {
	my $r = shift;
	my $msg = shift;

	# TODO: Dump out the message somewhere
	# about where this error occured

	# for now just print the crap that comes back
	#$r->content_type('text/plain');
	#$r->send_http_header;
	$r->print($msg);

	return HTTP_OK;
}

sub get_params {
	my $r = shift;
	my $o = shift;

	my $input;
	if ($o->{env}{REQUEST_METHOD} ne "GET") {
		my $buffer;         
		while (my $ret = $r->read_client_block($buffer,2048)) {
			$input .= substr($buffer,0,$ret);



( run in 3.228 seconds using v1.01-cache-2.11-cpan-75ffa21a3d4 )