package CGI::Tools;
# $Id: Tools.pm,v 1.23 2001/01/03 08:20:36 tom Exp $
################################################################

=head1 NAME

CGI::Tools - CGI tools

=head1 STATIC FUNCTIONS

=cut

################################################################
    

use strict;
use Exporter;

use vars qw(@ISA @EXPORT
	    $ContentType);

@ISA = qw(Exporter);
@EXPORT = qw(Escape SetDieHandler
	     UrlEncode UrlDecode
	     PrintHTTPHeader ContentType);

my ($DieHandle, $ModPerl);

# mod_perl works?
if (exists $ENV{'GATEWAY_INTERFACE'} 
    && 
    ($ModPerl = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)){
    $| = 1;
    require Apache;
}

# default content-type
$ContentType = "text/html";

################################################################
# if works as CGI, set handler automatically
sub SetDieHandler(;$);
my $gateway_interface = $ENV{'GATEWAY_INTERFACE'} || "";
if ($gateway_interface =~ m/CGI/){
    SetDieHandler();
}
sub IsModPerl() { return $ModPerl; }

# URL-decoded data
sub UrlDecode {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;       # pluses become spaces
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    return $todecode;
}

# URL-encode data
sub UrlEncode {
    my($toencode) = @_;
    $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
    return $toencode;
}

# escape line
sub Escape($)
{
    my $str = shift;
    $str =~ s/&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/"/&quot;/g;    #"
    $str;
}
# unescape line
sub Unescape($)
{
    my $str = shift;
    $str =~ s/&lt;/</g;
    $str =~ s/&gt;/>/g;
    $str =~ s/&amp;/&/g;
    $str =~ s/&quot;/"/g; #"
    $str;
}
sub PrintHTTPHeader
{
    print ContentType() . "\r\n";
}
sub ContentType(;$)
{
    require Skelton;

    my $type = shift;
    $type ||= $ContentType;
    my $charset = Skelton::GetOutputCharset();

    return qq(content-type: $type;charset=$charset\r\n);
}
################################################################
# Error Handler
sub SetDieHandler (;$){
    my $handler = shift;

    $SIG{'__DIE__'} = $handler || \&die_handler;
}
sub SetWarnHandler(;$){
    my $handler = shift;

    $SIG{'__WARN__'} = $handler || \&warn_handler;
}

# default die handler
sub die_handler ($)
{
    my $name = shift;
    return if $name =~ /unimplemented/;

    return if $name && $name =~ /eval/;
    print "content-type: text/html\n\n";
    print "<h1>Error occured</h1>";
    print "<p>$name</p>";

    for (1..6){
	my ($class, $file, $line) = caller($_);
	last unless $class;
	print "<h2>caller info depth $_</h2>class: $class<br>file: $file<br>line: $line</p>";
    }
    exit;
}
# default warn handler
sub warn_handler ($)
{
    my $name = shift;

    #print STDERR times, " $name";
}
    
1;
################################################################
