Apache-PrettyPerl

 view release on metacpan or  search on metacpan

PrettyPerl.pm  view on Meta::CPAN

# You can set colors here. Use HTML color names or codes
# (like #ff0000 being red).
our %Colors =
(
	foreground	=> 'silver',
	background	=> 'black',
	links		=> 'white',
	
	comment	=> 'navy',
	escaped	=> 'purple',
	keyword	=> 'yellow',
	number	=> 'red',
	pod	=> 'navy',
	regex	=> 'red',
	string	=> 'red',
	variable=> 'aqua'
);

our @KeyWords =
qw(

PrettyPerl.pm  view on Meta::CPAN

span.error
{
	color: red;
	background-color: yellow;
}
EOF

	my %defaults =
	(
		escaped	=> 'purple',
		keyword	=> 'yellow',
		number	=> 'red',
		pod	=> 'navy',
		regex	=> 'red',
		string	=> 'red',
		variable=> 'aqua'
	);

	for (sort (keys (%defaults)))
	{

PrettyPerl.pm  view on Meta::CPAN

sub get_dl_link
{
	my $req = shift;
	my $uri = $req->uri ();
	my $file = basename ($uri);

	my $retval = qq#\n<p><a href="$uri?download">Download <code>$file</code></a></p>\n#;
	return ($retval);
}

sub html_escape
{
	$_ = shift;

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

	s/  +/'&nbsp;' x length ($&)/ge;
	s/\t/'&nbsp;' x $Tabsize/ge;

PrettyPerl.pm  view on Meta::CPAN

	return ($_);
}
	

sub string2html
{
	my $string = shift;
	my $retval = '';

	$string = html_escape ($string);

	if ($string =~ m/^("|<<[^']|qq.)/)
	{
		$retval = $&;
		$string = $';

		while ($string =~ m/\\(?:[^&]|&[a-z]+;)|[\@\%\&]?\$*\$(?:&[a-z]+;|[^A-Za-z:]|(?:::)?[A-Za-z](?:\w|::)*)/)
		{
			my $match = $&;
			$retval .= $`;
			$string = $';

			if ($match =~ m/^[\$\@\%\&]/)
			{
				$retval .= qq#<span class="variable">$match</span>#;
			}
			else
			{
				$retval .= qq#<span class="escaped">$match</span>#;
			}
		}
		
		$retval .= $string;
		$retval = qq#<span class="string">$retval</span>#;
	}
	elsif ($string =~ m/^('|&lt;&lt;'|q[^qxr])/)
	{
		$retval = $string;
		$retval =~ s#\\[\\']#<span class="escaped">$&</span>#g;
		$retval = qq#<span class="string">$retval</span>#;
	}
	elsif ($string =~ m/^#/)
	{
		$retval = qq#<span class="comment">$string</span>#;
	}
	elsif ($string =~ m/^=/)
	{
		$retval = qq#<span class="pod">$string</span>#;
	}

PrettyPerl.pm  view on Meta::CPAN

	{
		$retval = qq#<span class="string">$string</span>#;
	}
	
	return ($retval);
}

sub regex2html
{
	$_ = shift;
	$_ = html_escape ($_);

	s#
		\((?:\?(?:[=!:]|&lt;[=!]|&gt;))?
	|	\[\^?
	|	\\(?:\&\w+;|.)
	|	[\*\+\?\)\]\|]
	#<span class="escaped">$&</span>#gx;

	$_ = qq#<span class="regex">$_</span>#;
	
	return ($_);
}

sub perl2html
{
	my $yet_to_process = join ("\n", @_);
	my $processed = '';

PrettyPerl.pm  view on Meta::CPAN

		}
		else
		{
			$processed .= qq#$alrm!ERROR!$alrm$BufferFill$alrm#;

			$Buffer[$BufferFill] = qq#$match#;
			$BufferFill++;
		}
	}

	$_ = html_escape ($processed . $yet_to_process);

	my $re;
	{
		my $temp = '';
		$temp = join ('|', map { quotemeta ($_) } (@KeyWords));

		$re = qr#$temp#;
	}

	s#\b($re)\b#<span class="keyword">$1</span>#g;
	
	s#$alrm!STRING!$alrm(\d+)$alrm#string2html ($Buffer[$1])#ge;
	s#$alrm!REGEX!$alrm(\d+)$alrm#regex2html ($Buffer[$1])#ge;
	s#$alrm!(\w+)!$alrm(\d+)$alrm#"<span class=\"\L$1\E\">" . html_escape ($Buffer[$2]) . '</span>'#ge;

	return (qq#\n<div class="source">\n$_</div>\n#);
}

__END__

=head1 NAME

B<Apache::PrettyPerl> - Apache mod_perl PerlHandler for nicer output perl files in the client's browser.