package exception_handler;

use Exporter;
use File::Spec;
use File::Basename;
use CGI::Util qw/escape unescape/;
use base qw(Exporter);
use vars qw($VERSION @EXPORT);
no warnings;
use strict;

our $VERSION = '0.01';
our @EXPORT  = qw(die warn);

BEGIN {
	$SIG{__DIE__} = \&die;
	my $error_fd = $ENV{"TM_ERROR_FD"};
	open (TM_ERROR_FD, ">&=$error_fd");
}

END {
	print TM_ERROR_FD "</div>";
	close (TM_ERROR_FD);
}

sub id {
	my $level = 0;
	my @c;
	# check which line emitted the error/warn depending on 'eval'
	while(@c = caller($level)) {$level++}
	$level -= (!$^S) ? 1 : 2;
	my ($pack, $file, $line) = caller($level);
	my ($dev, $dirs, $id) = File::Spec->splitpath($file);
	return ($file, $line);
}

sub quote {
	my $str = shift;
	$str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
	return $str;
}

sub check_filename {
	my $file = shift;
	my $url = "";
	my $display_name = "";
	if ($file ne "-") {
		$display_name = basename($file);
		$url = 'url=file://' . quote($file) . '&amp;';
	} else {
		$url = "";
		$display_name = 'untitled';
	}
	return ($url, $display_name);
}

sub print_message {
	my ($message, $url, $line, $display_name) = @_;
	print TM_ERROR_FD "<div id='exception_report' class='framed'>\n";
	print TM_ERROR_FD "<p id='exception'>" . htmlize($message) . "</p>\n";
	print TM_ERROR_FD "<blockquote><table border='0' cellspacing='0' cellpadding='0'>\n";
	print TM_ERROR_FD '<tr><td>in <a href="txmt://open?' . $url . '&line=' . $line . '"> ' . $display_name . "</a> at line $line<td></tr>\n" ;
	print TM_ERROR_FD "</table></blockquote></div>";
}

sub htmlize {
	my $l = shift;
	$l =~ s/&/&amp;/g;
	$l =~ s/</&lt;/g;
	$l =~ s/>/&gt;/g;
	return $l;
}

sub warn {
	my $message = join('', @_);
	chomp($message);
	my ($file, $line) = id();
	my ($url, $display_name) = check_filename($file);
	print_message($message, $url, $line, $display_name);
}

sub die {
	my $message = join('', @_);
	chomp($message);
	my ($file, $line) = id();
	my ($url, $display_name) = check_filename($file);
	print_message($message, $url, $line, $display_name);
	exit($!) if (!$^S);
}