Apache-Pod
view release on metacpan or search on metacpan
lib/Apache/Pod/HTML.pm view on Meta::CPAN
SetHandler perl-script
PerlHandler Apache::Pod::HTML
PerlSetVar STYLESHEET auto
</Location>
Specifying 'auto' for the stylesheet will cause the built-in CSS
stylesheet to be used. If you prefer, you can replace the word 'auto'
with the URL of your own custom stylesheet file.
=head2 INDEX
When INDEX is true, a table of contents is added at the top of the
HTML document.
<Files *.pod>
SetHandler perl-script
PerlHandler Apache::Pod::HTML
PerlSetVar INDEX 1
</Files>
By default, this is off.
=head2 GZIP
When GZIP is true, the whole HTTP body is compressed. The user's browser must
accept gzip, and L<Compress::Zlib> must be available. Otherwise, GZIP is ignored.
<Files *.pod>
SetHandler perl-script
PerlHandler Apache::Pod::HTML
PerlSetVar GZIP 1
</Files>
By default, this is off.
=head2 LINKBASE
Specifying an optional C<LINKBASE> variable changes the external
HTTP links to use a URL prefix of your specification instead of using
L<Pod::Simple::HTML>'s default. Using the magic word C<LOCAL> will make
links local instead of external.
=cut
sub handler {
my $r = shift;
if ( $r->path_info eq '/auto.css' ) {
$r->content_type( 'text/css' );
$r->send_http_header;
$r->print( _css() );
return OK;
}
my $body;
my $file = Apache::Pod::getpodfile( $r );
if ( $file ) {
my $parser = Pod::Simple::HTML->new;
$parser->no_errata_section(1);
$parser->complain_stderr(1);
$parser->output_string( \$body );
$parser->index( $r->dir_config('INDEX') );
if ( my $prefix = $r->dir_config('LINKBASE') ) {
if ( $prefix eq 'LOCAL' ) {
$prefix = $r->location . '/';
}
$parser->perldoc_url_prefix( $prefix );
}
$parser->parse_file( $file );
# TODO: Send the timestamp of the file in the header
my $stylesheet = $r->dir_config('STYLESHEET') || '';
$stylesheet = $r->location . '/auto.css' if $stylesheet =~ /^auto/i;
if ( $stylesheet ) {
# Stick in a link to our stylesheet
$stylesheet = qq(<LINK REL="stylesheet" HREF="$stylesheet" TYPE="text/css">);
$body =~ s{(?=</head)}{$stylesheet\n}i;
}
if ( $r->dir_config('GZIP') && ($r->header_in('Accept-Encoding') =~ /gzip/) ) {
local $@;
eval {
require Compress::Zlib;
$body = Compress::Zlib::memGzip( $body );
$r->header_out('Content-Encoding','gzip');
};
}
} else {
$body = "<HTML><HEAD><TITLE>Not found</TITLE></HEAD><BODY>That module doesn't exist</BODY></HTML>";
}
$r->content_type('text/html');
$r->send_http_header;
$r->print( $body );
return OK;
}
sub _css {
return <<'EOF';
BODY {
background: white;
color: black;
font-family: times,serif;
margin: 0;
padding: 1ex;
}
TABLE {
border-collapse: collapse;
border-spacing: 0;
border-width: 0;
color: inherit;
}
A:link, A:visited {
background: transparent;
color: #006699;
}
PRE {
( run in 1.021 second using v1.01-cache-2.11-cpan-39bf76dae61 )