#!/usr/bin/perl
use strict vars;
use English;
require 'urlencoding.pm';
#---------------------------------------------------------------------------------------------------------
#--
#--  E n v i r o n m e n t
#--
#--
#--  Mit diesem Script werden Environmentvariablen angezeigt.
#--  Die Ausgabe kann WML oder HTML sein.
#--
#--
#--  env.cgi
#--
#--  20.03.2000 SK Titel geändert
#--  10.02.2000 SK Fehlerbehebung: perl-Pfad
#--  08.02.2000 SK Fertigstellung
#--  25.01.2000 SK Grobfassung
#--
#---------------------------------------------------------------------------------------------------------

#---------------------------------------------------------------------------------------------------------
my %CGI_Input = ();

#---------------------------------------------------------------------------------------------------------
# Variablen
#---------------------------------------------------------------------------------------------------------
my $scripting  	= "WML";
my $br     	= "";

##########################################################################################################
  if ($scripting eq "HTML") {
    &httpHeader();
  } else {
    &wtpHeader();
  }
  
  %CGI_Input = &ParseInput();
  
  &Input_aufbereiten(\%CGI_Input); # Adresse wird übergeben

  if ($scripting eq "HTML") {
    $br = "<br>";
  } else {
    $br = "<br/>";
  }
  
  if ($scripting eq "HTML") {
    &HTML_Start("Konfiguration");
  } else {
    &WML_Start;  
    print "<template>\n";
    print "<do type=\"prev\" label=\"Zur&#252;ck\">\n";
    print "<prev/></do>\n";
    print "</template>\n";
    print "<card id=\"card1\" title=\"Konfiguration\">\n";
  }
  
  print "<p>";
  if ($ENV{'HTTP_USER_AGENT'} ne "") 		{ print "Http User Agent: $ENV{'HTTP_USER_AGENT'}$br\n"; }
  if ($ENV{'HTTP_ACCEPT_CHARSET'} ne "")	{ print "Zeichens&#228;tze: $ENV{'HTTP_ACCEPT_CHARSET'}$br\n"; }
  if ($ENV{'HTTP_ACCEPT_ENCODING'} ne "")	{ print "Kodierungsarten: $ENV{'HTTP_ACCEPT_ENCODING'}$br\n"; }
  if ($ENV{'HTTP_ACCEPT_LANGUAGE'} ne "")	{ print "Sprachen: $ENV{'HTTP_ACCEPT_LANGUAGE'}$br\n"; }
  if ($ENV{'HTTP_ACCEPT'} ne "") 		{ print "Mime-types: $ENV{'HTTP_ACCEPT'}$br\n"; }
  if ($ENV{'HTTP_HOST'} ne "") 			{ print "Http Host: $ENV{'HTTP_HOST'}$br\n"; }
  if ($ENV{'HTTP_VIA'} ne "") 			{ print "Proxy-Caches: $ENV{'HTTP_VIA'}$br\n"; }
  if ($ENV{'SERVER_PROTOCOL'} ne "")		{ print "Server Protokoll: $ENV{'SERVER_PROTOCOL'}$br\n"; }
  if ($ENV{'SERVER_SOFTWARE'} ne "")		{ print "Server Software: $ENV{'SERVER_SOFTWARE'}$br\n"; }
  if ($ENV{'SERVER_NAME'} ne "")		{ print "Server Name: $ENV{'SERVER_NAME'}$br\n"; }
  if ($ENV{'SERVER_PORT'} ne "") 		{ print "Server Port: $ENV{'SERVER_PORT'}$br\n"; }
  if ($ENV{'GATEWAY_INTERFACE'} ne "")	 	{ print "Gateway Interface: $ENV{'GATEWAY_INTERFACE'}$br\n"; }
  if ($ENV{'LOGON_USER'} ne "") 		{ print "Logon User: $ENV{'LOGON_USER'}$br\n"; }
  if ($ENV{'REMOTE_HOST'} ne "") 		{ print "Remote Host: $ENV{'REMOTE_HOST'}$br\n"; }
  if ($ENV{'REMOTE_ADDR'} ne "") 		{ print "Remote Adress: $ENV{'REMOTE_ADDR'}$br\n"; }
  if ($ENV{'LAST_MODIFIED'} ne "") 		{ print "&#196;nderungsdatum: $ENV{'LAST_MODIFIED'}$br\n"; }
  if ($ENV{'CONTENT_LENGTH'} ne "")		{ print "Datenlaenge: $ENV{'CONTENT_LENGTH'}$br\n"; }
  print "&#169; WubscH Consulting</p></card>";
  
  if ($scripting eq "HTML") {
    &HTML_Abschluss();
  } else {
    &WML_Abschluss();
  }
  exit 0; # habe fertig!

#--------------------------------------------------------------------------------------------------------
#--
#--  Eingabe analysieren
#--
#--------------------------------------------------------------------------------------------------------
sub ParseInput {

  my $in;
  
  # print TEST "ParseInput: ";
 
  if ($ENV{'REQUEST_METHOD'} eq "GET")
  {
    $in = $ENV{'QUERY_STRING'};
  }
  elsif ($ENV{'REQUEST_METHOD'} eq "POST")
  {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  # print TEST "$in\n";
  
  $in =~ s/required(.*?)={1}/$1=/g;
   
  # print TEST "Input: ";
  # print TEST "$in\n";
  
  return URLEncoding::parse_cgi($in);
  
}

#--------------------------------------------------------------------------------------------------------
#--
#--  CGI_Input aufbereiten
#--
#--------------------------------------------------------------------------------------------------------
sub Input_aufbereiten
{
  my ($input) = @_;
  my $key;

  foreach $key (keys %$input)
  { $$input{$key} =~ s/\0/,/g;       # maskierte '\0' in ',' aendern
  }
  
}

#--------------------------------------------------------------------------------------------------------
#--  http-Header
#--------------------------------------------------------------------------------------------------------
sub httpHeader {

  print "Pragma: no-cache\n";
  print "Expires: now\n";
  print "Content-type: text/html\n\n";

}

#--------------------------------------------------------------------------------------------------------
#--  wtp-Header
#--------------------------------------------------------------------------------------------------------
sub wtpHeader {

  print "Pragma: no-cache\n";
  print "Expires: now\n";
  print "Content-type: text/vnd.wap.wml\n\n";

}

#--------------------------------------------------------------------------------------------------------
#--  HTML-Start
#--------------------------------------------------------------------------------------------------------
sub HTML_Start {

  my ($title) = @_;

  print "<html>\n";
  print "<head>\n";
  print "<title>$title</title>\n";
  print "<meta http-equiv=\"Content-Type\" content=\"text/html\; charset=iso-8859-1\">\n";
  print "</head>\n";
  print "<body bgcolor=\"#FFFFFF\">\n";

}

#--------------------------------------------------------------------------------------------------------
#--  HTML-Abschluss
#--------------------------------------------------------------------------------------------------------
sub HTML_Abschluss {

  print "</body>\n";
  print "</html>\n";

}

#--------------------------------------------------------------------------------------------------------
#--  WML-Start
#--------------------------------------------------------------------------------------------------------
sub WML_Start {

  print "<?xml version=\"1.0\"?>\n";
  print "<!DOCTYPE wml PUBLIC \"-//WAPFORUM//DTD WML 1.1//EN\" \"http://www.wapforum.org/DTD/wml_1.1.xml\">\n";
  print "<wml>\n";

}

#--------------------------------------------------------------------------------------------------------
#--  WML-Abschluss
#--------------------------------------------------------------------------------------------------------
sub WML_Abschluss {

  print "</wml>\n";

}