#!/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! &nbsp=this+space?

  # 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 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 <pre> tags and use <br>'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|<br />\n|mg;
#   $tidied =~ s|\n|<br />\n|mg;
#   $code   =~ s|^( +)|length($1)x'&nbsp;'|gem;
#   $tidied =~ s|^( +)|length($1)x'&nbsp;'|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;