#!/usr/bin/perl use CGI; use Syntax::Highlight::Perl; use warnings; use strict; # put your sources directory here my $SOURCES_DIR = '../sources/'; my $color_table = { 'Variable_Scalar' => 'color:#008800;', 'Variable_Array' => 'color:#ff7700;', 'Variable_Hash' => 'color:#8800ff;', 'Variable_Typeglob' => 'color:#ff0033;', 'Subroutine' => 'color:#998800;', 'Quote' => 'color:#0000aa;', 'String' => 'color:#0000aa;', 'Comment_Normal' => 'color:#006699;font-style:italic;', 'Comment_POD' => 'color:#001144;font-family:garamond,serif;font-size:11pt;', 'Bareword' => 'color:#33AA33;', 'Package' => 'color:#990000;', 'Number' => 'color:#ff00ff;', 'Operator' => 'color:#000000;', 'Symbol' => 'color:#000000;', 'Keyword' => 'color:#000000;', 'Builtin_Operator' => 'color:#330000;', 'Builtin_Function' => 'color:#000011;', 'Character' => 'color:#880000;', 'Directive' => 'color:#339999;font-style:italic;', 'Label' => 'color:#993399;font-style:italic;', 'Line' => 'color:#000000;', }; my $content = ""; sub pdie{ my $msg = shift; print $msg; die; } print "Content-type: text/html\n\n"; print <<EOF; <HTML><HEAD><TITLE>Perl sources viewer</TITLE></HEAD> <BODY> EOF # load source file here my $query = new CGI; my $file = $query->param('file'); # if filename is not specified, then show file list if (!$file){ opendir(DIR, $SOURCES_DIR) || pdie "Can't open sources directory: $!"; my @files = readdir(DIR); closedir DIR; print qq|<h2>Perl sources list</h2><br>|; for (@files){ # show only .pl and .pm files print qq|<a href="/cgi-bin/perlcode.pl?file=$_">$_</a><br>| if /\.(pm|pl)$/; } exit; } # clean file name (am I too restrictive? ;)) $file =~ s/(\.\.|[^a-zA-z0-9.])//g; my $f1 = open (IN,"<$SOURCES_DIR/$file") || pdie ("Could not open file: $!\n\n"); while (<IN>){ $content .= $_; } close IN; # create a new formatter my $formatter = Syntax::Highlight::Perl->new(); # define basic HTML escapes substitutions for the formatter $formatter->define_substitution('<' => '<', '>' => '>', '&' => '&'); # install the formats set up above while ( my ( $type, $style ) = each %{$color_table}) { $formatter->set_format($type, [ qq|<span style=\"$style\">|, '</span>' ] ); } print '<PRE style="font-size:14pt;color:#333366;">'; print $formatter->format_string($content); print "</PRE>"; exit 0;