#!/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+space?
# Removes rampant
tags
$code =~ 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 manually
# 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
tags and use
's again like perlmonks does (*barf*) # 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|
\n|mg; # $tidied =~ s|\n|
\n|mg; # $code =~ s|^( +)|length($1)x' '|gem; # $tidied =~ s|^( +)|length($1)x' '|gem; my $html = join "\n", ("", ""); print $cgi->header; print $html; }; if($@) { # open my $errlog, '>>', ERRLOGFILE; # print $errlog "$@"; # close $errlog; print $cgi->header(-status => 500); #die "$0: $@"; } exit 0;", $code, "", "", $tidied, "", "