package tpplib_perl;

# hack-y little set of routines to get at useful routines in tpplib without a
# poper perl module
# (building perl modules turns out to be an ugly mess for many end users)
# uses the increasingly misnamed tpp_hostname commandline app to get at needed
# tpplib functions

use Cwd;
use File::Basename;

# Provide analogous routines for getting the configuration's file paths
# and www references that are found in contants.h, sysdepend.h, util.c.
# Note: Filesystem paths all have '/' appended to them

my $_tpp_hostname = undef;;

sub _lookup {
  my $s;
  if ( $_tpp_hostname ) {
     $s = `$_tpp_hostname $_[0] 2>&1`;
  } else {
     $_tpp_hostname = 'tpp_hostname';
     $s = `$_tpp_hostname $_[0] 2>&1`;
     if ( $? && $ENV{TPP_HOME} ) {
        $_tpp_hostname = "$ENV{TPP_HOME}/bin/tpp_hostname";
        $s = `$_tpp_hostname $_[0] 2>&1`;
     }
  }
  if ( $? ) {
     die( "Error: invoking tpp_hostname to look up installation property '$_[0]'\n" );
  }
  if ( $s =~ /^no_raw_data/ ) {
     die( "Error: can't locate TPP installation for $_[0]\n" );
  }
  return $s;
}


# All of these will throw an die() exception if they can't run tpp_hostname

my $_HomePath = undef;
sub getHomePath {       # TPP "home", full path to the installation directory
  return $_HomePath || ($_HomePath = _lookup('HomePath!'));
}

my $_TPPPort = undef;
sub getTPPPort {       # TPP "home", full path to the installation directory
  return $_TPPPort || ($_TPPPort = _lookup('TPPPort!'));
}

my $_BinPath = undef;
sub getBinPath  {       # Full path to directory for program/scripts
  return $_BinPath || ($_BinPath = _lookup('BinPath!'));
}

my $_CgiPath = undef;
sub getCgiPath  {       # Full path to directory for cgi program/scripts
  return $_CgiPath || ($_CgiPath = _lookup('CgiPath!'));
}

my $_ConfPath = undef;
sub getConfPath {       # Full path to directory for conf files
  return $_ConfPath || ($_ConfPath = _lookup('ConfPath!'));
}

my $_HtmlPath = undef;
sub getHtmlPath {       # Full path to directory for static images/js/css
  return $_HtmlPath || ($_HtmlPath = _lookup('HtmlPath!'));
}

my $_DataPath = undef;
sub getDataPath {       # Full path to directory for data
  return $_DataPath || ($_DataPath = _lookup('DataPath!'));
}

my $_LogPath = undef;
sub getLogPath {        # Full path to directory for log files
  return $_LogPath || ($_LogPath = _lookup('LogPath!'));
}

# Web URLs
my $_BaseUrl = undef;
sub getBaseUrl {        # TPP base reference for all TPP URLs (/tpp/)
  return $_BaseUrl || ($_BaseUrl = _lookup('BaseUrl!'));
}

my $_DataUrl = undef;
sub getDataUrl {        # TPP base reference for all data URLs (/tpp/data/)
  return $_DataUrl || ($_DataUrl = _lookup('DataUrl!'));
}

my $_CgiUrl = undef;
sub getCgiUrl {         # TPP URL for cgi (/tpp/cgi-bin/)
  return $_CgiUrl || ($_CgiUrl = _lookup('CgiUrl!'));
}

my $_HtmlUrl = undef;
sub getHtmlUrl {        # TPP URL for static documents (/tpp/html/)
  return $_HtmlUrl || ($_HtmlUrl = _lookup('HtmlUrl!'));
}

# Path/URL conversions

sub tppDataPath2Url {
   my $url  = $_[0];
   my $path = getDataPath();
   $url =~ s/^$path//i;
   return getDataUrl() . $url;
}

sub tppDataUrl2Path {
   my $path = $_[0];
   my $url  = getDataUrl();
   $path =~ s/^$url//i;
   return getDataPath() . $path;
}


# Miscellaneous 

sub hasValidPepXMLFilenameExt {
  my $fname=shift;
  my $ext = _lookup( "hasValidPepXMLFilenameExt! $fname" );
  return $ext;
}

sub hasValidProtXMLFilenameExt {
  my $fname=shift;
  my $ext = _lookup( "hasValidProtXMLFilenameExt! $fname" );
  return $ext;
}

sub uncompress_to_tmpfile {
  my $fname=shift;
  my $maxchar=shift;
  $maxchar = "" unless defined($maxchar);
  my $tmpfname = _lookup( "uncompress_to_tmpfile!$maxchar $fname" );
  return $tmpfname;
}

sub getGnuplotBinary {
  my $exename = _lookup( "getGnuplotBinary!" );
  return $exename;
}

sub getTPPVersionInfo {
  my $versionInfo = _lookup( "versionInfo!" );
  return $versionInfo;
}

sub get_tpp_hostname {
  my $hostname = _lookup('');
  if ("" eq $hostname) {
    $hostname="localhost";
  }
  return $hostname;
}

# taken off the web
sub read_query_string
{
    local ($buffer, @pairs, $pair, $name, $value, %FORM);
    # Read in text
    $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
    if ($ENV{'REQUEST_METHOD'} eq "POST")
    {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    } else
    {
        $buffer = $ENV{'QUERY_STRING'};
    }
    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs)
    {
        ($name, $value) = split(/=/, $pair);
        $value =~ tr/+/ /;
        $value =~ s/%(..)/pack("C", hex($1))/eg;
	if ($value =~ /;/) {
	    print "GET query string failure, found illegal character ';' ...\n";
	}
	else {
	    $FORM{$name} = $value;
	}
    }
    %FORM;
}

1; # required so that file can be correctly included in another script
   #- gives a 'true' response when loaded