Apache-PrettyPerl
1 match

 view release on metacpan or  search on metacpan

PrettyPerl.pm  view on Meta::CPAN 

	$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>



( run in 1.727 second using v1.01-cache-2.11-cpan-ceb78f64989 )