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 )