escape results from the CPAN

Apache-VimColor

view release on metacpan or search on metacpan

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::VimColor> - Apache mod_perl Handler for syntax highlighting in HTML.

=head1 DESCRIPTION

This apache handler converts text files in syntax highlighted HTML output using
L<Text::VimColor|Text::VimColor>. 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<Cache::Cache|Cache::Cache> to cache the parsed files. Also the I<ETag> and
I<LastModified> HTTP headers are set to help browsers and proxy servers to
cache the URL.

=head1 SYNOPSIS

This module requires B<mod_perl2> (see L<http://perl.apache.org/>) and
B<Text::VimColor>.

The apache configuration neccessary might look a bit like this:

  # in httpd.conf (or any other apache configuration file)
  <Location /source>
    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"
  </Location>

For a complete list of all options and descriptions see L<below|/"CONFIGURATION DIRECTIVES">.

=cut

our $Position = 0;
our $Cache = {};

return (1);

sub escape_html ($)
{
	$_ = shift;

	s/\&/&amp;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
	s/"/&quot;/g;

	s#\n#<br />\n#sg;
	s/(  +)/'&nbsp;' 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<PerlSetVar> directive. For example:

    PerlSetVar	AllowDownload	true	# inside <Files>, <Location>, ...
					# 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<true> will allow plaintext downloads of the files. A
link will be included in the output. The default is not to allow downloads.

=cut

VimColor.pm view on Meta::CPAN


	<body>
HEADER
	$req->print (qq(\t\t<h1>Source of <code>$filename_without_path</code>)
	. ($options->{'allow_dl'} ? ' (<a href="' . $req->uri () . '?download">download</a>)' : '') . "</h1>\n");

	$req->print (qq(\t\t<div class="fixed">\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(<span class="$type">$value</span>);
		}
		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(<span class="linenumber">%7u </span>), $linenumber++)#gem;
	}
	$req->print ($output);

	$req->print ("\t\t</div>\n");
	$req->print (<<FOOTER);
		<div class="notice">
			Generated with <a href="http://search.cpan.org/perldoc?Apache%3A%3AVimColor">Apache::VimColor $VERSION</a>
			by <a href="http://verplant.org/">Florian octo Forster</a>
		</div>
	</body>
</html>
FOOTER

	return (OK);
}

=head1 SEE ALSO

L<perl(1)>, L<mod_perl(3)>, L<Apache(3)>, L<Text::VimColor|Text::VimColor>,
L<Cache::Cache>

=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

( run in 0.730 second using v1.01-cache-2.11-cpan-39bf76dae61 )