I have made a user script for Greasemonkey in Firefox. This userscript in turn passes data to a perl script on the net to highlight and/or tidy up perl code in code blocks, here on PerlMonks. If you have Greasemonkey installed, click the following link and tell it to install to try it out. PMTidy.user.js
I recently stumbled upon an AJAX syntax highlighter for perl that uses a perl script. The script uses Perl::Tidy to recolor perl code. I thought this was neat and wanted to see if I could make it work here.
I started with Jon Allen's scripts until after a few days I have this! The script creates links next to download beneath the code that let you highlight or tidy up the code. There are some kinks/bugs, though:
- When you click a link, you scroll up to the top of the code block. It's a bit jerky but otherwise you could end up looking anywhere nearby.
- Since the links go to an anchor created around the code, it creates another entry in your history (you have to click Back more times).
- Perl::Tidy craps out on the crazier obfuscations, and won't display the highlight or tidy links.
- Word wrapping does not work perfectly, long strings are not wrapped. This I can probably fix later.
You can't tidy code blocks in readmore tags because the markup is different and I didn't anticipate this. (update: guess I was wrong)
- The userscript inserts a pre block around the code because I couldn't get indentation working properly with  
I also transfered my domain name to a new host today so you might get the old IP number once and awhile. Hopefully that won't last long.
There are two configuration options you can change by editing the Greasemonkey script. When you Manage Users Scripts there is an Edit button to open your editor. One is the url of the perl script to call and the other is a wordwrap setting (that works poorly).
I also found a node via Super Search that talks about syntax highlighting and has alternatives. I was already halfway done with this when I found it though.
The perl script the Greasemonkey script calls to tidy up is on my web hosting account and the source code is the following:
#!/usr/local/bin/perl -w
use strict;
use warnings;
use CGI qw/:standard/;
use Perl::Tidy;
use HTML::Entities;
use XML::Simple;
our $VERSION = '0.01';
use constant {
UNPERLMSG => 'How very unperlish of you!',
# ERRLOGFILE => 'pmtidyerr.log',
};
my $cgi = new CGI;
my $code = $cgi->param('code');
my $wordwrap = $cgi->param('wordwrap');
eval {
die 'No code given' unless(defined $code);
$wordwrap = 80 unless(defined $wordwrap);
$code =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # from URI::Encode
decode_entities($code);
$code =~ s/\xA0/ /g; # wtf!  =this+spac
+e?
# Removes rampant <br> tags
$code =~ s|<br(?:\s+/)?>||g;
# put the perltidy.ERR file in /tmp
chdir('/tmp') or die "could not chdir to /tmp: $!";
# We return two versions, both are converted to html and colorized
# But one is also tidied up (reformatted) first.
my $errors;
my $tidied;
# The stderr option to perltidy does not seem to do anything!.
# So we force it muahaha! Take that!
open my $tmpstderr, '>', \$errors or die "open for temp STDERR: $!";
my $oldstderr = *STDERR;
*STDERR = $tmpstderr;
perltidy( source => \$code, destination => \$tidied );
*STDERR = $oldstderr;
close $tmpstderr;
if( $errors ) {
print $cgi->header;
print UNPERLMSG;
exit 0;
}
# I'm thinking errors won't happen with perltidy below if they
# did not above...
# BUG: wordwrap option doesn't work for long string, need to manuall
+y
# fix that
my $tidyargs = "-html -pre -l=$wordwrap";
my $result;
perltidy( source => \$code,
destination => \$result,
argv => $tidyargs );
$code = $result;
perltidy( source => \$tidied,
destination => \$result,
argv => $tidyargs );
$tidied = $result;
# Removes the anchors that are created since we wont use them.
$code =~ s|</?a.*?>||g;
# Remove the <pre> tags and use <br>'s again like perlmonks does (*b
+arf*)
# BUG: I can't get this to indent at beginning of line properly.
# So I'm just leaving the pre tags, so much easier!
# $code =~ s|</?pre>\n||mg;
# $tidied =~ s|</?pre>\n||mg;
# $code =~ s|\n|<br />\n|mg;
# $tidied =~ s|\n|<br />\n|mg;
# $code =~ s|^( +)|length($1)x' '|gem;
# $tidied =~ s|^( +)|length($1)x' '|gem;
my $html = join "\n", ("<div>",
"<div id=\"highlight\">", $code, "</div>",
"<div id=\"tidy\">", $tidied, "</div>",
"</div>");
print $cgi->header;
print $html;
};
if($@) {
# open my $errlog, '>>', ERRLOGFILE;
# print $errlog "$@";
# close $errlog;
print $cgi->header(-status => 500);
#die "$0: $@";
}
exit 0;