Apache::Syntax::Highlight::Perl - mod_perl 1.0/2.0 extension to

Apache-Syntax-Highlight-Perl documentation Contained in the Apache-Syntax-Highlight-Perl distribution.

Index

Code Index:

NAME

Top

Apache::Syntax::Highlight::Perl - mod_perl 1.0/2.0 extension to highlight Perl code

SYNOPSIS

Top

In httpd.conf (mod_perl 1):

   PerlModule Apache::Syntax::Highlight::Perl

   <FilesMatch "\.((p|P)(l|L|m|M)|t)$">
      SetHandler perl-script
      PerlHandler Apache::Syntax::Highlight::Perl
      PerlSetVar HighlightShowLineNumbers On
      PerlSetVar HighlightCSS http://path.to/highlight.css
   </FilesMatch>

In httpd.conf (mod_perl 2):

   PerlModule Apache2
   PerlModule Apache::Syntax::Highlight::Perl

   <FilesMatch "\.((p|P)(l|L|m|M)|t)$">
      SetHandler perl-script
      PerlResponseHandler Apache::Syntax::Highlight::Perl
      PerlSetVar HighlightShowLineNumbers On
      PerlSetVar HighlightCSS http://path.to/highlight.css
   </FilesMatch>

DESCRIPTION

Top

Apache::Syntax::Highlight::Perl is a mod_perl (1.0 and 2.0) module that provides syntax highlighting for Perl code. This module is a wrapper around Syntax::Highlight::Perl.

MOD_PERL 2 COMPATIBILITY

Top

Apache::Syntax::Highlight::Perl is fully compatible with both mod_perl generations 1.0 and 2.0.

If you have mod_perl 1.0 and 2.0 installed on the same system and the two uses the same per libraries directory, to use mod_perl 2.0 version make sure to load first Apache2 module which will perform the necessary adjustements to @INC:

   PerlModule Apache2
   PerlModule Apache::Syntax::Highlight::Perl

Of course, notice that if you use mod_perl 2.0, there is no need to pre-load the Apache::compat (Apache::compat) compatibility layer.

INSTALLATION

Top

In order to install and use this package you will need Perl version 5.005 or better.

Prerequisites:

* mod_perl 1 or 2 (of course)
* Syntax::Highlight::Perl >= 1.00

Installation as usual:

   % perl Makefile.PL
   % make
   % make test
   % su
     Password: *******
   % make install

CONFIGURATION

Top

In order to enable Perl file syntax highlighting you could modify httpd.conf or .htaccess files.

DIRECTIVES

Top

You can control the behaviour of this module by configuring the following variables with PerlSetVar directive in the httpd.conf (or .htaccess files)

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 .htaccess context.

The CSS file is used to define styles for all the syntactical elements that Syntax::Highlight::Perl currently recognizes.

For each style there is a correspondant syntactical element. The elements are:

Comment_Normal

Default is {color:#006699;font-style:italic;}

Comment_POD

Default is {color:#001144;font-family:garamond,serif;font-size:11pt;font-style:italic;}

Directive

Default is {color:#339999;font-style:italic;}

Label

Default is {color:#993399;font-style:italic;}

Quote

Default is {color:#0000aa;}

String

Default is {color:#0000aa;}

Subroutine

Default is {color:#998800;}

Variable_Scalar

Default is {color:#008800;}

Variable_Array

Default is {color:#ff7700;}

Variable_Hash

Default is {color:#8800ff;}

Variable_Typeglob

Default is {color:#ff0033;}

Whitespace

Not yet used

Character

Default is {color:#880000;}

Keyword

Default is {color:#000000; font-weight:bold;}

Builtin_Function

Default is {color:#000000; font-weight:bold;}

Builtin_Operator

Default is {color:#000000; font-weight:bold;}

Operator

Default is {color:#000000;}

Bareword

Default is {color:#33AA33;}

Package

Default is {color:#990000;}

Number

Default is {color:#ff00ff;}

Symbol

Default is {color:#000000;}

CodeTerm

Default is {color:#AA0000;}

DATA

Default is {color:#CCCCCC;}

LineNumber

This style hasn't a correspondant syntactical element but is used to display line numbers to the right of the code. Default is {color:#CCCCCC;}

See FORMAT TYPES section of Syntax::Highlight::Perl POD for more informations about elements currently recognized.

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 .htaccess context. The default value is Off.

HighlightCache On|Off

This directive enables a very simple cache layer of already and unchanged highlighted files:

   PerlSetVar HighlightCache On

Default is Off.

HighlightCacheDir string

This directive sets cache directory 

   PerlSetVar HighlightCacheDir /tmp/highlight

Default is /tmp.

RUN TIME CONFIGURATION

Top

In addition, you can control the module behaviour at run time by adding some values via the query string. In particular:

download

Forces the module to exit with DECLINED status, for example by allowing users to download the file (according to Apache configuration):

   http://myhost.com/myproject/sample.pl?download
showlinenumbers

Forces showing of code line numbers. For example:

   http://myhost.com/myproject/sample.pl?showlinenumbers

BUGS

Top

Please submit bugs to CPAN RT system at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Apache%3A%3ASyntax%3A%3AHighlight%3A%3APerl or by email at bug-apache-syntax-highlight-perl@rt.cpan.org

Patches are welcome and I'll update the module if any problems will be found.

VERSION

Top

Version 1.01

TODO

Top

SEE ALSO

Top



Syntax::Highlight::Perl, Apache (Apache), IO::FIle, perl

AUTHOR

Top



Enrico Sorcinelli, <enrico@sorcinelli.it>

COPYRIGHT AND LICENSE

Top



Copyright (C) 2004 by Enrico Sorcinelli

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.2 or, at your option, any later version of Perl 5 you may have available.
Apache-Syntax-Highlight-Perl documentation Contained in the Apache-Syntax-Highlight-Perl distribution. 
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('<' => '&lt;', '>' => '&gt;', '&' => '&amp;'); 

		# 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 { '&nbsp;' x ($max_space - length($line_number)) . '<span class="LineNumber">' . $line_number++ . '</span>&nbsp;' . $_ } @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__