package Apache::VimColor; use strict; use warnings; use vars (qw($VERSION)); use Apache::Const (qw(:common)); use Apache::RequestRec; use Apache::RequestIO; use Apache::RequestUtil; use Apache::Response; use Apache::Log; use Apache::Server; use File::Basename (qw(basename)); use Text::VimColor; $VERSION = '2.31'; =head1 NAME B - Apache mod_perl Handler for syntax highlighting in HTML. =head1 DESCRIPTION This apache handler converts text files in syntax highlighted HTML output using L. If allowed by the configuration the visitor can also download the text-file without syntax highlighting. Since Text::VimColor isn't the fastest module this version can use L to cache the parsed files. Also the I and I HTTP headers are set to help browsers and proxy servers to cache the URL. =head1 SYNOPSIS This module requires B (see L) and B. The apache configuration neccessary might look a bit like this: # in httpd.conf (or any other apache configuration file) SetHandler perl-script PerlHandler Apache::VimColor # Below here is optional PerlSetVar AllowDownload "True" PerlSetVar CacheType "File" PerlSetVar CacheSize 1048576 # 1 MByte PerlSetVar CacheExpire 7200 # 2 hours PerlSetVar StyleSheet "http://domain.com/stylesheet.css" PerlSetVar TabSize 8 PerlSetVar LineNumbers "True" For a complete list of all options and descriptions see L. =cut our $Position = 0; our $Cache = {}; return (1); sub escape_html ($) { $_ = shift; s/\&/&/g; s//>/g; s/"/"/g; s#\n#
\n#sg; s/( +)/' ' x length ($1)/ge; return ($_); } sub escape_tabs ($$) { my $value = shift; my $tabstop = shift; my $retval = ''; $value =~ s/\r//g; while ($value =~ s/^([^\n\t]*)([\n\t])//s) { $retval .= $1; $Position += length ($1); if ($2 eq "\n") { $retval .= "\n"; $Position = 0; } else { my $num = $tabstop - ($Position % $tabstop); $retval .= ' 'x$num; $Position += $num; } } $retval .= $value; $Position += length ($value); return ($retval); } =head1 CONFIGURATION DIRECTIVES All features of the this PerlHandler can be set in the apache configuration using the I directive. For example: PerlSetVar AllowDownload true # inside , , ... # apache directives =over 4 =cut sub get_config ($) { my $req = shift; my $options = { allow_dl => 0, cssfile => '', tabstop => 8 }; =item AllowDownload Setting this option to B will allow plaintext downloads of the files. A link will be included in the output. The default is not to allow downloads. =cut if ($req->dir_config ('AllowDownload')) { my $conf = lc ($req->dir_config ('AllowDownload')); if (($conf eq 'on') or ($conf eq 'true') or ($conf eq 'yes')) { $options->{'allow_dl'} = 1; } } =item CacheType Selects the caching method to use. Depending on your choices a L module will be loaded and used. The default is not to use any caching. I can be one of: Memory SharedMemory File Although the default is not to use caching, if I is given and I is not, then B is being used. Obviously these values correspond to the B modules. The modules are loaded at runtime. If errors occur they are logged to Apache's errorlog. =item CacheSize Sets the maximum size of the cache in bytes. If I is non-zero the B variants will be used. =item CacheExpire I sets the expiration time. The value must be given in seconds. Defaults to 3600 seconds (one hour). See L for details. =cut if ($req->dir_config ('CacheType') or $req->dir_config ('CacheSize')) { my $cid = $req->server ()->server_hostname () . ':' . $req->location (); my $cache; if (defined ($Cache->{$cid})) { $cache = $Cache->{$cid}; } else { my $type = 'File'; my $size = 0; my $expr = 3600; my $cmd; if ($req->dir_config ('CacheType')) { my $tmp = lc ($req->dir_config ('CacheType')); if ($tmp =~ m/((?:shared)?memory|file)/) { if ($1 eq 'sharedmemory') { $type = 'SharedMemory'; } elsif ($1 eq 'memory') { $type = 'Memory'; } } else { $req->warn (qq(CacheType "$tmp" is not valid. Will use "File".)); } } if ($req->dir_config ('CacheSize')) { my $tmp = $req->dir_config ('CacheSize'); $tmp =~ s/\D//g; $size = $tmp if ($tmp); } if ($req->dir_config ('CacheExpire')) { my $tmp = $req->dir_config ('CacheExpire'); $tmp =~ s/\D//g; $expr = $tmp if ($tmp); } if ($size) { $type = "SizeAware$type"; } $type .= 'Cache'; $cmd = "require Cache::$type; \$cache = Cache::$type->new ({ namespace => 'Apache::VimColor', default_expires_in => $expr"; if ($size) { $cmd .= ", max_size => $size"; } $cmd .= ' });'; eval ($cmd); if ($@) { $req->log ()->error (qq(Loading Cache::$type filed: $@")); $cache = undef; # just to make sure ;) } $Cache->{$cid} = $cache if (defined ($cache)); } $options->{'cache'} = $cache; } =item TabStop Sets the width of one tab symbol. The default is eight spaces. =cut if ($req->dir_config ('TabStop')) { my $tmp = $req->dir_config ('TabStop'); $tmp =~ s/\D//g; $options->{'tabstop'} = $tmp if ($tmp); } =item StyleSheet If you want to include a custom stylesheet you can set this option. The string will be included in the html-output as-is, you will have to take care of relative filenames yourself. All highlighted text is withing a C-tag with one of the following classes: Comment Constant Error Identifier PreProc Special Statement Todo Type Underlined =cut if ($req->dir_config ('StyleSheet')) { $options->{'cssfile'} = $req->dir_config ('StyleSheet'); } return ($options); } sub handler { my $req = shift; my $filename = $req->filename (); my $filename_without_path = basename ($filename); my $options = get_config ($req); my $download = 0; my $mtime; my $vim; my $cache_entry; my $elems; my $output = ''; if (!-e $filename or -z $filename) { return (NOT_FOUND); } if (!-r $filename) { return (FORBIDDEN); } $mtime = (stat ($filename))[9] or return (SERVER_ERROR); if ($req->args ()) { my %args = $req->args (); if (exists ($args{'download'}) and ($options->{'allow_dl'})) { $download = 1; } } # Set up header $req->content_type ($download ? 'text/perl-script' : 'text/html'); $req->set_last_modified ($mtime); $req->set_etag (); if ($req->header_only ()) { return (OK); } # User wished to download. This is already checked against the # `AllowDownload' option. if ($download) { return ($req->sendfile ($filename)); } $req->print (< $filename_without_path HEADER $req->print ($options->{'cssfile'} ? qq(\t\t\n) : < HEADER $req->print (< HEADER $req->print (qq(\t\t

Source of $filename_without_path) . ($options->{'allow_dl'} ? ' (download)' : '') . "

\n"); $req->print (qq(\t\t
\n)); if (defined ($options->{'cache'})) { $cache_entry = $options->{'cache'}->get ($filename); if (defined ($cache_entry)) { if ($cache_entry->[0] != $mtime) { $cache_entry->[0] = $mtime; $cache_entry->[1] = []; } $elems = $cache_entry->[1]; } else { $cache_entry = [$mtime, []]; $elems = $cache_entry->[1]; } } else { $elems = []; } # $elems may have been loaded from the cache if (scalar (@$elems) == 0) { my $tmp; # This is slow, therefore the caching. $vim = new Text::VimColor (file => $filename); $tmp = $vim->marked (); # For loop to prevent aliasing. for (my $i = 0; $i < scalar (@$tmp); $i++) { push (@$elems, [$tmp->[$i][0], $tmp->[$i][1]]); } if (defined ($options->{'cache'})) { $options->{'cache'}->set ($filename, $cache_entry); } } # For loop to prevent aliasing. for (my $i = 0; $i < scalar (@$elems); $i++) { my $type = $elems->[$i][0]; my $value = $elems->[$i][1]; $value = escape_tabs ($value, $options->{'tabstop'}); $value = escape_html ($value); if ($type) { $output .= qq($value); } else { $output .= $value; } } =item LineNumbers Sets wether or not line numbers will be displayed. The Default is not to display line numbers. =back =cut if ($req->dir_config ('LineNumbers') and ($req->dir_config ('LineNumbers') =~ m/^(yes|on|true)$/i)) { my $linenumber = 1; $output =~ s#^#sprintf (q(%7u ), $linenumber++)#gem; } $req->print ($output); $req->print ("\t\t
\n"); $req->print (< Generated with Apache::VimColor $VERSION by Florian octo Forster FOOTER return (OK); } =head1 SEE ALSO L, L, L, L, L =head1 AUTHOR Florian octo Forster octo(at)verplant.org http://verplant.org/ =head1 COPYRIGHT Copyright (c) 2005 Florian Forster. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut