transparent results from the CPAN

Apache-PrettyPerl
view release on metacpan or search on metacpan
	}

	$req->set_last_modified ($mtime);
	$req->set_etag ();

	if ($req->header_only ())
	{
		return (OK);
	}

	$data = $req->slurp_filename ();

	if ($dl)
	{
		$req->print ($$data);
	}
	else
	{
		$req->print (get_head ($req));

		if ($dl_ok)
		{
			$req->print (get_dl_link ($req));
		}
		$req->print (perl2html ($$data));
		$req->print (get_foot ());
	}

	return (OK);
}

sub get_head
{
	my $req = shift;
	my $uri = $req->uri ();
	my $file = basename ($uri);
	my $temp;
	
	my $retval = <<EOF;
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
        "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>Source of $file</title>
<meta name="generator" content="Apahe::PrettyPerl" />
<style type="text/css">
<!--
EOF
	$temp = 'white';
	if (defined ($Colors{'links'}))
	{
		$temp = $Colors{'links'};
	}

	$retval .= <<EOF;
a
{
	color: $temp;
	background-color: transparent;
	text-decoration: none;
	font-weight: bold;
}

a:hover
{
	text-decoration: underline;
}

EOF

	{
		my $bg = 'black';
		my $fg = 'silver';

		if (defined ($Colors{'background'}))
		{
			$bg = $Colors{'background'};
		}
		if (defined ($Colors{'foreground'}))
		{
			$fg = $Colors{'foreground'};
		}

		$retval .= <<EOF;
body
{
	color: $fg;
	background-color: $bg;
}

div.source
{
	font-family: monospace;
	border: 1px solid gray;
	padding: 1em;
}

p.generator
{
	text-align: right;
	font-size: smaller;
}

EOF
	}

	$temp = 'navy';
	if (defined ($Colors{'comment'}))
	{
		$temp = $Colors{'comment'};
	}

	$retval .= <<EOF;
span.comment
{
	color: $temp;
	background-color: transparent;
}

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)))
	{
		$temp = $defaults{$_};

		if (defined ($Colors{$_}))
		{
			$temp = $Colors{$_};
		}

		$retval .= <<EOF;

span.$_
{
	color: $temp;
	background-color: transparent;
}
EOF
	}

	$retval .= <<EOF;
//-->
</style>
</head>
<body>
<h1>Source of <code>$file</code></h1>
EOF
	return ($retval);
}

sub get_foot
{
	my $retval = <<EOF;
<p class="generator">Generated by <a href="http://amk.lg.ua/~ra/PrettyPerl/">Apache::PrettyPerl $VERSION</a></p>

</body>
</html>
EOF
	return ($retval);
}

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;
	s#\n#<br />\n#sg;

	return ($_);
}
	

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

	$string = html_escape ($string);

	if ($string =~ m/^(&quot;|&lt;&lt;[^']|qq.)/)
( run in 1.185 second using v1.01-cache-2.11-cpan-6aa56a78535 )