Apache-Syntax-Highlight-Perl
view release on metacpan or search on metacpan
lib/Apache/Syntax/Highlight/Perl.pm view on Meta::CPAN
package Apache::Syntax::Highlight::Perl;
require 5.005;
use strict;
use vars qw($VERSION);
$VERSION = '1.01';
use mod_perl;
use constant MP2 => ($mod_perl::VERSION >= 1.99);
use Syntax::Highlight::Perl;
use IO::File;
my $can_cache;
my %stat;
BEGIN {
# Tests mod_perl version and uses the appropriate components
if (MP2) {
require Apache::Const;
Apache::Const->import(-compile => qw(DECLINED OK));
require Apache::RequestRec;
require Apache::RequestIO;
require Apache::RequestUtil;
}
else {
require Apache::Constants;
Apache::Constants->import(qw(DECLINED OK));
}
# Test caching necessaries modules
eval { require Digest::MD5; Digest::MD5->can('md5_hex') };
$can_cache = $@ ? 0 : 1;
}
my %default_styles = (
'Comment_Normal' => 'color:#006699;font-style:italic;',
'Comment_POD' => 'color:#001144;font-style:italic;',
'Directive' => 'color:#339999;font-style:italic;',
'Label' => 'color:#993399;font-style:italic;',
'Quote' => 'color:#0000aa;',
'String' => 'color:#0000aa;',
'Subroutine' => 'color:#998800;',
'Variable_Scalar' => 'color:#008800;',
'Variable_Array' => 'color:#ff7700;',
'Variable_Hash' => 'color:#8800ff;',
'Variable_Typeglob' => 'color:#ff0033;',
'Whitespace' => '',
'Character' => 'color:#880000;',
'Keyword' => 'color:#000000;',
'Builtin_Operator' => 'color:#330000;',
'Builtin_Function' => 'color:#000011;',
'Operator' => 'color:#000000;',
'Bareword' => 'color:#33AA33;',
'Package' => 'color:#990000;',
'Number' => 'color:#ff00ff;',
'Symbol' => 'color:#000000;',
'CodeTerm' => 'color:#000000;',
'DATA' => 'color:#000000;',
'LineNumber' => 'color:#CCCCCC;'
);
sub handler {
my $r = shift;
my $str; # buffered output
my $mtime;
my $have_to_cache = 0;
return (MP2 ? Apache::DECLINED : Apache::Constants::DECLINED) if $r->args =~ /download/i;
my $sln = ($r->dir_config('HighlightShowLineNumbers') =~ /^on$/i || $r->args =~ /ShowLineNumbers/i) ? 1 : 0;
my $key = $r->filename . $sln;
my $debug = $r->dir_config('HighlightDebug') eq 'On' ? 1 : 0;
# Cache feature
if ( $can_cache && $r->dir_config('HighlightCache') =~ /^on$/i ) {
$mtime = (stat $r->filename)[9];
# File needs to be processed
if ( ! defined $stat{$key} || $mtime > $stat{$key} ) {
$stat{$key} = $mtime;
$have_to_cache = 1;
print STDERR "[$$] We have to cache!\n" if $debug;
}
# We have already in cache
else {
$str = get_cache( file => $key, dir => $r->dir_config('HighlightCacheDir') || '/tmp', debug => $debug );
}
use Data::Dumper;
print STDERR ("[$$] " . $r->filename . "\n" . Dumper(\%stat)) if $debug;
}
# When we must highlight?
if ( $have_to_cache || ! $str ) {
print STDERR "[$$] Generating highlight...\n" if $debug;
my $formatter = new Syntax::Highlight::Perl;
# Open file to highlight
my $fh = new IO::File($r->filename);
# Escapes HTML
$formatter->define_substitution('<' => '<', '>' => '>', '&' => '&');
# Install the formats
if ( $r->dir_config('HighlightCSS') ) {
foreach (keys %default_styles) {
$formatter->set_format($_, [ "<span class=\"$_\">",'</span>' ] );
}
$str = '<LINK HREF="' . $r->dir_config('HighlightCSS') . '" REL="stylesheet" TYPE="text/css"><PRE>';
}
else {
while ( my($type,$style) = each %default_styles ) {
$formatter->set_format($type, [ "<span style=\"$style\">",'</span>' ] );
$str = '<PRE style="font-size:10pt;color:#333366;">';
}
}
my @lines = $formatter->format_string(<$fh>);
undef $fh;
# Adds line numbers
if ( $sln ) {
my $line_number = 1;
my $max_space = length($formatter->line_count) + 1;
@lines = map { ' ' x ($max_space - length($line_number)) . '<span class="LineNumber">' . $line_number++ . '</span> ' . $_ } @lines;
}
$str .= join('',@lines) . '</PRE>';
}
if ( $have_to_cache ) {
put_cache( file => $key, content => $str, dir => $r->dir_config('HighlightCacheDir') || '/tmp', debug => $debug );
}
# Output code to client
$r->content_type('text/html');
MP2 ? 1 : $r->send_http_header;
$r->print($str);
return MP2 ? Apache::OK : Apache::Constants::OK;
}
sub get_cache {
my %args = @_;
$args{'key'} ||= Digest::MD5->md5_hex($args{'file'});
return undef if ! $args{'file'};
print STDERR "[$$] Opening file: $args{'dir'}/$args{'key'}\n" if $args{'debug'};
my $fh = new IO::File("$args{'dir'}/$args{'key'}");
my $slurp = do { local $/; <$fh> };
return $slurp;
}
sub put_cache {
my %args = @_;
return 0 if ( $args{'dir'} !~ /^\/tmp/ );
$args{'key'} ||= Digest::MD5->md5_hex($args{'file'});
return 0 if ( ! $args{'key'} || ! $args{'content'} );
print STDERR "[$$] Writing file: $args{'dir'}/$args{'key'}\n" if $args{'debug'};
my $fh;
if ( open($fh,">$args{'dir'}/$args{'key'}") ) {
flock($fh,2) if $^O !~ /win32/i;
print $fh $args{'content'};
flock($fh,8) if $^O !~ /win32/i;
close($fh);
return 1;
}
return 0;
}
1;
__END__
=pod
=head1 NAME
Apache::Syntax::Highlight::Perl - mod_perl 1.0/2.0 extension to
lib/Apache/Syntax/Highlight/Perl.pm view on Meta::CPAN
PerlModule Apache::Syntax::Highlight::Perl
Of course, notice that if you use mod_perl 2.0, there is no need to pre-load
the L<Apache::compat|Apache::compat> compatibility layer.
=head1 INSTALLATION
In order to install and use this package you will need Perl version 5.005 or
better.
Prerequisites:
=over 4
=item * mod_perl 1 or 2 (of course)
=item * Syntax::Highlight::Perl >= 1.00
=back
Installation as usual:
% perl Makefile.PL
% make
% make test
% su
Password: *******
% make install
=head1 CONFIGURATION
In order to enable Perl file syntax highlighting you could modify I<httpd.conf>
or I<.htaccess> files.
=head1 DIRECTIVES
You can control the behaviour of this module by configuring the following
variables with C<PerlSetVar> directive in the I<httpd.conf> (or I<.htaccess>
files)
=over 4
=item C<HighlightCSS> string
This single directive sets the URL (or URI) of the custom CCS file.
PerlSetVar HighlightCSS /highlight/perl.css
It can be placed in server config, <VirtualHost>, <Directory>, <Location>,
<Files> and F<.htaccess> context.
The CSS file is used to define styles for all the syntactical elements that
L<Syntax::Highlight::Perl|Syntax::Highlight::Perl> currently recognizes.
For each style there is a correspondant syntactical element. The elements are:
=over 4
=item Comment_Normal
Default is C<{color:#006699;font-style:italic;}>
=item Comment_POD
Default is C<{color:#001144;font-family:garamond,serif;font-size:11pt;font-style:italic;}>
=item Directive
Default is C<{color:#339999;font-style:italic;}>
=item Label
Default is C<{color:#993399;font-style:italic;}>
=item Quote
Default is C<{color:#0000aa;}>
=item String
Default is C<{color:#0000aa;}>
=item Subroutine
Default is C<{color:#998800;}>
=item Variable_Scalar
Default is C<{color:#008800;}>
=item Variable_Array
Default is C<{color:#ff7700;}>
=item Variable_Hash
Default is C<{color:#8800ff;}>
=item Variable_Typeglob
Default is C<{color:#ff0033;}>
=item Whitespace
Not yet used
=item Character
Default is C<{color:#880000;}>
=item Keyword
Default is C<{color:#000000; font-weight:bold;}>
=item Builtin_Function
Default is C<{color:#000000; font-weight:bold;}>
=item Builtin_Operator
Default is C<{color:#000000; font-weight:bold;}>
=item Operator
Default is C<{color:#000000;}>
=item Bareword
Default is C<{color:#33AA33;}>
=item Package
Default is C<{color:#990000;}>
=item Number
Default is C<{color:#ff00ff;}>
=item Symbol
Default is C<{color:#000000;}>
=item CodeTerm
Default is C<{color:#AA0000;}>
=item DATA
Default is C<{color:#CCCCCC;}>
=item LineNumber
This style hasn't a correspondant syntactical element but is used to display
line numbers to the right of the code. Default is C<{color:#CCCCCC;}>
=back
See C<FORMAT TYPES> section of
L<Syntax::Highlight::Perl|Syntax::Highlight::Perl> POD for more informations
about elements currently recognized.
=item C<HighlightShowLineNumbers> On|Off
This single directive displays line numbers to the right of the text
PerlSetVar HighlightShowLineNumbers On
It can be placed in server config, <VirtualHost>, <Directory>, <Location>,
<Files> and F<.htaccess> context. The default value is C<Off>.
=item C<HighlightCache> On|Off
This directive enables a very simple cache layer of already and unchanged
highlighted files:
PerlSetVar HighlightCache On
Default is C<Off>.
=item C<HighlightCacheDir> string
( run in 1.656 second using v1.01-cache-2.11-cpan-ceb78f64989 )