#!/usr/bin/perl5.18.2
if (exists $ENV{'TRILOBIT'}) { eval('use CGI::Carp qw "fatalsToBrowser croak";') }
use warnings;
no warnings 'deprecated';
$SIG{__WARN__} = sub {
  if (exists $ENV{'TRILOBIT'}) {
    print STDOUT $_[0];
  }
};
BEGIN {
  $SIG{__WARN__} = sub {
    my ($text) = @_;
    if (exists $ENV{'TRILOBIT'} && !exists $ENV{'HTTP_HOST'}) {
      if (   $text !~ /Name "(\w+)::\w+" used only once: possible typo/i
          || (defined $1 && $1 eq 'main')
      ) {
        print STDOUT $text;
      }
    }
  };
}

package parameter;
use Cwd();
use File::Basename();

if (!defined $parameter::init) {
  $parameter::init=1;
  @parameter::parameters=();
  %parameter::parameters=();
  %parameter::files=();
  $parameter::poststring = '';
  $parameter::getstring='';
  $parameter::argvstring='';

  ######################################################################
  # Programmtechnische Variablen in main setzten:
  # (Zugriff über '$main::_home_dir' oder auch '$parameter::home_dir')
  # $_remote_addr = IP-Adresse
  # $_http_host = Name oder IP des Servers, die beim Aufruf benutzt wurde
  # $_home_dir  = Voller Pfad des Hauptverzeichnisses der Präsenz (z.B. E:/Kunden/trilobit)
  # $_root_dir  = Voller Pfad des Hauptverzeichnisses der Domäne (z.B. E:/Kunden/trilobit/tst.trilobit.de)
  # $_cgi_bin   = Voller Pfad des cgi-bin Verzeichnisses der Domäne (z.B. E:/Kunden/trilobit/tst.trilobit.de/cgi-bin)
  # $_prog_dir  = Voller Pfad auf das Verzeichnis, in dem das Programm ausgeführt wird (z.B. E:/Kunden/trilobit/tst.trilobit.de/cgi-bin/test)
  # $_prog_name = Name des Programms (z.B. test.pl)
  ######################################################################

  $parameter::remote_addr = exists $ENV{'REMOTE_ADDR'} ? $ENV{'REMOTE_ADDR'} : '';
  $parameter::http_host   = exists $ENV{'HTTP_HOST'}   ? $ENV{'HTTP_HOST'}   : '';

  my $abs_name = Cwd::abs_path(__FILE__);  # absoluten Pfad inkl. Skriptname ermitteln
  $abs_name =~ s/\\/\//g;                  # Backslashes in Forward-Slahes umwandeln
  $abs_name =~ s/\/\.//g;                  # "/." entfernen (Anm: Aus Bestandscode übernommen, Sinn unklar - Rolf 2010-08-02)

  $prog_dir  = File::Basename::dirname($abs_name);       # Pfad extrahieren
  $prog_name = File::Basename::basename($abs_name);      # Skriptname extrahieren

  if ($prog_dir =~ /\A(.*\/cgi-bin)/) {
    $cgi_bin = $1;
  }
  else {
    $cgi_bin = $prog_dir;
  }

  if (exists $ENV{'DOCUMENT_ROOT'}) {
    $root_dir = $ENV{'DOCUMENT_ROOT'};
  }
  else {
    if ($cgi_bin =~ /(.*)\/cgi-bin/) {
      $root_dir = $1;
    }
    else {
      if ($cgi_bin =~ /(.*)\/[^\/]*\Z/) {
        $root_dir = $1;
      }
      else {
        $root_dir = $cgi_bin;
      }
    }
  }

  $root_dir =~ s/\/\.?\Z//;
  $home = $ENV{'HOME'};         # gesetzt wenn direkt auf Linux per telnet/cron gestartet...
  if (!$home || $home eq '/') { # ansonsten root_dir in home umwandeln (erstes .../xZZZZZZZZZ oder .../htdocs Verzeichnis)
    $home = $root_dir;
    if ($home =~ /\/tst\./ ) {  # wenn Trilobit-Test-Domain (tst.xxxx.yyy) dann ..
      if ($home =~ /\A(.*)\/tst\./) { $home = $1; }
    } else {
      if ($home =~ /(\A(?:.*?)\/rp-hosting\/\d+\/\d+)/) { $home = $1; }
      elsif ($home =~ /(\A\/kunden\/[^\/]+)\/webseiten\Z/) { $home = $1; }
      elsif ($home =~ /(\A(?:.*?)\/\D\d{6,}(\/htdocs)?)/) { $home = $1; }
      elsif ($home =~ /\A(.*?)\/htdocs\Z/) { $home = $1; }
    }
  }
  $home =~ s/\/\.?\Z//;
  # print "\n\nHOME (vor DF Sonder): $home<br>\n";

  ## DF-Änderungen: 27.2.07 (Rolf)
  ## DF Sonderbehandlung: rp-hosting
  if ($home !~ /\/rp-hosting\/\d+\/\d+\// && $cgi_bin  =~ /(\/kunden\/[^\/]+\/rp-hosting\/\d+\/\d+)\//) {
    # kein /rp-hosting/zahl/zahl/ im Home-Dir, aber im cgi-bin -> Ergänzen (Aufruf über Cron)
    $home = $1;
    # root-dir um Verzeichnis(se) vor cgi-bin ergänzen
    if ($cgi_bin =~ /(.*)\/cgi-bin/) {
      $root_dir = $1;
    }
  }
  ## DF Sonderbehandlung II: webseiten
  if ($cgi_bin =~ /(\A\/kunden\/[^\/]+)\/webseiten\// && $root_dir !~ /\A\/kunden\/[^\/]+\/webseiten/) {
    # cgi-bin enthält /kunden/.../webseiten, Root-Dir aber nicht -> Ergänzen (Aufruf über Cron)
    $home = $1;
    # root-dir um Verzeichnis(se) vor cgi-bin ergänzen
    if ($cgi_bin =~ /(.*)\/cgi-bin/) {
      $root_dir = $1;
    }
  }


  $main::_ip           = $remote_addr;
  $main::_remote_addr  = $remote_addr;
  $main::_host         = $http_host;
  $main::_http_host    = $http_host;
  $main::_home         = $home;               # Zirkelzuweisung wegen warning "used only once".
  $main::HOME          = $main::_home;
  $main::_home_dir     = $main::HOME;
  $main::_root_dir     = $root_dir;
  $main::DOCUMENT_ROOT = $root_dir;
  $main::DOCUMENT_ROOT = $main::DOCUMENT_ROOT;  # Zirkelzuweisung wegen warning "used only once".
  $main::_cgi_bin      = $cgi_bin;
  $main::_prog_dir     = $prog_dir;
  $main::_prog_name    = $prog_name;


  #print "content-type: text/plain\n\n";
  # Parameter auslesen und setzten

  $enctype = '';
  if (defined $ENV{'CONTENT_LENGTH'} && $ENV{'CONTENT_LENGTH'}>0) {
    binmode STDIN;
    my $tmp='';
    $stdin = '';
    while (sysread(STDIN, $tmp, 1024)) { $stdin.=$tmp; $tmp='';}
    if ($stdin) {
      ##$stdin =~ s/\n\r/\n/g;
      ##$stdin =~ s/\r/\n/g;
      #print $ENV{'CONTENT_LENGTH'};
      #print "\n";
      #print length($stdin);
      #die;
      if ($stdin =~ /\A([^\n]*?)\n(.*)\Z/s) {
        ######################################################################
        # MULTIPART-FORMDATA:
        # liefert zusätzlich folgende Werte zurück:
        # $name (= $value):  die übertragene Datei als $<Name des FILE-Feldes>
        # $name_contenttype: der "Content-Type" der übertragenen Datei
        # $name_filetype:    die Endung der Datei (gif, jpg, etc.)
        # $name_filepath:    der komplette Pfad+Name der Datei auf den Client
        # $name_filename:    der Name der Datei (ohne Pfad, mit Endung)
        # $name_filesize:    die Größe der Datei in Bytes
        ######################################################################
        my $id = $1;
        $enctype = 'multipart';
        $poststring = $2;
        $id =~ s/\r//g;
##print "content-type: text/plain\n\n";
##print "|$id|$poststring|<br>\n";
        my @a=split /$id/, $poststring;
        pop @a;
        foreach (@a) {
          if (/name="(.*?)"(.*?)\r*\n\r*\n(?:\n|\r)*(.*?)(\n|\r)+\Z/s) {
            my $filepath = '';
            my $filename = '';
            my $filetype = '';
            my $contenttype = '';
            my $name = $1;      # $1=Name der Variable
            my $rest = $2;      # $2=Restinformationen
            my $content = $3;   # $3=Inhalt
            my $filesize = length($content);
            if ($rest =~ /filename="(.*?)"/s) {
              addVar($name.'_filesize',$filesize);
              my $filepath = $1;
              $filepath =~ s/\\/\//g;
              addVar($name.'_filepath',$filepath);
              if ($filepath =~ /.*\/(.*?)\Z/ ) { $filename = $1; } else { $filename = $filepath; }
              addVar($name.'_filename',$filename);
              if ($filename =~ /\.(.*)\Z/) { $filetype=correctFileType($1); addVar($name.'_filetype',$filetype); }
              $files{$name}=1;
            }
            if ($rest =~ /Content-Type: (.*)\Z/si) {
              $contenttype = $1;
              addVar($name.'_contenttype',$contenttype);
              if (!$filetype && $contenttype =~ /\/(.*)\Z/) { $filetype=correctFileType($1); addVar($name.'_filetype',$filetype); }
            }
            if ($filename) { addVar($name, $content, 'binary'); }
            else {
              $content =~ s/\r\n/\n/g;
              $content =~ s/\r/\n/g;
              addVar($name, $content);
            }

            ##if ($contenttype) { binmode STDOUT; print "Content-Type: $contenttype\n\n$content"; die; }
          }
        }
      } else {
        ######################################################################
        # SINGLE-LINE-FORMDATA:
        # wandelt die Zeile aus STDIN in Variablen um
        ######################################################################
        $poststring=$stdin;
        separateString($poststring);
      }
    }
  }

  if (defined $ENV{'QUERY_STRING'}) {
    $getstring = $ENV{'QUERY_STRING'};
    separateString($getstring);
  }
  if (@ARGV) {
    $argvstring = joinString(@ARGV);
    separateString($argvstring);
  }
}

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


sub addVar { my ($var, $val, $mode) = @_;
  if (!$mode) { $mode='post'; }
  if ($mode eq 'post' && $enctype ne 'multipart') {
    $var =~ s/%(..)/pack("H*",$1)/ge;
    $val =~ s/%u2018/‘/g;                   # Unicodeersetzung
    $val =~ s/%u2019/’/g;                   # Unicodeersetzung
    $val =~ s/\+/ /g;
    $val =~ s/%(..)/pack("H*",$1)/ge;
    $val =~ s/\r\n/\n/g;
    $val =~ s/\r/\n/g;
  }
  $var =~ s/\./_/g;
  push @parameters, $var;
  $parameters{$var}=$val;
  if ($var !~ /::/) { $var="main::$var"; }
  if (!defined $$var) {
     $$var = $val;
     @$var = ($val);
   } else {
     push @$var, $val;
  }
}


sub correctFileType { # $filetype
  my $filetype = lc (shift @_);
  if ($filetype =~ 'jpeg') { $filetype='jpg'; }  # jpeg, pjpeg
  return $filetype;
}


sub encode { # $text => $text
  my $text = shift @_;
  $text =~ s/([^\w@\-\.,*_\[\] ])/'%'.unpack("H*",$1)/ge;
  $text =~ tr/ /+/;
  return $text;
}


sub joinString {
  my $string='';
  foreach (@ARGV) {
    $_ =~ /([^=]+)=(.*)/;
    $var=encode($1); $value=encode($2);
    $string.=($string?'&':'')."$var=$value";
  }
  return $string;
}


sub separateArray { # @parameter
  foreach (@_) {
    if (/\A(.*?)=(.*)\Z/) { addVar($1,$2); }
  }
}


sub separateString { # $line
  my $line = shift @_;
  my @line = split('&', $line);
  separateArray(@line)
}


package file;
$| = 1;  # weil sonst unter Perl 5.8 STDERR-Meldungen vor allen gepufferten Ausgaben geschrieben werden

my $flock = 1; # umgestellt am 4.8. von Oli (!$ENV{'TRILOBIT'} || $ENV{'TRILOBIT'} eq 'SERVER');
$OS = 'UNIX';       # kein 'my', die Variable wird von anderen Paketen genutzt, z.B: htaccess.pl

if (   (exists $ENV{'SYSTEMROOT'} && $ENV{'SYSTEMROOT'})
    || (exists $ENV{'OS'} && $ENV{'OS'} =~ /Win/i)
    || (exists $ENV{'HOMEDRIVE'} && $ENV{'HOMEDRIVE'})
    || $^O =~ /win32/i
) {
  $OS = 'WINNT';
}
elsif (exists $ENV{'winbootdir'} && $ENV{'winbootdir'}) {
  $OS = 'WIN98';
}

$permission_mask = 0755;    # wird beim Anlegen eines Verzeichnisses verwendet

########### INTERNE METHODEN ########################################


sub _set { my ($filename, $content, $options, $extoptions) = @_;       # $filename, $content, ($options)  (Veraltet: $extoptions durch z.B: setIfDifferent) => /
  # mögliche Optionen:
  # - compare
  # - locked
  # - append
  # - mkdir oder auch -makedir

  if ($filename =~ /\A\|/) {
    if (open FILE, $filename) {
      print FILE $content;
      close FILE;
      return 1;
    }
    return 0;
  }
  if ($extoptions) { $options.= " $extoptions"; }
  my $compare = 0;
  if (!defined $options) { $options = ''; }
  if ($options =~ /compare/) { $compare = 1; }
  my $locked = 0;
  if ($options =~ /locked/) { $locked = 1; }
  my $mkdir = 0;
  if ($options =~ /ma?ke?dir/) { $mkdir = 1; }
  my $append = 0;
  if ($filename =~ /\A>>/) { $append = 1; }
  $filename =~ s/>//g;
  my $ok = 0;
  my $dowrite = 1;
  use Fcntl qw(:DEFAULT :flock);
  if ($mkdir) { makeFileDir($filename); }
  if (sysopen(FILE, $filename, O_RDWR | O_CREAT)) {     # Kann FILE geöffnet/angelegt werden ?
    my $FILE=select(FILE); $|=1; select ($FILE);        # autoflush FILE
    if ($locked && $flock) { flock(FILE, LOCK_EX); }    # FILE locken
    binmode FILE;                                       # FILE in binmode ansprechen -> keine automatische Umwandlung von Return-Codes
    if ($compare) {                                     # Inhalt vorher vergleichen ?
      seek(FILE, 0, 0);                                 # FILE an den Anfang setzen (ersetzen) [0 = SEEK_SET]
      local $/;
      my $old_content = <FILE>;
      if ((!defined $content || $content eq '') && $old_content eq '') {
        $dowrite = 0;
      }
      if (defined $content && $content eq $old_content) {
        $dowrite = 0;
      }
    }
    if ($dowrite) {                                     # Wirklich schreiben:
      if ($append) {
        seek(FILE, 0, 2);                               # FILE an das Ende setzen (anfügen) [2 = SEEK_END]
      }
      else {
        seek(FILE, 0, 0);                               # FILE an den Anfang setzen (ersetzen) [0 = SEEK_SET]
      }

      print FILE $content;                              # $content in FILE (über)schreiben (ohne Datei vorher zu leeren/löschen)
      truncate(FILE, tell(FILE));                       # FILE an aktueller Position beenden
      $ok = 1;
    }
    close(FILE);                                        # FILE schließen und automatisch Lock freigeben
  }
  else {
    print STDERR "ERROR: can't open file '$filename' for output (file::set [$options])\n";
  }

  return $ok;
}


sub correctPath { my ($path) = @_;
  # $path => $path
  # ersetzt \ durch /
  # ersetzt // durch /
  # fasst <dir>/.. zusammen

  if (!$path) {
    $path = '.';
  }

  $path =~ s/\\/\//g;
  $path =~ s/\/\//\//g;
  $path =~ s/\Aftp:\//ftp:\/\//i;

  while ($path =~ /\/[^\/]+\/\.\./) {
    $path =~ s/\/[^\/]+\/\.\.//;
  }

  return $path;
}


sub makeDir { my ($dir, $recurse) = @_;   # legt ein Verzeichnis oder Verzeichnisstruktur an
  if (!-d $dir) {
    if ($recurse) {                 # rekursiv komplette Verzeichnisstruktur anlegen
      my @dirs = split '/', $dir;
      $dir = '';
      foreach (@dirs) {
        $dir .= "$_/";
        if (!-d $dir) {
          CORE::mkdir "$dir", $permission_mask;
        }
      }
    }
    else {
      CORE::mkdir "$dir", $permission_mask;    # nur einzelnes Verzeichnis
    }
  }
}


sub makeFileDir { my ($dir, $file) = splitPath(@_);
  # legt die Verzeichnisstruktur für eine Datei an
  makeDir($dir, 1);
}


sub set {
  _set(@_);
}


sub splitPath { # $fullfilename => $path, $filename
  # spaltet den vollen Dateinamen in Pfad und Dateinamen
  my $file = correctPath(shift @_);
  my $path = '';
  if ($file =~ /\A(.*)\/([^\/]*)\Z/) {
    $path = $1;
    $file = $2;
  }

  return ($path, $file);
}


package date;
my $debug = 0;

######################################################
# languages:
# - en = Englisch
# - de = Deutsch
# - fr = Französisch
# - nl = Niederländisch
# - es = Spanisch
######################################################

%feiertage = (   # Feiertagsliste  (http://www.feiertage.net/uebersicht.php?year=2008, http://www.us-infos.de/fakten-feiertage.html)
# WICHTIG: Listenformat muss D.M.JJJJ sein, keine führenden Nuller

  # immer gültige Feiertage, kein Jahr angeben:
   '1.1.'  => 'nj|de',
   '6.1.'  => 'hdk|de-bw,de-by,de-st',
  '14.2.'  => '_vt|de,us',
   '1.5.'  => '1m|de',
   '4.7.'  => 'usid|us',
  '15.8.'  => 'mh|de-by,de-sl',
   '3.10.' => 'tde|de',
  '31.10.' => 'rt|de-bb,de-mv,de-sn,de-st,de-th',
   '1.11.' => 'ah|de-bw,de-by,de-nw,de-rp,de-sl',
  '24.12.' => '_ha|de,us',
  '25.12.' => '1wt|de',
  '26.12.' => '2wt|de',
  '31.12.' => '_slv|de,us',

  # variable Feiertage werden bis 2099 berechnet
);

# Liste der Geltungsbereiche für automatisch berechnete Tage
%geltungsbereich = (
  '_wf'   => '_wf|de',
  '_rm'   => '_rm|de',
  '_fn'   => '_fn|de',
  '_am'   => '_am|de',
  '_pls'  => '_pls|de',
  '_gd'   => '_gd|de',
  'kf'    => 'kf|de',
  '_os'   => '_os|de',
  'om'    => 'om|de',
  'ch'    => 'ch|de',
  '_pfs'  => '_pfs|de',
  'pfm'   => 'pfm|de',
  'fl'    => 'fl|de-bw,de-by,de-he,de-nw,de-rp,de-sl',
  'bb'    => 'bb|de-sn',
  '_ts'   => '_ts|de',
  '_1as'  => '_1as|de,us',
  '_2as'  => '_2as|de,us',
  '_3as'  => '_3as|de,us',
  '_4as'  => '_4as|de,us',
);

# Feiertagsnamen
# ID beginnt mit _: kein offizieller Feiertag -> Ereignis
%fname = (
  'de'=> {
    'nj'   => 'Neujahr',
    'hdk'  => 'Heilige Drei Könige',
    '_vt'  => 'Valentinstag',
    '_wf'  => 'Weiberfastnacht',
    '_rm'  => 'Rosenmontag',
    '_fn'  => 'Fastnacht',
    '_am'  => 'Aschermittwoch',
    '_pls' => 'Palmsonntag',
    '_gd'  => 'Gründonnerstag',
    'kf'   => 'Karfreitag',
    '_os'  => 'Ostersonntag',
    'om'   => 'Ostermontag',
    '1m'   => 'Maifeiertag',
    'ch'   => 'Christi Himmelfahrt',
    '_pfs' => 'Pfingstsonntag',
    'pfm'  => 'Pfingstmontag',
    'fl'   => 'Fronleichnam',
    'mh'   => 'Mariä Himmelfahrt',
    'tde'  => 'Tag der Deutschen Einheit',
    'rt'   => 'Reformationstag',
    'ah'   => 'Allerheiligen',
    '_vtt' => 'Volkstrauertag',
    'bb'   => 'Buß- und Bettag',
    '_ts'  => 'Totensonntag',
    '_1as' => '1. Adventssonntag',
    '_2as' => '2. Adventssonntag',
    '_3as' => '3. Adventssonntag',
    '_4as' => '4. Adventssonntag',
    '_ha'  => 'Heiligabend',
    '1wt'  => '1. Weihnachtstag',
    '2wt'  => '2. Weihnachtstag',
    '_slv' => 'Silvester',
    'usid' => 'Unabhängigkeitstag',
  },
  'en'=> {
    'nj'   => "New Year's Day",
    'hdk'  => 'Epiphany',
    '_vt'  => "Valentine's Day",
    '_wf'  => 'Thursday before Shrove Tuesday',
    '_rm'  => 'Carnival Monday',
    '_fn'  => 'Shrove Tuesday',
    '_am'  => 'Ash Wednesday',
    '_pls' => 'Palm Sunday',
    '_gd'  => 'Maundy Thursday',
    'kf'   => 'Good Friday',
    '_os'  => 'Easter Sunday',
    'om'   => 'Easter Monday',
    '1m'   => 'May Day',
    'ch'   => 'Ascension Day',
    '_pfs' => 'Whit Sunday',
    'pfm'  => 'Whit Monday',
    'fl'   => 'Corpus Christi',
    'mh'   => 'Assumption Day',
    'tde'  => 'German Unification Day',
    'rt'   => 'Reformation Day',
    'ah'   => "All Saints' Day",
    '_vtt' => 'Remembrance Day',
    'bb'   => 'Penance Day',
    '_ts'  => 'Sunday in commemoration of the dead',
    '_1as' => '1st Advent Sunday',
    '_2as' => '2nd Advent Sunday',
    '_3as' => '3rd Advent Sunday',
    '_4as' => '4th Advent Sunday',
    '_ha'  => 'Christmas Eve',
    '1wt'  => 'Christmas Day',
    '2wt'  => 'Boxing Day',
    '_slv' => "New Year's Eve",
    'usid' => 'Independence Day',
  },

);

# Regionsnamen
%rname = (
  'de'=> {
    'de'=>'Deutschland',
    'de-bw'=>'Baden-Württemberg',
    'de-by'=>'Bayern',
    'de-be'=>'Berlin',
    'de-bb'=>'Brandenburg',
    'de-hb'=>'Bremen',
    'de-hh'=>'Hamburg',
    'de-he'=>'Hessen',
    'de-mv'=>'Mecklenburg-Vorpommern',
    'de-ni'=>'Niedersachsen',
    'de-nw'=>'Nordrhein-Westfalen',
    'de-rp'=>'Rheinland-Pfalz',
    'de-sl'=>'Saarland',
    'de-sn'=>'Sachsen',
    'de-st'=>'Sachsen-Anhalt',
    'de-sh'=>'Schleswig-Holstein',
    'de-th'=>'Thüringen',
    'us'=>'Vereinigte Staaten',
  },
  'en'=> {
    'de'=>'Germany',
    'de-bw'=>'Baden-Wuerttemberg',
    'de-by'=>'Bavaria',
    'de-be'=>'Berlin',
    'de-bb'=>'Brandenburg',
    'de-hb'=>'Bremen',
    'de-hh'=>'Hamburg',
    'de-he'=>'Hesse',
    'de-mv'=>'Mecklenburg-Western Pomerania',
    'de-ni'=>'Lower Saxony',
    'de-nw'=>'North Rhine-Westphalia',
    'de-rp'=>'Rhineland-Palatinate',
    'de-sl'=>'Saarland',
    'de-sn'=>'Saxony',
    'de-st'=>'Saxony-Anhalt',
    'de-sh'=>'Schleswig-Holstein',
    'de-th'=>'Thuringia',
    'us'=>'United States',
  },

);

# Monatsnamen
@mname_en = ( 'January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December' );
@mname_de = ( 'Januar', 'Februar', 'März', 'April', 'Mai', 'Juni', 'Juli', 'August', 'September', 'Oktober', 'November', 'Dezember' );
@mname_fr = ( 'janvier', 'février', 'mars', 'avril', 'mai', 'juin', 'juillet', 'août', 'septembre', 'octobre', 'novembre', 'décembre' );
@mname_es = ( 'enero', 'febrero', 'marzo', 'abril', 'mayo', 'junio', 'julio', 'agosto', 'septiembre', 'octubre', 'noviembre', 'diciembre' );
@mname_nl = ( 'januari', 'februari', 'maart', 'april', 'mei', 'juni', 'juli', 'augustus', 'september', 'oktober', 'november', 'december' );
%mname = ( 'en' => \@mname_en, 'de' => \@mname_de, 'fr' => \@mname_fr, 'es' => \@mname_es, 'nl' => \@mname_nl );

# Wochentagnamen
@dname_en = ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday', 'Sunday' );
@dname_de = ( 'Sonntag', 'Montag', 'Dienstag', 'Mittwoch', 'Donnerstag', 'Freitag', 'Samstag', 'Sonntag' );
@dname_fr = ( 'dimanche', 'lundi', 'mardi', 'mercredi', 'jeudi', 'vendredi', 'samedi', 'dimanche' );
@dname_es = ( 'domingo', 'lunes', 'martes', 'miércoles', 'jueves', 'viernes', 'sábado', 'domingo' );
@dname_nl = ( 'zondag', 'maandag', 'dinsdag', 'woensdag', 'donderdag', 'vrijdag', 'zaterdag', 'zondag' );
%dname = ( 'en' => \@dname_en, 'de' => \@dname_de, 'fr' => \@dname_fr, 'es' => \@dname_es, 'nl' => \@dname_nl );

# Datumsformate
@format_en = ('%D%TH %MON %YYYY', '%h:%mm:%ss %pm');        # 3rd February 2002 - 8:43:22 am
@format_de = ('%D. %MON %YYYY', '%h:%mm:%ss');              # 3. Februar 2002 - 8:43:22
@format_fr = ('%D %MON %YYYY', '%h:%mm:%ss');               # 3 février 2002 - 8:43:22
@format_es = ('%D de %MON de %YYYY', '%h:%mm:%ss');         # 3 de febrero de 2002 - 8:43:22
@format_nl = ('%D %MON %YYYY', '%h:%mm:%ss');               # 3 februari 2002 - 8:43:22
%format = ( 'en' => \@format_en, 'de' => \@format_de, 'fr' => \@format_fr, 'es' => \@format_es, 'nl' => \@format_nl );

# Abkürzungen
%bc = (
  'en'=>'B.C.',
  'de'=>'v. Chr.',
  'fr'=>'',
  'es'=>'aC',
  'nl'=>'v. Chr.',
);
%ad = (
  'en'=>'A.D.',
  'de'=>'n. Chr.',
  'fr'=>'',
  'es'=>'dC',
  'nl'=>'n. Chr.',
);

#|           |       |                           |Zeit-  |  DST-Start (+1)   |    DST-Ende (-1)  |
#|Array-Name |ZoneID |Timezone-Name              |Diff   |Mon.|WTag|Num.|Uhr | Mon.|WTag|Num.|Uhr|
@utc = ('UTC', 'Universal Time Coordinated',       '0:00',   0,  0,  0, '0:00',  0,  0,  0, '0:00');
@gmt = ('GMT', 'Greenwich Mean Time',              '0:00',   0,  0,  0, '0:00',  0,  0,  0, '0:00');
@wet = ('WET', 'Western European Time',            '0:00',   3,  0, -1, '2:00', 10,  0, -1, '3:00');
@cet = ('CET', 'Central European Time',           '+1:00',   3,  0, -1, '2:00', 10,  0, -1, '3:00');
@act = ('ACT', 'Australien Central Time',         '+9:30',  10,  0, -1, '2:00',  3,  0, -1, '2:00');
@aet = ('AET', 'Australien Eastern Time',        '+10:00',  10,  0, -1, '2:00',  3,  0, -1, '2:00');
%tzone = ('UTC' => \@utc, 'GMT' => \@gmt, 'WET' => \@wet, 'CET' => \@cet, 'ACT' => \@act, 'AET' => \@aet);
# Mon. : Monat (1-12)
# WTag : Wochentag (0-6, 0=Sonntag)
# Num. : Nummer des Wochentags im Monat, -1 = letzter
# Uhr  : Uhrzeit

$shortyear = 1; # 0: 86 -> 86 n.Chr. / 1: 86 -> 1986 n.Chr.

if (!$language) { $language = 'de' }
$language = lc(substr($language,0,2));
if (!$_timezone) { $_timezone = 'CET' }
$_timezone = uc($_timezone);

1;

################################################################
# Aliases        # @date-array:
################################################################
$_sec = 0;       # 0: seconds  (0-59)
$_min = 1;       # 1: minutes  (0-59)
$_hour = 2;      # 2: hours    (0-23)
$_mday = 3;      # 3: mday     (1-[28-31])
$_month = 4;     # 4: month    (0-11)
$_year = 5;      # 5: year     (date.pl: 4 stellig; gmtime: Jahre seit 1900)
$_wday = 6;      # 6: wday     (0-6; 0 = Sonntag)
$_yday = 7;      # 7: yday     (0-364/365)
$_dst = 8;       # 8: dst      (-1: na/0: no/1: yes)
$_tzone = 9;     # 9: tzone    (3 Char Name der TZone)
$_longsecs= 10;  #10: longsecs (Sekunden seit/bis 1.1.1970 0:00:00 Uhr GMT)
$_fullyear = 11; #11: fullyear (0: Umrechnung evtl. notwendig (+1900)/1: keine Umrechnung mehr notwendig)
$_week = 12;     #12: week     (1-52/53)
$_quartal = 13;  #13: quartal  (1-4)
$_weekyear = 14; #14: weekyear (4 stellig, Jahr der Woche: KW 1 im Dezember 2000 -> weekyear = 2001)
                 #
                 # DST: -1 = DST nicht berechnet
                 #       0 = kein DST
                 #       1 = DST
                 #
################################################################
# zusätzliche Aliases
$_second = $_sec;
$_seconds = $_sec;
$_minute = $_min;
$_minutes = $_min;
$_hours = $_hour;
$_day = $_mday;
$_monthday = $_mday;
$_weekday = $_wday;
$_yearday = $_yday;
$_long = $_longsecs;
$_time = $_longsecs;
$_kw = $_week;
$_quarter = $_quartal;
################################################################
# Sekundenwerte
$_minsecs = 60;
$_hoursecs = 3600;
$_daysecs = 86400;
$_weeksecs = 604800;
################################################################


sub convert {
# 1. Parameter: Message
# 2. Parameter: Date-Array
# Ersetzt Datums-/Zeitplatzhalter in einer Message durch die richtigen Werte aus dem Date-Array
# wird kein @date angegeben, wird die aktuelle Zeit benutzt.
# Sprache: $date::language = de | en
# %D    = Tag (2)
# %DD   = Tag mit führender Null (02)
# %DDD  = Name des Tages in 3-Zeichen Form (Die | Tue)
# %DAY  = Name des Tages (Dienstag | Tuesday)
# %TH   = englisches 1., 2., 3. => 1st, 2nd, 3rd...
# %W    = Woche (3)
# %WW   = Woche mit führender Null (03)
# %M    = Monat (4)
# %MM   = Monat mit führender Null (04)
# %MMM  = Name des Monats in 3-Zeichen Form (Mär | Mar)
# %MON  = Name des Monats (März | March)
# %WY   = Wochenjahr (letzter Tag in 2002 -> 1/2003 -> Wochenjahr 2003)
# %Y    = Jahr wie angegeben
# %YY   = Jahr in 2-Zeichen (72)
# %YYYY = Jahr in 4-Zeichen (1972)
# %YEAR = Jahr in 4-Zeichen komplett (1972 n. Chr)
# %L    = Sekunden-Longwert (seit/bis 1.1.1970 0:00:00 Uhr GMT)
# %s    = Sekunden (3)
# %ss   = Sekunden mit führender Null (03)
# %m    = Minuten (3)
# %mm   = Minuten mit führender Null (03)
# %h    = Stunden (3)
# %hh   = Stunden mit führender Null (03)
# %pm   = englisches Zeitformat (am/pm)

  my $msg = shift @_;
  my @d = @_;
  my $lang = $language;
  my $x;
  if (!$d[3]) { @d = getDate(); }
  if ($shortyear and $d[5] < 1000) { $d[5] += 1900; }

  $msg =~ s/%GER_/%DE_/g;
  $msg =~ s/%ENG_/%EN_/g;
  # Ersetze %<LangID>_DATE / %<LangID>_TIME zu %DATE und %TIME und speichere LangID
  foreach my $lgkey (keys %format) {
    $lgkey = uc($lgkey);
    if ($msg =~ /%($lgkey)_/ ) {
      $language=lc($1);
      $msg =~ s/%${1}_/%/g; ## Prozent zuviel? <- wer immer das geändert hat: Das muss so bleiben! (Alex)
      #$msg =~ s/%${1}_//g; ## Auf keinen Fall ohne %! (Alex)
    }
  }

  $msg =~ s/%DATE/$format{$language}->[0]/g;
  $msg =~ s/%TIME/$format{$language}->[1]/g;

  if ($msg =~ /D%TH/) {
    $x='th';
    if ($d[3]==1 or $d[3]==21 or $d[3]==31) { $x = 'st'; }
    if ($d[3]==2 or $d[3]==22) { $x = 'nd'; }
    if ($d[3]==3 or $d[3]==23) { $x = 'rd'; }
    $msg =~ s/D%TH/D$x/g;
  }

  if ($d[14]>=0) { $x=sprintf("%04d",$d[14]); $msg =~ s/%WY/$x/g; }
            else { $x=sprintf("%05d",$d[14]); $msg =~ s/%WY/$x/g; }

  $x=sprintf("%02d",$d[12]); $msg =~ s/%WW/$x/g;
  $x=sprintf("%d",$d[12]);   $msg =~ s/%W/$x/g;

  $x=getDayName($d[6]);      $msg =~ s/%DAY/$x/g;
  $x=substr($x,0,3);         $msg =~ s/%DDD/$x/g;
  $x=sprintf("%02d",$d[3]);  $msg =~ s/%DD/$x/g;
  $x=sprintf("%d",$d[3]);    $msg =~ s/%D/$x/g;

  my $mon = $d[4]+1;
  $x=getMonthName($mon);     $msg =~ s/%MON/$x/g;
  $x=substr($x,0,3);         $msg =~ s/%MMM/$x/g;
  $x=sprintf("%02d",$mon);   $msg =~ s/%MM/$x/g;
  $x=sprintf("%d",$mon);     $msg =~ s/%M/$x/g;

  my $year='';
  if ($d[5]>=0) {
    if ($msg =~ /%YEAR/ ) {
      $year = $ad{$lang};
      $x=sprintf("%4d %s",$d[5],$year);
      $msg =~ s/%YEAR/$x/g;
    }
    $x=sprintf("%04d",$d[5]); $msg =~ s/%YYYY/$x/g;
    $x=substr($x,2,2);        $msg =~ s/%YY/$x/g;
  } else {
    if ($msg =~ /%YEAR/ ) {
      $year = $bc{$lang};
      $x=sprintf("%4d %s",($d[5]*-1),$year);
      $msg =~ s/%YEAR/$x/g;
    }
    $x=sprintf("%05d",$d[5]);  $msg =~ s/%YYYY/$x/g;
    $x=substr($x,3,2);         $msg =~ s/%YY/$x/g;
  }
  $x=$d[5];                    $msg =~ s/%Y/$x/g;

  $x=$d[10];                   $msg =~ s/%L/$x/g;

  my $hour = $d[2];
  if ($msg =~ /%pm/) {
    if ($hour >= 12) { $hour-=12; $x='pm'; } else { $x='am'; }
    if ($hour == 0) { $hour = 12; }
    $msg =~ s/%pm/$x/g;
  }

  $x=sprintf("%02d",$hour);    $msg =~ s/%hh/$x/g;
  $x=sprintf("%d",$hour);      $msg =~ s/%h/$x/g;

  $x=sprintf("%02d",$d[1]);    $msg =~ s/%mm/$x/g;
  $x=sprintf("%d",$d[1]);      $msg =~ s/%m/$x/g;

  $x=sprintf("%02d",$d[0]);    $msg =~ s/%ss/$x/g;
  $x=sprintf("%d",$d[0]);      $msg =~ s/%s/$x/g;

  $x=$d[9]; if ($d[8]>0) { $x=$x." DST"; }
  if ($language eq 'de') {
    $x =~ s/CET DST/MESZ/g;
    $x =~ s/CET/MEZ/g;
  }
  $msg =~ s/%ZONE|%TZ/$x/g;

  $language = $lang;
  return $msg;
}


sub date2Long {
# 1. Parameter: Date-Array
# Wandelt ein Datums-Array in Long-Sekunden um (Neuberechnung, 'longsecs' wird ignoriert)
# Sollte im Date-Array keine Zeitzoneninformation vorhanden sein, wird $_timezone verwendet
  my @date = @_; my ($long, $diff, $abzug, $sj, $d, $m, $y, $yd, $dst, $tz, $fy);
  my @days = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334); my $x=0;
  $d=$date[3]; $m=$date[4]; $y=$date[5]; $dst=$date[8]; $tz=$date[9]; $fy=$date[11];
  if (not $fy and $y<200) { $y+=1900 }
  if (not $tz) { $tz = $date[9] = $_timezone }
  if ($y <= 1900) { $dst = 0 }
 #print "DST: <b>$dst</b>: ";
  if ($dst < 0) { $dst = getDST(@date) }  # wenn -1: DST noch nicht berechnet, also nachholen
 #print " -> <b>$dst</b><br>\n";
  $diff = getTimeDiff($tz);
  if ($dst>0) { $diff+=3600 }
  $yd = getYearDays( $d, $m, $y);
  use integer;
  if ($y > 1582) {
    $sj=11+(($y+3)/4)-(($y-1)/100)+(($y-1)/400);
    $abzug=719539;
  } elsif ($y > 0) {
    if ($y==1582 and $m==9 and $d>4 and $d<15) { $d = 15 }
    $sj=($y-1)/4;
    $abzug=719529;
  } else {
    $sj=($y-3)/4;
# $sj=-1;
    $abzug=719164;  # Jahr 0 gibt es nicht
  }
  no integer;
  my $secs = ((($y*365+$sj+$yd-$abzug)*24+$date[2])*60+$date[1])*60+$date[0]-$diff;
 #print "$d.".($m+1).".$y - $date[2]:$date[1]:$date[0] Uhr ($date[9]) [$secs] ($diff)<br>";
  return $secs;
}


sub getDST {
# 1. Parameter: Date-Array
# Prüft, ob DST für das Date-Array vorliegt           #|Zeit-  |  DST-Start (+1)   |    DST-Ende (-1)  |
# gibt die Zeitdifferenz und DST-Status zurück        #|Diff   |Mon.|WTag|Num.|Uhr | Mon.|WTag|Num.|Uhr|
# Aufbau $z: ('CET', 'Central European Time',           '+1:00',   3,  0, -1, '2:00', 10,  0, -1, '3:00');
  my @d = @_; # 0               1                           2      3   4   5     6     7   8   9    10
  my $t = uc($d[9]);
  my $z = $tzone{$t};
  my $diff = 0;
  my $DST = 0;
  if (not $z) { print("Timezone '".$t."' not found !!!"); $DST = -1; }
  elsif ($z->[2] && $z->[3] && $z->[7]) {                                         # Wenn DST aktiv (Differenz/Start-/Endmonat existiert)
    $diff = time2Sec($z->[2]);
    if (numeric($d[$_month])) {
      my $m = $d[$_month]+1;
      if ( ($z->[3] < $z->[7] and $m > $z->[3] and $m < $z->[7]) or               # Monat liegt innerhalb
           ($z->[3] > $z->[7] and ($m > $z->[3] or $m < $z->[7])) ) { $DST = 1; } # des DST-Bereichs
      else {
        if ($d[$_wday]<0) {                                                       # Wochentag unbekannt -> ausrechnen! Dazu Wochentag auf UTC-Basis berechnen
          my @tmpd = @d;
          $tmpd[$_tzone] = 'UTC';
          $tmpd[$_hour] = 12;
          @tmpd = updateDate(@tmpd);
          $d[$_wday] = $tmpd[$_wday];
          $d[$_yday] = $tmpd[$_yday];
 #print "Wochentag $tmpd[$_mday].".($tmpd[$_month]+1).".$tmpd[$_year] = $tmpd[$_wday]<br>\n";
        }

        if ($m == $z->[3]) {                                                      # Monat = DST-Startmonat
 #print $d[$_mday]." / ".$d[$_wday]." / ".($d[$_mday]-$d[$_wday]+$z->[4]);
          my $i; my $x = $d[$_mday]-$d[$_wday]+$z->[4]; while ($x > 0) { $x -= 7; } $x += 7;
          my @xtag = (0,0,0,0,0,0); my $max = getMonthDays($d[$_month]+1, $d[$_year]);
          for ($i=1; $x<=$max; $i++) { $xtag[$i]=$x; $x+=7; }
          my $tag = $z->[5]; if ($tag < 0) { $tag+=$i; } $tag = $xtag[$tag];      # MTag der Umstellung
 #print("DST START: ".getDayName($z->[4]).", ".$tag.". ".getMonthName($z->[3])." - ".$z->[6]." Uhr ($max)<br>\n");
          if ($d[$_mday] > $tag) { $DST = 1; }
          else {
            if ($d[$_mday] == $tag) {
              $x = time2Sec($z->[6]);
              $i = $d[$_hour]*3600+$d[$_min]*60+$d[$_sec];
              if ($i >= $x) { $DST = 1; }
            }
          }
        }
        if ($m == $z->[7]) {                                                      # Monat = DST-Endmonat
          my $i; my $x = $d[$_mday]-$d[$_wday]+$z->[8]; while ($x > 0) { $x -= 7; } $x += 7;
          my @xtag = (0,0,0,0,0); my $max = getMonthDays($d[$_month]+1, $d[$_year]);
          for ($i=1; $x<=$max; $i++) { $xtag[$i]=$x; $x+=7; }
          my $tag = $z->[9]; if ($tag < 0) { $tag+=$i; } $tag = $xtag[$tag];      # MTag der Umstellung
 #print("DST END: ".getDayName($z->[8]).", ".$tag.". ".getMonthName($z->[7])." - ".$z->[10]." Uhr<br>\n");
          if ($d[$_mday] < $tag) { $DST = 1; }
          else {
            if ($d[$_mday] == $tag) {
              $x = time2Sec($z->[10]);
              $i = (1+$d[$_hour])*3600+$d[$_min]*60+$d[$_sec];                    # +1 Stunde weil DST-Ende sich auf DST-Zeit bezieht
              if ($i < $x) { $DST = 1; }
            }
          }
        }
      }
    }
    else {
      if ($debug) {
        print STDERR "ERROR: '$d[4]' is no valid month! (date::getDST)\n";
      }
    }
  }
  return ($diff, $DST);
}


sub getDate {
# 1. Parameter (optional): Zeitzone
# liefert das aktuelle Datum als Array

  my $timezone;
  if (defined $_[0]) {
	$timezone = uc($_[0])
  }
  return (long2Date( getTime(), $timezone));
}


sub getDayName {
# 1. Parameter: Tag (0-7, 0/7=Sonntag)
# liefert den Namen des Tages zurück
  my $l = $language;
  if (!exists $dname{$l}) { $l = 'en'; }
  return $dname{$l}->[$_[0]];
}


sub getDayNumber {
# 1. Parameter: Name des Tages
# liefert die Nummer des Tages (0-6, 0=Sonntag) zurück
  my $n=$_[0];
  if (length($n)>3 || getMonthNumber($n) eq '') {
    $n = quotemeta($n);
    for (my $i=0; $i<7; $i++) {
      if ( $dname_de[$i] =~ /^$n/i or
           $dname_en[$i] =~ /^$n/i or
           $dname_fr[$i] =~ /^$n/i or
           $dname_es[$i] =~ /^$n/i or
           $dname_nl[$i] =~ /^$n/i) { return ($i) }
    }
  }
  return '';
}


sub getMonthDays {
# 1. Parameter: Monat (1-12!)
# 2. Parameter: Jahr (4-stellig)
# liefert die Anzahl der Tage im Monat zurück
  my $m = $_[0];
  my $y = $_[1];
  my $d = 31;

  if (!numeric($m) && $debug) {
    print STDERR "ERROR: '$m' is no valid month! (date::getMonthDays)\n";
    return 0;
  }

  if ($m == 2) {
    if (isSwitchYear($y)) {
      $d = 29
    }
    else {
      $d = 28
    }
  }

  if (   $m ==  4
      || $m ==  6
      || $m ==  9
      || $m == 11
  ) {
    $d = 30;
  }

  return $d;
}


sub getMonthName {
# 1. Parameter: Monat (1-12!)
# liefert den Namen des Monats zurück
  my $l = $language;
  if (!exists $mname{$l}) { $l = 'en'; }
  return $mname{$l}->[$_[0]-1];
}


sub getMonthNumber {
# 1. Parameter: Name des Monats
# liefert die Nummer des Monats (1-12!) zurück
  my $n=$_[0];
  $n = quotemeta($n);
  for (my $i=0; $i<12; $i++) {
    if ( $mname_de[$i] =~ /^$n/i or
         $mname_en[$i] =~ /^$n/i or
         $mname_fr[$i] =~ /^$n/i or
         $mname_es[$i] =~ /^$n/i or
         $mname_nl[$i] =~ /^$n/i) { return (1+$i) }
  }
  return '';
}


sub getTime {
# liefert die aktuelle Zeit in Sekunden seit dem 1.1.1970
# Unbedingt anstelle von time() verwenden !!!!
  my $l = time();
  if ($l<0) { $l+=4294967296; }
  return $l;
}


sub getTimeDiff {
# 1. Parameter: Zeitzone
# liefert die Zeitdifferenz zu GMT in Sekunden für die Zeitzone zurück
  my $t = uc($_[0]);
  my $z = $tzone{$t};
  if (not $z) { print("Timezone '".$t."' not found !!!"); return 0;}
  return time2Sec($z->[2]);
}


sub getWeek {
# 1. Parameter: Date-Array
# liefert die Nummer der Woche im Jahr
  my @date = @_;
  my $jd = $date[7];
  my $wd = $date[6];
  if ($language ne 'en') {
    if (!$wd) { $wd = 7; } ## Amerikanisches -> Deutsches System
    $wd--;                 ## Montag ist der erste Wochentag
  }
  my $d = ($jd-$wd) % 7;
  my $w = int((7+$jd-$d) / 7);
  if ($d > 3) { $w++; }   # Mehrzahl der Tage liegt im neuen Jahr
  if ($w <= 0) {          # Wochennummer = letzte Woche des Vorjahres
    @date2 = @date;
    $date2[3]=31;
    $date2[4]=11;
    $date2[5]--;
    $date2[6]=6-$d;
    $date2[6]++;                            ## (Deutsches -> Amerikanisches System)
    if ($date2[6]==7) { $date2[6] = 0; }    ## (Sonntag ist der erste Wochentag)
    $date2[7]=getYearDays($date2[3], $date2[4], $date2[5]);
    $w = getWeek(@date2);
  }
  if ($date[4]==11 && $w >= 53) { # Dezember und Wochennummer >= 53: Ausnahmefall
    $d=$wd+32-$date[3];
    if ($d < 4) { $w = 1; }       # weniger als 4 Tage in dieser Woche, dann Woche 1 des naechsten Jahres
  }
  return $w;
}


sub getYearDays {
# 1. Parameter: Tag im Monat (1-31)
# 2. Parameter: Monat (0-11)
# 3. Parameter: Jahr (4-stellig)
# liefert die Nummer des Tages im Jahr (1-365/366!)
  my $d = $_[0];
  my $m = $_[1];
  my $y = $_[2];

  if (!numeric($m) && $debug) {
    print STDERR "ERROR: '$m' is no valid month! (date::getYearDays)\n";
    return 0;
  }

  my @days = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
  my $x = 0;
  my $yd = $d + $days[$m] - 1;

  # Papst Gregor XIII. korrigierte 1582 den fehlerhaften Julianischen Kalender, weil der sogenannte
  # astronomische Frühlingspunkt davonlief. Eine Reform war nötig. Die Wochentagsabfolge blieb
  # traditionell erhalten, aber er entschied: Auf Donnerstag, den 04.10.1582, folgt per Dekret
  # Freitag, der 15.10.1582 .
  if (   $y == 1582
      && ($m > 9 || ($m == 9 && $d > 4))
  ) {       # ($m = Monat-1)
    if ($m == 9 && $d < 15) {
      $d = 15;
    }

    $yd = $d + $days[$m] - 11;
  }

  if (isSwitchYear($y) && $m >= 2) {
    $yd++;
  }

  return $yd;
}


sub isSwitchYear {
# 1. Parameter: Jahr (4-stellig)
# liefert 1 wenn es ein Schaltjahr ist, sonst 0
  my $y=$_[0]; my $r=0;
  if (!$y) { return 0; }
  if ($y > 1582) {
    if ((not ($y%4) and ($y%100)) or not ($y%400)) { $r=1 }
  } elsif ($y > 0) {
    if (not ($y%4)) { $r=1 }
  } else {
    if (not (($y+1)%4)) { $r=1 }
  }
  return $r;
}


sub long2Date {
# 1. Parameter: Long-Sekunden
# 2. Parameter: Timezone (optional)
# Wandelt Long-Sekunden in ein Datums-Array um und ergänzt es um die Zeitzone, Long-Sekunden, Woche, etc.
# Sollte keine Zeitzone angegeben werden, wird GMT verwendet.
# Diese Funktion sollte unbedingt anstelle von gmtime()/localtime() verwendet werden!
# Da alle 28 Jahre die Jahre identisch sind (100er-Jahre nicht beachted s.u.) kann bei
# Werten die über dem "End Of Time" (19.01.2038 - 03:14:07 GMT) liegen der $long
# Wert vermindert und später als Jahre wieder addiert werden. (28 Jahre = 883612800 sec)
# Ähnliches gilt bei negativen $long (Jahre < 1970)
# Zusatz: alle 400 Jahre wiederholt sich ein 400-Jahre Block: 1600-1999, 2000-2399, etc.
# Berechnung von zukünftigen Jahren nun unbegrenzt möglich
# Neuer Gültigkeitsbereich long2Date Funktion: keine Beschränkung, gesichert ab 1.1.08 n. Chr (und noch weiter)
  my $long  = $_[0];
  my $tzone = $_[1] ? uc($_[1]) : $_timezone;

  my $orglong = $long;
  my $DST = 0;

  my $diff = getTimeDiff($tzone);

  $long += $diff;
  $long += 11676096000;  # 1.1.1600 = 0 Sekunden

  if ($long < 0) {       # < 1600
    # vor 1600: alle 4 Jahre ein Schaltjahr, 1582 folgte auf den 4.10 der 15.10
    if ($long < -50459673600) {                          # vor dem 01.01.-1:     -1 -> 1976
      $long += 50459673600 + (2557 * $_daysecs);
      $years -= 1977;
    }
    elsif ($long < -543196800) {                         # vor dem 15.10.1582: 1582 -> 1990
      $long += 543196800 + (7582 * $_daysecs);
      $years -= 408;
    }
    else {                                               # ab dem 15.10.1582
      $long += (730 * $_daysecs);
      $years -= 372;
    }
    while ($long < 0) {
      $years -= 28;
      $long += 883612800;
    }
  }
  else {
   # 400 Jahre Zyklus: 12622780800 Sekunden (1600-1999)
    $years=0;
    while ($long >= 12622780800) { $long -= 12622780800;                    $years += 400; }

    if    ($long >= 9498643200)  { $long -= 9498643200 -(5479 * $_daysecs); $years -= 84; }   # 1901 -> 1985
    elsif ($long >= 9467107200)  { $long -= 9467107200 -(1096 * $_daysecs); $years -= 73; }   # 1900 -> 1973
    elsif ($long >= 6342969600)  { $long -= 6342969600 -(4018 * $_daysecs); $years -= 180; }  # 1801 -> 1981
    elsif ($long >= 6311433600)  { $long -= 6311433600 -(1826 * $_daysecs); $years -= 175; }  # 1800 -> 1975
    elsif ($long >= 3187296000)  { $long -= 3187296000 -(2557 * $_daysecs); $years -= 276; }  # 1701 -> 1977
    elsif ($long >= 3155760000)  { $long -= 3155760000 - (365 * $_daysecs); $years -= 271; }  # 1700 -> 1971
    else {                         $long += (730*$_daysecs);                $years -= 372; }

    while ($long > 883612800)    { $long -= 883612800;                      $years += 28; }
  }

  my @date = gmtime($long);

  if ($date[$_year] < 1000) {
    $date[$_year] += 1900;
  }

  if ($orglong > -2177452800) {
    $DST = getDST(@date, $tzone);
    if ($DST > 0) {
      $long += 3600;
    }
    @date = gmtime($long);

    if ($date[$_year] < 1000) {
      $date[$_year] += 1900;
    }
  }

  $date[$_year]    += $years;
  $date[$_yday]     = getYearDays( $date[$_mday], $date[$_month], $date[$_year]);
  $date[$_dst]      = $DST;
  $date[$_tzone]    = $tzone;
  $date[$_longsecs] = $orglong;
  $date[$_fullyear] = 1;
  $date[$_week]     = getWeek(@date);
  $date[$_quartal]  = int($date[4]/3)+1;
  $date[$_weekyear] = $date[$_year];

  if (   $date[$_week]  == 1
      && $date[$_month] == 11
  ) {
    $date[$_weekyear]++;
  }

  if (   $date[$_week]  >= 52
      && $date[$_month] == 0
  ) {
    $date[$_weekyear]--;
  }

  #print "$date[3].".($date[4]+1).".$date[5] - $date[2]:$date[1]:$date[0] Uhr ($date[9], $date[8]) [$date[10]]<br>";
  return @date;
}


sub numeric { my( $a )=@_;
  if ($a =~ /\A\d+\Z/) { return 1; }
  return 0;
}


sub print {
# 1. Parameter: Message
# 2. Parameter: Date-Array
# Ersetzt Datums-/Zeitplatzhalter in einer Message durch die richtigen Werte aus dem Date-Array
# und zeigt die Message danach an
  print(convert(@_));
}


sub time2Sec {
# 1. Parameter: Zeit im 'hh:mm:ss' Format
# liefert die Zeit in Sekunden zurück
  my $sec = 0; $time = $_[0];
  if ($time =~ /\s*([-+])?(\d{1,2}):?(\d{1,2})?:?(\d{1,2})?/gi) {
    if (defined $4) { $sec += $4; };
    if (defined $3) { $sec += $3*60; };
    if (defined $2) { $sec += $2*3600; };
    if (defined $1 and $1 eq '-') { $sec *= -1; }
  }
  return $sec;
}


sub updateDate {
# Überprüft das Date-Array, korrigiert/setzt die Werte 'yday', 'DST', 'timezone', 'longsecs', 'fullyear', 'week', 'quartal'
# und wenn nötig auch 'day' und 'year'.
# 1. Parameter: Date-Array
  return long2Date(date2Long(@_),$_[9]);
}


package convert;
{
################# Initialisierung ##################
$use_encode = 0;
if ($] >= 5.008) {      # Wenn Perl 5.8 oder neuer, dann das Core-Modul "Encode" nutzen
  $use_encode = 1;
	eval ("use Encode;");
}

################# Variablen ##################
$_charmap = 'WE';           # WE = Western Europe | CE = Central Europe | CY = Cyrillic
$isomap = 'ISO-8859-1';     # ISO-8859-1 (WE)  | ISO-8859-2 (CE)  | WINDOWS-1251 (CY) -> setCharMap()
$codepage = 'cp1252';       #  wird durch setCharMap gesetzt, stellt die ZielCharMap für Encode zur Verfügung
$metatag = "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=$isomap\">";
$zero = chr(0);             # wird öfters benutzt
$bom_utf8 = chr(0xEF).chr(0xBB).chr(0xBF);
$bom_utf16le = chr(0xFF).chr(0xFE);
$bom_utf16be = chr(0xFE).chr(0xFF);

# Konstanten für die Funktion htmlspecialchars, ob Single- und/oder Double-Quotes für HTML kodiert werden
$ENT_NOQUOTES = 0;     # keine Quotes kodieren
$ENT_SGQUOTES = 1;     # nur Single-Quotes kodieren
$ENT_DBQUOTES = 2;     # nur Double-Quotes kodieren
$ENT_QUOTES   = 3;     # beide Quotes kodieren


# Tabelle für unicode -> wincode
%uni2win = (
  8364 => 128,  # Euro-Zeichen
  8218 => 130,  # Einfaches, gekrümmtes, wie die Ziffer Neun geformtes Anführungszeichen unten
  402  => 131,  # Kleines Schreibschrift-f mit Haken
  8222 => 132,  # Doppeltes, gekrümmtes, wie die Ziffer Neun geformtes Anführungszeichen unten
  8230 => 133,  # Waagerechtes Auslassungszeichen (Drei Punkte)
  8224 => 134,  # "Dolch", "Gestorben am ..."
  8225 => 135,  # "Doppel-Dolch", Doppelkreuz
  710  => 136,  # Zirkumflex-Akzent
  8240 => 137,  # Promille-Zeichen
  352  => 138,  # S mit Caron (Hatschek)
  8249 => 139,  # Einfaches, nach links weisendes, spitzwinkeliges Anführungszeichen
  338  => 140,  # Franz. OE-Ligatur
  381  => 142,  # Z mit Caron (Hatschek)
  8216 => 145,  # Linkes, einfaches Anführungszeichen (wie die Ziffer Sechs geformt)
  8217 => 146,  # Rechtes, einfaches Anführungszeichen (wie die Ziffer Neun geformt)
  8220 => 147,  # Rechtes, einfaches Anführungszeichen (wie die Ziffer Neun geformt)
  8221 => 148,  # Rechtes, doppeltes Anführungszeichen (wie die Ziffer Neun geformt)
  8226 => 149,  # Aufzählungspunkt, Thesenpunkt
  8211 => 150,  # Gedankenstrich der Breite des Buchstaben n
  8212 => 151,  # Gedankenstrich der Breite des Buchstaben m
  732  => 152,  # kleine Tilde (hochgestellt)
  8482 => 153,  # Trademark-Zeichen (geschütze Handelsmarke)
  353  => 154,  # s mit Caron (Hatschek)
  8250 => 155,  # Einfaches, nach rechts weisendes, spitzwinkliges Anführungszeichen
  339  => 156,  # Franz. oe-Ligatur
  382  => 158,  # z mit Caron (Hatschek)
  376  => 159,  # Großes Y mit Diaeresis (Trema)
  956  => 181,  # Micro-Zeichen; griech. Buchstabe "Mü" (Ersatz)
  181  => 181,  # Micro-Zeichen; griech. Buchstabe "Mü" (richtig)
);
%unicode = %uni2win;  # Kompatibilät zu alter Bezeichnung
%win2uni = ();
foreach $key (sort {$b<=>$a} keys %uni2win) {     # Wichtig: rückwärts durchgehen damit 181 -> 181 und nicht 956 wird
  $win2uni{$uni2win{$key}} = $key;
}

# Tabelle für decode_entity() - Allgemein
my %entity = (   '&nbsp;'  =>' ',
'&quot;'  =>'"', '&lt;'    =>'<', '&gt;'    =>'>', '&copy;'  =>'©', '&reg;'   =>'®', '&times;' =>'×',
'&divide;'=>'÷', '&euro;'  =>'€', '&iquest;'=>'¿', '&trade;' =>'™',

'&#34;'   =>'"', '&#60;'   =>'<', '&#62;'   =>'>', '&#169;'  =>'©',  '&#174;'  =>'®', '&#215;'  =>'×',
'&#247;'  =>'÷', '&#8364;' =>'€', '&#191;'  =>'¿', '&#8222;'  =>'„', '&#8221;' =>'“', '&#8220;' =>'“',
);


# Tabelle für decode_entity() - Westen Europe
my %entity_WE = (
'&Agrave;'=>'À', '&Aacute;'=>'Á', '&Acirc;' =>'Â', '&Atilde;'=>'Ã', '&Auml;'  =>'Ä', '&Aring;' =>'Å',
'&AElig;' =>'Æ', '&Ccedil;'=>'Ç', '&Egrave;'=>'È', '&Eacute;'=>'É', '&Ecirc;' =>'Ê', '&Euml;'  =>'Ë',
'&Igrave;'=>'Ì', '&Iacute;'=>'Í', '&Icirc;' =>'Î', '&Iuml;'  =>'Ï', '&ETH;'   =>'Ð', '&Ntilde;'=>'Ñ',
'&Ograve;'=>'Ò', '&Oacute;'=>'Ó', '&Ocirc;' =>'Ô', '&Otilde;'=>'Õ', '&Ouml;'  =>'Ö', '&Oslash;'=>'Ø',
'&Ugrave;'=>'Ù', '&Uacute;'=>'Ú', '&Ucirc;' =>'Û', '&Uuml;'  =>'Ü', '&Yacute;'=>'Ý', '&THORN;' =>'Þ',
'&szlig;' =>'ß',

'&agrave;'=>'à', '&aacute;'=>'á', '&acirc;' =>'â', '&atilde;'=>'ã', '&auml;'  =>'ä', '&aring;' =>'å',
'&aelig;' =>'æ', '&ccedil;'=>'ç', '&egrave;'=>'è', '&eacute;'=>'é', '&ecirc;' =>'ê', '&euml;'  =>'ë',
'&igrave;'=>'ì', '&iacute;'=>'í', '&icirc;' =>'î', '&iuml;'  =>'ï', '&eth;'   =>'ð', '&ntilde;'=>'ñ',
'&ograve;'=>'ò', '&oacute;'=>'ó', '&ocirc;' =>'ô', '&otilde;'=>'õ', '&ouml;'  =>'ö', '&oslash;'=>'ø',
'&ugrave;'=>'ù', '&uacute;'=>'ú', '&ucirc;' =>'û', '&uuml;'  =>'ü', '&yacute;'=>'ý', '&thorn;' =>'þ',
'&yuml;'  =>'ÿ',

'&#192;'=>'À', '&#193;'=>'Á', '&#194;'=>'Â', '&#195;'=>'Ã', '&#196;'=>'Ä', '&#197;'=>'Å',
'&#198;'=>'Æ', '&#199;'=>'Ç', '&#200;'=>'È', '&#201;'=>'É', '&#202;'=>'Ê', '&#203;'=>'Ë',
'&#204;'=>'Ì', '&#205;'=>'Í', '&#206;'=>'Î', '&#207;'=>'Ï', '&#208;'=>'Ð', '&#209;'=>'Ñ',
'&#210;'=>'Ò', '&#211;'=>'Ó', '&#212;'=>'Ô', '&#213;'=>'Õ', '&#214;'=>'Ö', '&#216;'=>'Ø',
'&#217;'=>'Ù', '&#218;'=>'Ú', '&#219;'=>'Û', '&#220;'=>'Ü', '&#221;'=>'Ý', '&#222;'=>'Þ',
'&#223;'=>'ß',
'&#338;'=>'Œ', '&#352;'=>'Š', '&#381;'=>'Ž', '&#376;'=>'Ÿ',

'&#224;'=>'à', '&#225;'=>'á', '&#226;'=>'â', '&#227;'=>'ã', '&#228;'=>'ä', '&#229;'=>'å',
'&#230;'=>'æ', '&#231;'=>'ç', '&#232;'=>'è', '&#233;'=>'é', '&#234;'=>'ê', '&#235;'=>'ë',
'&#236;'=>'ì', '&#237;'=>'í', '&#238;'=>'î', '&#239;'=>'ï', '&#240;'=>'ð', '&#241;'=>'ñ',
'&#242;'=>'ò', '&#243;'=>'ó', '&#244;'=>'ô', '&#245;'=>'õ', '&#246;'=>'ö', '&#248;'=>'ø',
'&#249;'=>'ù', '&#250;'=>'ú', '&#251;'=>'û', '&#252;'=>'ü', '&#253;'=>'ý', '&#254;'=>'þ',
'&#255;'=>'ÿ',
'&#339;'=>'œ', '&#353;'=>'š', '&#382;'=>'ž', '&#65533' => '-',
);


# Tabelle für decode_entity() - Central Europe
my %entity_CE = (
'&Aacute;'=>'Á', '&Acirc;' =>'Â', '&Auml;'  =>'Ä',
'&Ccedil;'=>'Ç', '&Eacute;'=>'É', '&Euml;'  =>'Ë',
'&Iacute;'=>'Í', '&Icirc;' =>'Î', '&ETH;'   =>'Ð',
'&Oacute;'=>'Ó', '&Ocirc;' =>'Ô', '&Ouml;'  =>'Ö',
'&Uacute;'=>'Ú', '&Uuml;'  =>'Ü', '&Yacute;'=>'Ý',
'&szlig;' =>'ß',

'&aacute;'=>'á', '&acirc;' =>'â', '&auml;'  =>'ä',
'&ccedil;'=>'ç', '&eacute;'=>'é', '&euml;'  =>'ë',
'&iacute;'=>'í', '&icirc;' =>'î', '&eth;'   =>'ð',
'&oacute;'=>'ó', '&ocirc;' =>'ô', '&ouml;'  =>'ö',
'&uacute;'=>'ú', '&uuml;'  =>'ü', '&yacute;'=>'ý',

'&#340;'=>'À', '&#193;'=>'Á', '&#194;'=>'Â', '&#258;'=>'Ã', '&#196;'=>'Ä', '&#313;'=>'Å',
'&#262;'=>'Æ', '&#199;'=>'Ç', '&#268;'=>'È', '&#201;'=>'É', '&#280;'=>'Ê', '&#203;'=>'Ë',
'&#282;'=>'Ì', '&#205;'=>'Í', '&#206;'=>'Î', '&#270;'=>'Ï', '&#208;'=>'Ð', '&#323;'=>'Ñ',
'&#327;'=>'Ò', '&#211;'=>'Ó', '&#212;'=>'Ô', '&#336;'=>'Õ', '&#214;'=>'Ö', '&#344;'=>'Ø',
'&#366;'=>'Ù', '&#218;'=>'Ú', '&#368;'=>'Û', '&#220;'=>'Ü', '&#221;'=>'Ý', '&#354;'=>'Þ',
'&#223;'=>'ß',
'&#260;'=>'¥', '&#321;'=>'£', '&#317;'=>'¼', '&#352;'=>'Š', '&#346;'=>'Œ', '&#350;'=>'ª',
'&#356;'=>'', '&#381;'=>'Ž', '&#377;'=>'', '&#379;'=>'¯',

'&#341;'=>'à', '&#225;'=>'á', '&#226;'=>'â', '&#259;'=>'ã', '&#228;'=>'ä', '&#314;'=>'å',
'&#263;'=>'æ', '&#231;'=>'ç', '&#269;'=>'è', '&#233;'=>'é', '&#281;'=>'ê', '&#235;'=>'ë',
'&#283;'=>'ì', '&#237;'=>'í', '&#238;'=>'î', '&#271;'=>'ï', '&#240;'=>'ð', '&#324;'=>'ñ',
'&#328;'=>'ò', '&#243;'=>'ó', '&#244;'=>'ô', '&#337;'=>'õ', '&#246;'=>'ö', '&#345;'=>'ø',
'&#367;'=>'ù', '&#250;'=>'ú', '&#369;'=>'û', '&#252;'=>'ü', '&#253;'=>'ý', '&#355;'=>'þ',
'&#729;'=>'ÿ',
'&#261;'=>'¹', '&#322;'=>'³', '&#318;'=>'¾', '&#353;'=>'š', '&#347;'=>'œ', '&#351;'=>'º',
'&#357;'=>'', '&#382;'=>'ž', '&#378;'=>'Ÿ', '&#380;'=>'¿', '&#65533' => '-',
);


# Tabelle für encode_entity() - Allgemein
my %char =   (
'<'=>'&lt;',     '>'=>'&gt;',     '©'=>'&copy;',   '®'=>'&reg;',   '×'=>'&times;',  '÷'=>'&divide;',
'”'=>'"',        '–'=>'-',        '¿'=>'&iquest;', '€'=>'&#8364;', '„'=>'&#8222;',  '“' => '&#8221;',
'“'=>'&#8220;',  '™'=>'&trade;',
);

# Tabelle für encode_entity() - Western Europe
my %char_WE = (
'À'=>'&Agrave;', 'Á'=>'&Aacute;', 'Â'=>'&Acirc;',  'Ã'=>'&Atilde;', 'Ä'=>'&Auml;',   'Å'=>'&Aring;',
'Æ'=>'&AElig;',  'Ç'=>'&Ccedil;', 'È'=>'&Egrave;', 'É'=>'&Eacute;', 'Ê'=>'&Ecirc;',  'Ë'=>'&Euml;',
'Ì'=>'&Igrave;', 'Í'=>'&Iacute;', 'Î'=>'&Icirc;',  'Ï'=>'&Iuml;',   'Ð'=>'&ETH;',    'Ñ'=>'&Ntilde;',
'Ò'=>'&Ograve;', 'Ó'=>'&Oacute;', 'Ô'=>'&Ocirc;',  'Õ'=>'&Otilde;', 'Ö'=>'&Ouml;',   'Ø'=>'&Oslash;',
'Ù'=>'&Ugrave;', 'Ú'=>'&Uacute;', 'Û'=>'&Ucirc;',  'Ü'=>'&Uuml;',   'Ý'=>'&Yacute;', 'Þ'=>'&THORN;',
'ß'=>'&szlig;',
'Œ'=>'&#338;',   'Š'=>'&#352;',   'Ž'=>'&#381;',   'Ÿ'=>'&#376;',

'à'=>'&agrave;', 'á'=>'&aacute;', 'â'=>'&acirc;',  'ã'=>'&atilde;', 'ä'=>'&auml;',   'å'=>'&aring;',
'æ'=>'&aelig;',  'ç'=>'&ccedil;', 'è'=>'&egrave;', 'é'=>'&eacute;', 'ê'=>'&ecirc;',  'ë'=>'&euml;',
'ì'=>'&igrave;', 'í'=>'&iacute;', 'î'=>'&icirc;',  'ï'=>'&iuml;',   'ð'=>'&eth;',    'ñ'=>'&ntilde;',
'ò'=>'&ograve;', 'ó'=>'&oacute;', 'ô'=>'&ocirc;',  'õ'=>'&otilde;', 'ö'=>'&ouml;',   'ø'=>'&oslash;',
'ù'=>'&ugrave;', 'ú'=>'&uacute;', 'û'=>'&ucirc;',  'ü'=>'&uuml;',   'ý'=>'&yacute;', 'þ'=>'&thorn;',
'ÿ'=>'&yuml;',
'œ'=>'&#339;',   'š'=>'&#353;',   'ž'=>'&#382;',
);

# Tabelle für encode_entity() - Central Europe
my %char_CE = (
'À'=>'&#340;',   'Á'=>'&Aacute;', 'Â'=>'&Acirc;',  'Ã'=>'&#258;',   'Ä'=>'&Auml;',   'Å'=>'&#313;',
'Æ'=>'&#262;',   'Ç'=>'&Ccedil;', 'È'=>'&#268;',   'É'=>'&Eacute;', 'Ê'=>'&#280;',   'Ë'=>'&Euml;',
'Ì'=>'&#282;',   'Í'=>'&Iacute;', 'Î'=>'&Icirc;',  'Ï'=>'&#270;',   'Ð'=>'&ETH;',    'Ñ'=>'&#323;',
'Ò'=>'&#327;',   'Ó'=>'&Oacute;', 'Ô'=>'&Ocirc;',  'Õ'=>'&#336;',   'Ö'=>'&Ouml;',   'Ø'=>'&#344;',
'Ù'=>'&#366;',   'Ú'=>'&Uacute;', 'Û'=>'&#368;',   'Ü'=>'&Uuml;',   'Ý'=>'&Yacute;', 'Þ'=>'&#354;',
'ß'=>'&szlig;',
'¥'=>'&#260;',   '£'=>'&#321;',   '¼'=>'&#317;',   'Š'=>'&#352;',   'Œ'=>'&#346;',   'ª'=>'&#350;',
''=>'&#356;',   'Ž'=>'&#381;',   ''=>'&#377;',   '¯'=>'&#379;',

'à'=>'&#341;',   'á'=>'&aacute;', 'â'=>'&acirc;',  'ã'=>'&#259;',   'ä'=>'&auml;',   'å'=>'&#314;',
'æ'=>'&#263;',   'ç'=>'&ccedil;', 'è'=>'&#269;',   'é'=>'&eacute;', 'ê'=>'&#281;',   'ë'=>'&euml;',
'ì'=>'&#283;',   'í'=>'&iacute;', 'î'=>'&icirc;',  'ï'=>'&#271;',   'ð'=>'&eth;',    'ñ'=>'&#324;',
'ò'=>'&#328;',   'ó'=>'&oacute;', 'ô'=>'&ocirc;',  'õ'=>'&#337;',   'ö'=>'&ouml;',   'ø'=>'&#345;',
'ù'=>'&#367;',   'ú'=>'&uacute;', 'û'=>'&#369;',   'ü'=>'&uuml;',   'ý'=>'&yacute;', 'þ'=>'&#355;',
'ÿ'=>'&#729;',
'¹'=>'&#261;',   '³'=>'&#322;',   '¾'=>'&#318;',   'š'=>'&#353;',   'œ'=>'&#347;',   'º'=>'&#351;',
''=>'&#357;',   'ž'=>'&#382;',   'Ÿ'=>'&#378;',   '¿'=>'&#380;',
);



################# Funktionen ##################















sub changeQuotes { my ($text) = @_;
  $text = '' unless defined $text;
  $text =~ s/"/&quot;/g;
  return $text;
}


sub decode_entity { my ($text, $chars, $charmap) = @_;
  if (!defined $charmap || ($charmap ne 'WE' && $charmap ne 'CE')) {
	  $charmap = $_charmap;  # Wenn keine (gültige) CharMap angegeben, die Default-Charmap von setCharMap() nehmen
	}
  $text =~ s/&#(\d+);?/$1<=255 ? chr($1) : '&#'.$1.';'/eg;
  if ($charmap eq 'WE') { $text =~ s/(&.*?;)/$entity_WE{$1}?$entity_WE{$1}:$1/eg; }
  if ($charmap eq 'CE') { $text =~ s/(&.*?;)/$entity_CE{$1}?$entity_CE{$1}:$1/eg; }
  if (!$chars) { $text =~ s/(&.*?;)/$entity{$1}?$entity{$1}:$1/eg; }
  return $text;
}


sub encode_entity { my ($text, $chars, $charmap) = @_;
  if (!defined $charmap || ($charmap ne 'WE' && $charmap ne 'CE')) {
	  $charmap = $_charmap;  # Wenn keine (gültige)  CharMap angegeben, die Default-Charmap von setCharMap() nehmen
	}
  if ($charmap eq 'WE') { $text =~ s/(.)/$char_WE{$1}?$char_WE{$1}:$1/eg; }
  if ($charmap eq 'CE') { $text =~ s/(.)/$char_CE{$1}?$char_CE{$1}:$1/eg; }
  if (!$chars) { $text =~ s/(.)/$char{$1}?$char{$1}:$1/eg; }
  return $text;
}


sub setCharMap { # CharMap ID (WE, CE)
  my( $id )=@_; $id = convert::uc($id);
  if ($id eq 'WE') {
  	$_charmap = $id;
		$isomap = 'ISO-8859-1';
		$codepage = 'cp1252';
	}
  elsif ($id eq 'CE') {
		$_charmap = $id;
		$isomap = 'ISO-8859-2';
		$codepage = 'cp1250';
	}
  elsif ($id eq 'CY') {
		$_charmap = $id;
		$isomap = 'WINDOWS-1251';
		$codepage = 'cp1251';
	}
  $metatag = "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=$isomap\">";
}


sub uc { # $text => $text, upper case, Umlaute werden beachtet
  my $text = CORE::uc shift @_;
  if ($_charmap eq 'WE') { $text =~ tr/[àáâãäåæçèéêëìíîïðñòóôõöøœùúûüþšýÿž]/[ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØŒÙÚÛÜÞŠÝŸŽ]/; }
  if ($_charmap eq 'CE') { $text =~ tr/[àáâãäåæçèéêëìíîïðñòóôõöøœùúûüþšýž¹³¾ºŸ¿]/[ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØŒÙÚÛÜÞŠÝŽ¥£¼ª¯]/; }
  if ($_charmap eq 'CY') { $text =~ tr/[àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿƒšœžŸ¢¼´¸º¿³¾]/[ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß€ŠŒŽ¡£¥¨ª¯²½]/; }
  return $text;
}


sub utf82win { my ($utf8) = @_;
  my $uni = '';
  if ($use_encode) {       # Core-Modul Encode ab Perl 5.8 benutzen
	  #print "ENCODE UTF8->WIN\n";
		$uni = $utf8;
		Encode::from_to($uni, "UTF-8", $codepage);
	}
	else {
	  #print "TRILOBIT UTF8->WIN\n";
	  my $char128 = chr(128);
	  my $char255 = chr(255);
	  my $multi_2bytes = 64;
	  my $multi_3bytes = 64 * 64;
	  my $multi_4bytes = 64 * 64 * 64;
	  my $special_2bytes = 128+64;
	  my $special_3bytes = 128+64+32;
	  my $special_4bytes = 128+64+32+16;
	  my $special_5bytes = 128+64+32+16+8;
	  my $win = '';

	  while ($utf8 =~ s/\A(.*?)([$char128-$char255])(.)//s) {
	    my $value = $1;
	    my $special = ord $2;
	    my $special2 = ord $3;
	    $win .= $value;
	    if ($special < $special_3bytes) {                        # 2 Bytes: 110xxxxx 10xxxxxx (128-2047)
	      my $value = ($special - $special_2bytes) * $multi_2bytes
	                + ($special2 - 128);
	      if ($value <= 255) {
	        $win .= chr($value);
	      }
	      elsif ($uni2win{$value}) {
	        $win .= chr($uni2win{$value});
	      }
	      else {
	        $win .= '?';
	      }
	    }
	    elsif ($special < $special_4bytes) {                     # 3 Bytes: 1110xxxx 10xxxxxx 10xxxxxx (2048-65535)
	      $utf8 =~ s/\A(.)//;
	      my $special3 = ord($1);
	      my $value = ($special - $special_3bytes) * $multi_3bytes
	                + ($special2 - 128) * $multi_2bytes
	                + ($special3 - 128);
	      if ($uni2win{$value}) {
	        $win .= chr($uni2win{$value});
	      }
	      else {
	        $win .= '?';
	      }
	    }
	    elsif ($special < $special_5bytes) {                     # 4 Bytes: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx (65536-2097151, nicht konvertierbar)
	      $utf8 =~ s/\A(.)(.)//;
	      $win .= '?';
	    }
	    else {                                                   # 5 Bytes: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx (2097152-67108863, nicht konvertierbar)
	      $utf8 =~ s/\A(.)(.)(.)//;
	      $win .= '?';
	    }
	  }
    $uni = $win.$utf8;
	}
	return $uni;
}


}
package form;
{

no warnings;

init();
1;

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
























sub Alert {my ($alt, $depend)=@_;    # STRING: alternative Msg, BOOL: Depending  (hat nichts mit Alert zu tun, setzt nur die ErrMsg, heißt aber wie im Javascript um die beiden einfacher pflegen zu können.)
  my $o=$obj; my $x;
  $m = cleanStr($msg);
  $objn = $name;
  if (!$m && $m ne '#') {
    $O = "date_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "name_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "time_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "email_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "emails_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "phone_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "number_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "url_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $O = "need_$objn"; if (defined ${"main::$O"} && !$msg) { CF_Get() }
    $m = $msg;
  }
  # 'warn' wird nicht berücksichtigt, da auf CGI-Ebene ohne Sinn.
  if (!$m) { $m = $alt; }
  if ($depend) { $depend = Depend() } else { $depend = 1 }
#print("\n\n$depend<br>");
  if ($depend && $m ne '#') {
    if (scalar @val) {
      for (my $i=1; $i<=scalar @val; $i++) {
        if ($val[$i] ne '') { $x = cleanStr($val[$i]); $m =~ s/\%$i/$x/g; }
      }
    }
    $m =~ s/\r//g;
    $m =~ s/\\n/<br>\n/ig; $check = 0;
    $m =~ s/%INPUT/$input/g;
    $m=prepareMsg($m);
    $errmsg = $m;
  }
}


sub CF_Get { my( $_multi_ )=@_;
  my $a; $conv=0; $O =~ /(.+?)_(.+)/; $field=$name=$2; my $E; my $c;
  if (get("date_$field")) { $conv=1 }
  if (get("time_$field")) { $conv=2 }
  if (get("number_$field")) { $conv=3 }
  my $val = cleanStr(get($O,$_multi_)); $val =~ s/\|+/|/g;
  if ($val eq '-') { $val =''; }
  @val = split('\|', $val); $msg=$val[0]; if ($val[1]) { $dep=$val[1] }
  for (my $i=1; $i<=$#val; $i++) {
    $val[$i]=cleanStr($val[$i]);
    $c = charAt($val[$i],0);
    if ($c eq '%') { $val[$i] = resolve($val[$i]) }
    else {
      if ($c eq '$') {
        my $f=substr($val[$i],1,100);
        if (!referer($f,$i)) {
          print('Error: field '.$val[$i].' not found');
        }
        if ($O =~ /depend_/) {
          $conv=0;
          if (get("date_$f")) { $conv=1 }
          if (get("time_$f")) { $conv=2 }
          if (get("number_$f")) { $conv=3 }
        }
      }
      else {
        $a=0;
        if ($i==1 && $O =~ /depend_/) { $a=referer($val[$i],$i) }
        #if (!$a && $conv) { $a=referer($val[$i],$i) }   <- Wegen Depend-Problemen raus. Sinn der Zeile ?
        if (!$a) { $val[$i]=convertValue($val[$i]) }
      }
    }
  }
  return ($obj = $field);
}


sub Depend {
  my @X = @val; #print "$name: @val ".scalar(@val);
  my $objname = $name;
  $O = "need_$objname";
  my $a = 0;
  if (get($O) && CF_Get()) { $a=allowed(1); }
  if ($a) { $value = ''; }
  $O = "depend_$objname"; if (not get($O)) { return 1 }
  if (!CF_Get()) { return 0 }
  my @d = @val; @val = @X;
  if (charAt($dep,0) eq '$') { $dep=substr($dep,1,100) }
  my $v=''; my $b = 0; my $i = 0;
  my $X=$obj; $obj=$dep;
  if ($obj) {
    my $y=0;
    my $t=uc(getGroupValue($y++));
    do {
      $v=$t;
      for ($i=2; $d[$i] && !$b; $i++) {
        if ($v eq uc($d[$i])) { $b=1 }
      }
      $t=uc(getValue($y++));
    } while (!$b && $t);
  }
  $obj=$X;
#print("\n\n> $m / $b / $i / $v<br>");
  if ($i==2 && $v) { $b = 1; }
  if ($b) { return $m; }
#print("$value<br>\n");
  if (!$value) { $check = 1; return 0; }
  $m = cleanStr($d[0]);
  if (!$m) { $m = "No input necessary"; }
  return 1;
}


sub _swap {
  my $x=$_[0]; my $s=$x;
  if (charAt($x,0) eq '<') {
    $s='<'; my $l=length($x);
    for (my $i=1; $i<$l; $i++) { $s=$s.('9'-charAt($x,$i)) }
  }
  return $s;
}


sub allowed {
  my $a=0; my $v=uc($value);
  for (my $i=$_[0]; $i<=$#val && !$a; $i++) {
    $f=uc($val[$i]);
    if ($v eq uc($val[$i])) { $a=1 }
  } return $a;
}


sub charAt {
  return substr($_[0],$_[1],1);
}


sub checkChars {
  if (!CF_Get()) { return }
  $input=$value=cleanStr(get($obj));
  setValue();
  if ($value eq '') { return }
  my $a=allowed(1);
  if ($a || contains($value,'0123456789?!$#+&:\\*"@§\^°µ\|;<>()\/_\[\]{}\'´`\%²³€~,.-')) {
    Alert('Please enter a valid name.'); }
}


sub checkDate {
  my $s=getDays(1,1,1900); my $e=getDays(31,12,2100);
  if (!$shortyear) { $s=getDays(1,1,-9999); $e=getDays(31,12,9999); }
  if (!CF_Get()) { return }
  $input=$value=get($obj); if (!$value) { return }
  if ($val[1]) { readDate($val[1]); $s=getDays($day,$mon,$year); }
  if ($val[2]) { readDate($val[2]); $e=getDays($day,$mon,$year); }
  readDate($value);
  $value=formatText('DATE');
  setValue();
  my $d=getDays($day,$mon,$year);
  #print "\n\nDays: $s / $d / $e<br>\n";
  my $a=allowed(3);
  if (!$day || !$mon) { $a=1 }
  if ($s>$e) { set($obj,''); $check=0; return; }
  if ($a || $d<$s || $d>$e || $year==0) {
    $msg=formatText('DATE',$msg);
    Alert($value+' is not valid.\nPlease enter a valid date.');
  }
}


sub checkEmail {my( $me )=@_;
  if (!CF_Get()) { return; }
  $value = get($obj); $value =~ s/\s+|\r+|\n+|, /,/g;
  $value =~ s/,+/, /g;
  setValue();
  if ($value eq '') { return }
  my $a=allowed(1);
  my $ea = ();
  if ($me) { @ea = split(', ', $value); } else { $ea[0] = $value; }
  for ($ec=0; $ec<scalar(@ea); $ec++) { if (!$a) {
    $input = $ea[$ec];
    if (contains($input,'!"#$%&\'()*+,/:;<=>?[\\]^`{|}~„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦¨§©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿€‚ƒ„')) { $a='true'; }
    my @e=split('@',$input); my $le=$#e+1;
    my @n=split('\.',$e[0]); my $ln=$#n+1;
    my @p=split('\.',$e[$le-1]); my $lp=$#p+1;
    if ($a || $le!=2 || $lp<2 || length($p[0])<1 || $lp>1 && (length($p[1])<1 ||
        length($p[$lp-2])<1 || length($p[$lp-1])<2 || length($p[$lp-1])>6) ||
        length($e[0])<1 || length($n[0])<1 || $ln>1 && (length($n[$ln-1])<1)) {
      Alert("'%INPUT' is not a valid email address.");
      $a='true';
    }
  }}
}


sub checkForm {
  ## 0 -> Form nicht ok
  ## 1 -> Form ok
  my $v;
  $errmsg = '';
  my $n=''; $check = 1; # CF_SetForm(form); ... überflüssig in Perl
  init();
  for (my $i=0; $i<scalar(@parameter::parameters) && $check; $i++) {
    $O = $parameter::parameters[$i];
    if ($O =~ /([^_]{2,})_(.+)/) {
      $n=$O;
      $typ=$1;
      $cvar=$2;
      if ($typ eq 'need' ||
          $typ eq 'minlength' ||
          $typ eq 'date' ||
          $typ eq 'time' ||
          $typ eq 'name' ||
          $typ eq 'email' ||
          $typ eq 'emails' ||
          $typ eq 'phone' ||
          $typ eq 'chars' ||
          $typ eq 'number' ||
          $typ eq 'convert' ||
          $typ eq 'blz' ||
          $typ eq 'url') {
        substr ($typ,0,1)=uc substr $typ,0,1;
        if ($typ eq 'Emails') { &{"checkEmail"}(1); }
        elsif ($typ ne 'Convert') { &{"check$typ"}(); }  ## WICHTIG! für parser2 alle Funktionen hier ausschreiben: checkNeed(, checkMinlength(, checkDate(, checkTime(, checkName(, checkEmail(, checkPhone(, checkChars(, checkNumber(, checkUrl(,
        elsif ($check) { convertInput(); }
        else { return 0; }
      }
    }
  }
  if ($check && defined $main::_form_usercheck) {
    my $package='';
    if ($main::_form_usercheck !~ /::/) {
      $package='main::';
    }
    $check = eval "$package$main::_form_usercheck();";
  }
  return $check;
}


sub checkMinlength {
  if (!CF_Get()) { return }
  $input=$value=cleanStr(get($obj));
  set($obj,$value);
  if ($value eq '') { return }
  my $a=allowed(1);
  if (!$val[1]) { $val[1] = 1; }
  if (length($value)<$val[1]) { Alert('Please enter at least '.$val[1].' chars.'); }
}


sub checkName {
  if (!CF_Get()) { return }
  $input=$value=cleanStr(get($obj));
  setValue();
  if ($value eq '') { return }
  my $a=allowed(1);
  my @n=split(' ',$value); my $l=$#n+1;
  if ($a || $l<2 || length($n[0])<2 || $l>1 && (length($n[1])<2 || length($n[$l-1])<2
      || contains($value,'0123456789?!$#+&:\\*"@§\^°µ\|;<>()\/_\[\]{}\'´`\%²³€~'))) {
    Alert('Please enter a valid name.'); }
}


sub checkNeed {
  if (!CF_Get()) { return; }
  ##$input = get($obj);
  my $i=0; my $a;
  my $input = $v = $value = getGroupValue($i++);
# print "\n\nVALUE $obj ($i): $v<br>\n";
  my $xxx = 0;
  do {
# print "OBJ: $obj / $i: $v ($xxx)<br>\n";
    if (!isGroup($obj)) { setValue($i-1); }
    $a=allowed(1);
    if ($v eq '' || $a) {
      Alert ('Please enter something',1);
      # no warn...
    } else {
      $msg='#';
      Alert('#',1);
    }
    $v = $value = getValue($i++);
  } while ($check && $v && $xxx++ < 1000);
}


sub checkNumber {
  if (!CF_Get()) { return }
  $input=$value=cleanStr(get($obj));
  if ($value eq '') { return }
  my $x0=''; if ($val[1]) { $x0=_swap(getNum($val[1])) }
  my $x1=''; if ($val[2]) { $x1=_swap(getNum($val[2])) }
  if ($x0>$x1) { $x=$x0; $x0=$x1; $x1=$x }
  $num=getNum($value);
  $value=formatText('NUMBER');
  $num=_swap(getNum($value));
  setValue();
  my $a=allowed(3);
  if ($num eq '' || $a || ($x0 ne '' && $num lt $x0) || ($x1 ne '' && $num gt $x1)) {
    Alert('Please enter a valid number.'); }
}


sub checkPhone {
  my $a; my $s=''; my $c; my $x; my $l; my $country=''; my $number='';
  if (!CF_Get()) { return }
  $input=$value=cleanStr(get($obj));
  setValue();
  if ($value eq '') { return }
  if (!consists($value,'0123456789 _/-()+')) { $a=1; }
  else {
    $x=1; $l=length($value);
    $c=charAt($value,0);
    if (substr($value,0,2) eq '00' || $c eq '+') {
      while ($x<=$l && ($c eq '0' || $c eq '+')) { $c=charAt($value, $x++); }
      while ($x<=$l && index('0123456789',$c)!=-1) {
        $country.=$c;
        $c=charAt($value, $x++);
      }
    }
    while ($x<=$l && index('0123456789',$c)==-1) { $c=charAt($value, $x++); }
    while ($x<=$l && index('0123456789 _/-()',$c)!=-1) {
      $number.=$c;
      $c=charAt($value,$x++);
    }
    if ($country) { $country='+'.$country; }
    if ($country && $number) { $s=' / '; }
    $tel_country=$country;
    $tel_number=$number;
    $value=$country.$s.$number;
    setValue();
    $a=allowed(1);
  }
  if ($a || !$value) { Alert('Please enter a valid phone number.'); }
}


sub checkTime {
  my $s='000000'; my $e='235959';
  if (!CF_Get()) { return }
  $input=$value=get($obj); if (!$value) { return }
  if ($val[1]) { readTime($val[1]); $s=formatText('TIME','%hh%mm%ss'); }
  if ($val[2]) { readTime($val[2]); $e=formatText('TIME','%hh%mm%ss'); }
  if ($e eq '000000') { $e='235959' }
  readTime($value);
  $value=formatText('TIME');
  setValue();
  my $t=formatText('TIME','%hh%mm%ss');
  my $a=allowed(3);
  if ($min eq '' || $sec eq '') { $a=1 }
  if ($s>$e) { set($obj,''); $check=0; return; }
  if ($a || $t<$s || $t>$e) {
    $msg=formatText('TIME',$msg);
    Alert($value+' is not valid.\nPlease enter a valid time.');
  }
}


sub checkUrl {
  if (!CF_Get()) { return }
  $input=$value=noSpaces(get($obj));
  $value =~ s/http\:\/\/|https\:\/\///ig;
  set($obj,$value);
  if ($value eq '') { return }
  my $a=allowed(1);
  if (contains($value,',\'´`\\*"@§\^°µ\|;<>()\[\]{}')) { $a=1 }
  if ($value =~ /ftp\:/) { $a=1 }
  my @url=split('\/',$value); @url=split('\.',$url[0]); my $l=$#url+1;
  if ($a || $l<2 || length($url[0])<2 || $l>1 && (length($url[1])<2 ||
      length($url[$l-2])<1 || length($url[$l-1])<2 || length($url[$l-1])>6)) {
    Alert('Please enter a valid URL.'); }
}


sub cleanStr { my ($S) = @_;
  if (!defined $form::utf8) {
    $S =~ s/\xA0/ /g;
  }
  $S =~ s/\r//g;
  $S =~ s/\A\s*//g;
  $S =~ s/\s*\Z//g;
  $S =~ s/ +/ /g;
  return $S;
}


sub consists {
  my $text=$_[0]; my $test=quotemeta($_[1]);
  $text =~ s/[$test]//g;
  return !$text;
}


sub contains {
  my $text=$_[0]; my $test=quotemeta($_[1]);
  if ( $text =~ /([$test])/ ) { return 1 }
  return 0;
}


sub convertInput {
  my $dest;
  for (my $_multi_=0; get($O,$_multi_); $_multi_++) {
    if (CF_Get($_multi_)) {
      $dest=$val[0];
      $dest=~ s/\A\$//;
      if ($dest) {
        if (!$val[1]) { $val[1]='%YYYY%MM%DD' }
        readDate(get($name));
        set($dest,formatText('DATE',$val[1]));
      }
    }
    #print("CONVERT: $name (".get($O,$_multi_).") -> $dest (".get($dest).")<br>\n");
  }
}


sub convertValue {
  my $v=''.$_[0];
#print "convertValue($v, $conv)<br>\n";
  if ($conv == 1) { readDate($v); $v=formatText('DATE'); }
  if ($conv == 2) { readTime($v); $v=formatText('TIME'); }
  if ($conv == 3) { $num=getNum($v); $v=formatText('NUMBER'); }
  return $v;
}


sub formatText {
  my $type=$_[0]; my $text=$_[1];
  my $n; my $i; my $format='';
  if ($O && defined ${"main::$O"}) {
    if ( $O =~ /(.+?)_(.+)/ ) { $n=$2 } else { $n=$O }
    my $ff="format_$n"; if (get($ff)) { $format=get($ff) }
  }
  if ($format eq '') {
    if ($type eq 'DATE') { $format='%DD-%MMM-%YYYY' }
    if ($type eq 'TIME') { $format='%hh:%mm:%ss' }
    if ($type eq 'NUMBER') { $format='%99' }
  }

  if (!defined $text || $text eq '') { $text=$format }
  if ($text eq '') { return '' }

  $text =~ s/\%FORMAT/$format/g;
  $text =~ s/\%INPUT/$input/g;

  if ($type eq 'DATE') {
    if ($day && $mon) {
      if ($form_date[3] != $day || $form_date[4] != $mon-1) {
        @form_date = date::long2Date(time());
        $form_date[3] = $day;
        $form_date[4] = $mon-1;
        $form_date[5] = $year;
        @form_date = date::long2Date(date::date2Long(@form_date));
        $form_date[5] = $year;  # wegen Jahr 0 (ist nach convert sonst 1)
      }
      $text=date::convert($text, @form_date);
    } else { $text='' }
  }

  if ($type eq 'TIME') {
    if ($hour ne '') {
      my @date = date::long2Date(time());
      $date[0]=$sec;
      $date[1]=$min;
      $date[2]=$hour;
      $text=date::convert($text, @date);
    } else { $text='' }
  }

  if ($type eq 'NUMBER') {
    $format=cleanStr($text); $text=''.$num;
    if ($text eq '') { return '' }
    $i=1; $n=$numbers; my $d=0; my $zahl=substr($num,1,200);
    my $s=''; my $a='|'; my $v=''; my $z=''; my $x; my $k='';
    my $vz=charAt($num,0);
    if ($format && charAt($format,0) eq '%') {
      $x=charAt($format,$i);
      if ($x eq '-' || $x eq '+') { $z=$x; $i++ } else { $z='' }
      $x=charAt($format,$i);
      if ($x eq ' ' || $x eq '0') { $a=$x; $i++; } else { $a='-' }
      $x=charAt($format,$i);
      if ($x ge '0' && $x le '9') { $n=0+$x; $i++; }
      else { $n=99; $a='z';}
      $x=charAt($format,$i);
      if ($x ge '0' && $x le '9') { $n=10*$n+(0+$x); $i++ }
      $x=charAt($format,$i);
      if ($x eq '.' || $x eq ',') { $k=$x; $i++ }
      $x=charAt($format,$i);
      if ($x ge '0' && $x le '9') { $d=0+$x; $i++ } else { $d=0 }
    }
    if ($n<1 || $n>$numbers) { $n=$numbers }
    if ($d>$decimals) { $d=$decimals }
    if ($vz eq '<') { $v='-' }
    else {
      if ($z eq '-') { $v=' ' }
      if ($z eq '+') { $v='+' }
    }
    my $komma='.'; if ($language eq 'de') { $komma=',' }
    if (!$k) { $komma='' }
    for ($i=$numbers-$n; $i<$numbers && charAt($zahl,$i) eq '0'; $i++) {
      if ($a eq ' ' || $a eq '0') { $s=$s.$a }
    }
    $z=substr($zahl,$i,$numbers-$i); if ($z=='') { $z='0' }
    $k=substr($zahl,$numbers,$d);
    if ($v ne '' && consists($z,'0') && consists($k,'0')) { $v=' ' }
    if ($a eq ' ') { $s=$s.$v }
    $s=$s.$z.$komma.$k;
    if ($a eq 'z') { $s=$zeros.$s }
    if ($a ne ' ') { $s=$v.$s }
    $text=$s;
  }

  return $text;
}


sub get { my( $var, $multi )=@_;
  if (not defined $multi) { $multi=0 }
  my $value='';
  if (@{"main::$var"} && $multi<scalar(@{"main::$var"})) { $value=${"main::$var"}[$multi]; }
#print "#($var, $multi) = $value<br>\n";
  return $value;
}


sub getDays {
  return ($_[2]*372+$_[1]*31+$_[0])
}


sub getGroupValue {my( $multi )=@_;
  my $val=getValue($multi);
  if (!isGroup($obj)) { return $val; }
  my $groupobj=$obj;
  my @felder = split('\|', $val);
  my $f='';
  $val='';
  my $need = '';
  for (my $i=1; $i<scalar(@felder); $i++) {
    $f.=$felder[$i].' / ';
    $obj=$felder[$i];
    my $ex = 0;
    my $O = ${"main::exclude_".$groupobj}; if ($O) { $ex = 1; }
    if ($obj) {
      my $v=getValue();
      if ($v) {
        if ($ex && $val && $check) { $_CF_O=$obj=$O; $msg=$O; Alert('Please fill in/select only one field'); }
        $val.=$v;
      }
      #print"\n\n$obj: $v";
    }
  }
  $obj=$groupobj;
  return $val;
}


sub getLimit {
  my @v = split( '\|', get($_[0]));
  return resolve(cleanStr($v[$_[1]]));
}


sub getNum {
  my $text = cleanStr($_[0]); $text =~ s/,/./g; if ($text eq '') { return '' }
  my $num=''; my $i; my $vz=1; my $d; $zeros='';
  my @n=split('\.',$text); my $c=charAt($n[0],0);
  if ($c eq '-') { $vz='<' } else { $vz='>' }
  if ($c lt '0' || $c gt '9') { $n[0]=substr($n[0],1,length($n[0])) }
  if (isNum($n[0])) {
    for ($i=0; $i<length($n[0])-1 && charAt($n[0],$i) eq '0'; $i++) { $zeros=$zeros.'0' }
    if ($i<$numbers) { $num=substr($n[0],$i,$numbers) }
  }
  my $a=isNum($n[1]);
  if ($num ne '0' && !$num && !$a) { return '' }
  $d=''; for ($i=0; $i<$decimals; $i++) { $d=$d.'0' }
  if ($n[1] && $a)  { $d=substr($n[1].$d,0,$decimals) }
  $num=$num.$d; my $l=length($num);
  for ($i=$numbers+$decimals; $i>$l; $i--) { $vz=$vz.'0' }
  return ($vz.$num);
}


sub getValue {my( $_multi_ )=@_;
  my $v=get($obj,$_multi_);
  if ($parameter::files{$obj}) { return $v; }
  $v = cleanStr($v);
#  $v = convertValue($v);   # wegen Depend ausmarkiert
#print "getValue($obj, $_multi_) = $v<br>\n";
  return $v;
}


sub init {
  $numbers=30;
  $decimals=9;
  $language='de';
  if ($main::_form_language) { $language = lc(substr($main::_form_language,0,2)); }
  if (defined &date::long2Date) {
    $shortyear=1;
    $date::language=$language;
    my @d = date::long2Date(time());
    if ($d[5] < 1000) { $d[5] += 1900; }
    $day=''.$d[3];
    $mon=''.($d[4]+1);
    $year=''.$d[5];
    $defaultyear=$year;
    $today=sprintf("%4d%02d%02d", $year, $mon, $day);
    $hour=''.$d[2];
    $min=''.$d[1];
    $sec=''.$d[0];
    $now=sprintf("%02d%02d%02d", $hour, $min, $sec);
    if (defined $main::_form_shortyear) { $shortyear = $date::shortyear = $main::_form_shortyear; }
    if (defined $main::_form_defaultyear) { $defaultyear = $date::defaultyear = $main::_form_defaultyear; }
  }
}


sub isGroup {my( $O )=@_;
  if (substr(get($O),0,11) eq '_form_group') { return 1; }
  return 0;
}


sub isNum {
  my $text=''.$_[0]; if (!length($text)) { return 0 }
  return consists($text,'0123456789');
}


sub noSpaces { my ($S) = @_;
  if (!defined $form::utf8) {
    $S =~ s/\s|\xA0//g;
  }
  else {
    $S =~ s/\s//g;
  }
  return $S;
}


sub prepareMsg {
  my $msg=$_[0];
  $msg =~ s/\$/§/g;
  my $m=$msg.' ';
  $m =~ s/\'|\"|\s|\n|\.|%|!|\?|\(|\)|\=/ /g;
  my $y=index($m,'§'); my $s; my $f; my $X=$obj;
  do {
    $s=index($m,' ',$y+1);
    if ($s>0) {
      $f=substr($m,$y,$s-$y);
      $obj=substr($f,1,100);
      $s=getValue(0);
      if ($s) { $msg =~ s/$f/$s/gi }
    }
    $y=index($m,'§',$y+1);
  } while ($y>=0);
  $obj=$X;
  #$msg(JS)
  return $msg;
}


sub readDate {
  my $value=$_[0]; my @x; my $m; my $a; my $y; my $d; my $i;
  # my @t = split(' ',$value);
  #if (date::getDayNumber($t[0]) ne '') { $value=substr($value, length($t[0])+1); }   # nicht mehr benötigt, da sonst "Mar 2007" als Mardi statt March erkannt wird
  my @t = split(',',$value);
  if ($t[1]) { $value=cleanStr($t[1]) }
  @form_date = date::long2Date(0);
  $value =~ s/ de / /g;
  if (!defined $form::utf8) {
    $value =~ s/\xA0/ /g;
  }
  $value =~ s/ +/ /g;
  $value =~ s/ |\. /\./g;
  ##$value =~ s/-/\//g;
  my $s = '-';
  if ($value =~ /\./ ) { $s='\.'; }
  if ($value =~ /\// ) { $s='/'; }
  if (!$value) { return @form_date; }
  @t = split($s, $value);
  if (!$t[1] && $t[0]) {
    if (length($t[0]) >= 8) {
      $t[2]=substr($t[0],0,4);
      $t[1]=substr($t[0],4,2);
      $t[0]=substr($t[0],6,2);
    }
    else {
      $t[1] = $defaultyear;
    }
  }
  if ($t[2] eq '' && $t[3]>0) { $t[2] = 0-$t[3]; }
  ##print "content-type: text/html\n\n$value<br>\n $s:> $t[0] / $t[1] / $t[2] $t[3]<br>\n";
  if ($s eq '/' && ($language eq 'en' || $language eq 'de')) {  ## Monat/Tag für US vertauschen
    my $tday = $t[1];
    $t[1] = $t[0];
    $t[0] = $tday;
  }
  if (length($t[0]) && !int($t[0])) {       ## t[0] ist Monat als Text -> mit t[0] tauschen
    my $tmon = date::getMonthNumber($t[0]);
    $t[0] = $t[1];
    $t[1] = $tmon;
  }
  elsif (length($t[1]) && !int($t[1])) {  ## t[1] ist Monat als Text -> t[0] bleibt
    $t[1] = date::getMonthNumber($t[1]);
  }
  ##print "$s:> $t[0] / $t[1] / $t[2] $t[3]<br>\n";
  if (int($t[0])>31 && int($t[1])<=31 && int($t[2])<=31) {    ## Format YYYY-MM-DD -> t[0] und t[1] tauschen
    my $tyear = $t[0];
    $t[0] = $t[2];
    $t[2] = $tyear;
    if (!$t[0]) { $t[0] = 1; }
  }
  if (!$t[2]) {    ## Nur 2 Angaben: entweder wurde Monat & Jahr oder Tag & Monat angegeben ...
    if (int($t[0])>31) {         ## t[0] = Jahr, t[1] = Monat -> t[2] = t[0], t[0] = defaulttag (1)
      $t[2] = $t[0];
      $t[0] = 1;
    }
    elsif (int($t[1])>31) {    ## t[1] = Jahr, t[0] = Monat -> t[2] = t[1], t[1] = t[0], t[0] = defaulttag (1)
      $t[2] = $t[1];
      $t[1] = $t[0];
      $t[0] = 1;
    }
    else {                              ## t[0] = Tag, t[1] = Monat -> t[2] = defaultjahr
      $t[2] = $defaultyear;
    }
  }

  ##print "$s:> $t[0] / $t[1] / $t[2] $t[3]<br>\n";
  for ($i=0; $i<=2; $i++) {
    if (!$t[$i]) { $t[$i]='' }
    $x[$i]=''.int($t[$i]);
    if (!$x[$i] && $x[$i] ne '0') { $x[$i] = ''; }
    if ($i<2 && $x[$i]==0) { $x[$i]=''; }
  }

  $day=$x[0]; $mon=$x[1]; $year=$x[2];
  if ($year eq '') { $year = $defaultyear; }
  $y=int($year); $m=int($mon); $d=int($day);
  ##print "$d.$m.$y<br>\n";
  if ((($value =~ /B\.C\./) || ($value =~ /v\.Chr\./)) && $y>0) { $y=0-$y; }
  if ($shortyear) {
    if ($y<0) { $y=0; }
    if ($y>40 && $y<200) { $y+=1900; }
    if ($y<=40) { $y+=2000; }
    if ($y>9999) { $y=9999; }
  }
  $year=''.$y;
  if ($m>12 && $m<32 && $d<=12) { $a=$mon; $mon=$day; $day=$a; $a=$m; $m=$d; $d=$a }
  if ($d<0 || $d>date::getMonthDays($m,$y)) {$day='' }
  if ($m<0 || $m>12) { $mon=''; }
  $form_date[3]=0+$day;
  $form_date[4]=(0+$mon)-1;
  $form_date[5]=0+$year;
  $form_date[0]=0;
  $form_date[1]=0;
  $form_date[2]=12;
  @form_date = date::long2Date(date::date2Long(@form_date, 'GMT'));
  $wday=$form_date[6];
  ##date::print("$wday: %DD|%MM|%YYYY<br>\n", @form_date);
  return @form_date;
}


sub readTime {
  my $value=$_[0]; $hour=''; $min=''; $sec=''; my @x; my $p=''; my $a;
  if (!$value) { return; }

  if ($value =~ /(p|a)/i) { $p=$1 }
  if (!defined $form::utf8) {
    $value =~ s/\xA0|p|a|m//g;
  }
  else {
    $value =~ s/p|a|m//g;
  }
  $value =~ s/\./:/g;
  if (length($value)>=14) { $value=substr($value,8,6) }
  my @t=split('\:',$value);
  if (!$t[1] && length($t[0])>2) {
    $value=substr($value,0,6);
    if (length($t[0]) % 2) { $t[0]='0'.$t[0] }
    $t[2]=substr($t[0],4,2);
    $t[1]=substr($t[0],2,2);
    $t[0]=substr($t[0],0,2);
  }
  for (my $i=0; $i<3; $i++) {
    if (!$t[$i]) { $t[$i]='0' }
    if (isNum($t[$i])) { $x[$i]=$t[$i] } else { $x[$i]='' }
    if ($i>0 && $x[0] ne '' && !(0+$x[$i])) { $x[$i]='0' }
  }
  $hour=''.$x[0]; $min=''.$x[1]; $sec=''.$x[2];
  if ($sec ne '') {
    my $s=0+$sec;
    if ($s<0 || $s>59) { $sec='' }
  }
  if ($min ne '') {
    my $m=0+$min;
    if ($m<0 || $m>59) { $min='' }
  }
  if ($hour ne '') {
    my $h=0+$hour;
    if ($p eq 'p' && $h<12) { $hour=''.($h+12) }
    if ($h==24 || ($p eq 'a' && $h==12)) { $hour='0' }
    if ($h>24) { $hour=''.($h%24) }
  }
#print "Time: $value; $hour : $min : $sec<br>\n";
}


sub referer { my( $o, $i)=@_;
  $obj=$o;
  if (charAt($o,0) ge 'A' && $obj) {
    $val[$i]=getValue();
    if ($val[$i] eq '') {
      my $name=$obj;
      $obj="date_$name"; if (get($obj)) { $val[$i]=getLimit($obj,$i) }
      $obj="time_$name"; if (get($obj)) { $val[$i]=getLimit($obj,$i) }
      $obj="number_$name"; if (get($obj)) { $val[$i]=getLimit($obj,$i) }
    }
    return 1;
  }
  return 0;
}


sub resolve {
  my $v=$_[0];
  if ($v eq '%TODAY') { $v=$today }
  if ($v eq '%NOW')   { $v=$now }
  if (charAt($v,0) ne '%') { $v = convertValue($v) }
  return $v;
}


sub set {my( $var, $value, $multi )=@_;
  if ((scalar @{"main::$var"}) > 1) {
    ${"main::$var"}[$multi] = $value;
  } else {
    ${"main::$var"}=$value;
    @{"main::$var"}=($value);
  }
}


sub setValue {my( $multi )=@_;
  if (!$multi) { $multi = 0; }
  if ($value ne '') {set($obj,$value,$multi) }
}


}
package mailsecure;
use MIME::Base64;

if (!defined $dir) {
  $dir = 'sbin';
}

my $smtp_server = 'smtp.trilobit.net';

my $smtp_user = 'skriptuser_xsj8od5@trilobit.de';

my $smtp_passwd  = '5do8jsx';


sub _check { my ($t, $was) = @_;
  my $error = '';
  $t =~ s/\A(\n|\r)+//;
  $t =~ s/\A(\n|\r)+\Z//;

  if ($t =~ /(\n|\r)/) {
    $error .= "Mehrzeiler in $was: $t\n";
    $t =~ s/\A(.*?)(\n|\r).*\Z/$1/;
  }

  return ($t, $error);
}


sub _correct_noAt { my ($string) = @_;
  $string =~ tr/[@]/[¶]/;
  return $string;
}


sub _correct_noKommas { my ($string) = @_;
  $string =~ tr/[,]/[.]/;
  return $string;
}


sub correctAddresses { my ($anwen) = @_;
# Gibt die gerichtete Adressliste und Empfängerliste zurück.
  $anwen =~ s/\s+/ /g;                              # mehrfache Leerzeichen zusammenfassen
  $anwen =~ s/(<[^>]+?( |"|\Z))/$1>, /g;            # alle <... zu <...>
  $anwen =~ s/,\s*>/>/g;                            # evtl. Folgefehler beheben
  $anwen =~ s/(<[^>]+>)"/"$1/g;                     # "... <...>" zu "..."<...>
  $anwen =~ s/("[^"]+")/_correct_noAt($1)/eg;       # alle "...@..." zu ¶
  $anwen =~ s/(<[^>]+>)/_correct_noKommas($1)/eg;   # alle <...,...> zu .
  $anwen =~ s/<|>/ /g;                              # alle < oder > zu Leerzeichen
  my $newanwen = '';
  my $emaillist = '';
  while ($anwen =~ /([^@>]*[^ ,@]+\@[^ ,@]+\.[A-Za-z]+)/g) {
    my $entry = $1;
    my $listentry = $1;
    $entry =~ s/\A\s*,\s*//g;
    if ($entry =~ /(.*?)([^ @,]+\@.*)/) {
      my $name = $1;
      my $email = $2;
      #my $email = _correct_noKommas($2);            # alle versehentlichen Kommas in < > zu Punkten
      $listentry = $entry = $email;
      $name =~ tr/[¶]/[@]/;                         # ¶ wieder zu @
      $name =~ s/"//g;
      $name =~ s/,?\s*\Z//;
      if ($name =~ /(,|\@)/) { $name = "\"$name\""; }
      if ($name) { $entry = "$name <$email>"; }
    }
    $newanwen  .= ", $entry";
    $emaillist .= ", $listentry";
  }
  $newanwen =~ s/\A, //;
  $emaillist =~ s/\A, //;
  return ($newanwen, $emaillist);
}


sub send { my ($hash, $options) = @_;
  $options = '' unless defined $options;

  my $return = '';
  my %hash   = %$hash;
  my $error  = '';
  my $body   = '';

  ## alle Hash-Keys in lowercase bringen

  foreach $key (keys %hash) {
    if ($key ne lc($key)) {
      if (!exists $hash->{lc($key)}) { $hash{lc($key)} = $hash{$key}; }
      delete $hash{$key};
    }
  }

  ## 1&1-Kompatibilität anschalten?

  my $einsundeins = 0;
  if (exists $hash{'1&1'}) {
    delete $hash{'1&1'};
    $einsundeins = 1;
  }

  ## from ermitteln für sendmail-Parameter

  my $from = '';
  foreach $was ('from', 'admin-from') {  ## Reihenfolge wichtig: admin-from überschreibt from
    foreach $key (keys %hash) {
      if (lc($key) eq $was) {
        ($v, $l) = correctAddresses($hash{$key});
        $from = $fromemail = $v;

        if ($l) {
          $fromemail = $l;
        }

        if ($was eq 'admin-from') {
          delete $hash{$key};
        }
      }
    }
  }

  if ($from =~ /\<\s*(.*?)\s*\>/) {
    $from = $1;
  }

  ## Header & Empfängerliste zusammenstellen
  my $was = '';
  my $header = '';
  my $header2  = '';
  my $empfaengerliste = '';
  my $e = '';

  # wird 'real' angegeben, werden alle anderen Angaben zu Empfängern ignoriert und ohne check 1:1 in der EMail übernommen: Fake-Emails
  my $real = 0;
  my %empfaengerliste = ();

  foreach $was ('real', 'to', 'cc', 'bcc', 'from', 'reply-to', 'absender') {
    foreach $key (keys %hash) {
      if (lc($key) eq $was) {
        my $v = $hash{$key}; my $l = $hash{$key};
        if (!$real) {
          ($v, $l) = correctAddresses($hash{$key});
          if ($l) {
            if ($was eq 'real') {
              $real = 1;
              foreach $email (split(', ',$l)) {
                $empfaengerliste{lc($email)}++;
              }
            }

            if (!$real && ($was eq 'to' || $was eq 'cc' || $was eq 'bcc')) {
              foreach $email (split(', ',$l)) {
                $empfaengerliste{lc($email)}++;
              }
            }
          }
          ($v, $e) = _check($v, $key);
          $error .= $e;
        }
        if ($was ne 'real') {
          $header .= "$was: $v\n";
        }

        if ($options =~ /print_$was/) {
          $return .= "$was: $v ($l)\n";
        }
        delete $hash{$key};
      }
    }
  }

  $empfaengerliste = '"' . join(', ', sort keys %empfaengerliste) . '"';

  foreach $was ('subject', 'content-type', 'content-transfer-encoding') {
    foreach $key (keys %hash) {
      if (lc($key) eq $was) {
        my $v = $hash{$key};
        ($v, $e) = _check($v, $key);
        $error .= $e;
        if ($was eq 'subject') { # Subject mime encoden
          if ($v =~ /[_\?\=\x00-\x1F\x7F-\xFF]/) {
            $v =~ s/([_\?\=\x00-\x1F\x7F-\xFF])/sprintf("=%02X", ord($1))/eg;
            $v =~ s/ /_/g;
            $v = "=?ISO-8859-1?Q?$v?=";
          }
        }
        $header .= "$was: $v\n";
        delete $hash{$key};
      }
    }
  }

  if (exists $hash{'body'}) {
    $body = $hash{'body'};
    delete $hash{'body'};
  }
  else {
    # hole neue keys: attachment, texthtml, textplain
    my $texthtml   = (exists $hash{'texthtml'}   ? 1 : 0);
    my $textplain  = (exists $hash{'textplain'}  ? 1 : 0);
    my $attachment = (exists $hash{'attachment'} ? 1 : 0);

    # kein Text -> leere Text Mail
    if (!$texthtml && !$textplain) {
      $textplain = 1;
      $hash{'textplain'} = '';
    }

    # print "$texthtml - $textplain - $attachment<br />\n";

    # Text/Html Mail
    if (!$attachment) {
      if ($texthtml && $textplain) {
        $header2 .= "Content-Type: multipart/alternative; boundary=\"------------020507080401090906010705\"\n\n";
        $header2 .= "This is a multi-part message in MIME format.\n";
        $header2 .= "--------------020507080401090906010705\nContent-Type: text/plain; charset=ISO-8859-15\nContent-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'textplain'}."\n\n";
        $header2 .= "--------------020507080401090906010705\nContent-Type: text/html; charset=ISO-8859-15\nContent-Transfer-Encoding: 8bit\n\n";
        $header2 .= $hash{'texthtml'};
        delete $hash{'textplain'};
        delete $hash{'texthtml'};
      }
      elsif ($texthtml) {
        $header2 .= "Content-Type: text/html; charset=ISO-8859-15\n";
        $header2 .= "Content-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'texthtml'};
        delete $hash{'texthtml'};
      }
      elsif ($textplain) {
        $header2 .= "Content-Type: text/plain; charset=ISO-8859-15\n";
        $header2 .= "Content-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'textplain'};
        delete $hash{'textplain'};
      }
    }
    else {
      my $boundaryAttach = "------------040202080901070702020400";

      if ($texthtml && $textplain) {
        $header2 .= "Content-Type: multipart/mixed; boundary=\"$boundaryAttach\"\n\n";
        $header2 .= "This is a multi-part message in MIME format.\n--$boundaryAttach\n";
        $header2 .= "Content-Type: multipart/alternative; boundary=\"------------020206050907030400050408\"\n\n";
        $header2 .= "--------------020206050907030400050408\nContent-Type: text/plain; charset=ISO-8859-15\nContent-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'textplain'}."\n\n";
        $header2 .= "--------------020206050907030400050408\nContent-Type: text/html; charset=ISO-8859-15\nContent-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'texthtml'}."\n";
        $header2 .= "--------------020206050907030400050408--\n\n";
        delete $hash{'textplain'};
        delete $hash{'texthtml'};
      }
      elsif ($texthtml) {
        $header2 .= "Content-Type: multipart/mixed; boundary=\"$boundaryAttach\"\n\n";
        $header2 .= "This is a multi-part message in MIME format.\n--$boundaryAttach\n";
        $header2 .= "Content-Type: text/html; charset=ISO-8859-15\nContent-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'texthtml'}."\n\n";
        delete $hash{'texthtml'};
      }
      elsif ($textplain) {
        $header2 .= "Content-Type: multipart/mixed; boundary=\"$boundaryAttach\"\n\n";
        $header2 .= "This is a multi-part message in MIME format.\n--$boundaryAttach\n";
        $header2 .= "Content-Type: text/plain; charset=ISO-8859-15\nContent-Transfer-Encoding: 7bit\n\n";
        $header2 .= $hash{'textplain'}."\n\n";
        delete $hash{'textplain'};
      }

      if (scalar(@{$hash{'attachment'}} > 0)) {
        # erweitern um attachments
        foreach my $atthash (@{$hash{'attachment'}}) {
          # boundary als trenner
          $header2 .= "--$boundaryAttach\n";
          $header2 .= "Content-Type: $atthash->{'content-type'}; name=\"$atthash->{'filename'}\"\n";
          $header2 .= "Content-Transfer-Encoding: base64\nContent-Disposition: inline; filename=\"$atthash->{'filename'}\"\n\n";
          $header2 .= encode_base64( ${$atthash->{'file'}} )."\n";
        }
      }
      # abschluss boundary
      $header2 .= "--$boundaryAttach--";
      delete $hash{'attachment'};
    }
  }

  ## Restliche Fehlerinfos zusammenstellen

  foreach (keys %hash) {
    $error .= "$_: $hash{$_}\n";
  }
  if ($error ne '') {
    $error = "\n\nMAILSECURE-FEHLER:\n\n$error\n\n";
  }


  ## Mail versenden
  my $text;
  if ($body eq '') {
    $text = $header . $header2;
  }
  else {
    $text = "$header\n$body";                               ## ein \n ist immer drin...
  }

  my $von = "-f $fromemail";
  if ($real) {
    $von = '';
  }

  my $command = '';
  if ($einsundeins) {
    $command = "|/usr/$dir/sendmail -oi -t $von > /dev/null 2>&1";
  }
  else {
    $command = "|/usr/$dir/sendmail -oi $von $empfaengerliste> /dev/null 2>&1";
  }

  if (open MAIL, ">>$main::_cgi_bin/TRILOBIT_STANDARD_MAIL.LOG") {
    if ( $options =~ /auth/i ) {
      $command = 'SMTP-auth Mailversand';
    }

    print MAIL "\n\n" . time() . " SENDMAIL: $command\n\n$error$text\n\n";
    close MAIL;
  }


  if (exists $ENV{'TRILOBIT'} && $ENV{'TRILOBIT'}) {                  ## TRILOBIT gesetzt: Intern
    ## nop
  }
  else {
    if ($options =~ /auth/i) {
      if (($sock = smtp::open($smtp_server, $smtp_user, $smtp_passwd))) {
        smtp::send( $sock, $text);
        smtp::close();
      }
    }
    else {
      if (open MAIL, $command) {
        print MAIL $text;
        close MAIL;
      }
    }
  }

  if (open MAIL, ">>$main::_cgi_bin/TRILOBIT_STANDARD_MAIL.LOG") {
    print MAIL "=======================================================\n\n";
    close MAIL;
  }

  return $return;
}


package nocontenttype;
$internal::contenttype='';


package random;


sub getInt { # $max, [ @seed ]
  my $max = shift @_;
  my $res=-1;
  while (@_) {
    my $seed=shift @_;
    if ($seed) {
      my $i;
      for ($i=0; $i<length($seed); $i++) { $res+=ord(substr $seed, $i,1); }
      return $res%($max+1);
    }
  }
  return int(rand($max+1));
}


sub getString { # $len
  my $len = shift @_;
  my $i;
  my $res='';
  for ($i=0; $i<$len; $i++) {
    $res.=chr(ord('a')+getInt(25));
  }
  return $res;
}


package smtp;
$_response = '';

# @author Ingo Gabriel


sub _cmd { my($sock, $send) = @_;
  _send($sock, $send);
  return _get($sock);
}


sub _get { my ($sock) = @_;
  $_response = '';
  sysread($sock, $_response, 1024);
  ##print "<<<$_response";
  $_response =~ /\A(\d+)/;
  ##print "Result: $1\n";
  return $1;
}


sub _send { my ($sock, $send) = @_;
  CORE::send($sock,"$send\r\n", 0);
}


sub close { my ($smtp) = @_;
  my $ok = 1;

  $result = _cmd(SOCK, 'QUIT');
  if ($result != 221) {
    printSmtpDebug("SMTP: $_response");
    $ok = 0;
  }

  CORE::close( $sock);
  return $ok;
}


sub open { my ($server, $user, $password) = @_;
  use Socket;
  use MIME::Base64;
  socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  connect(SOCK, sockaddr_in(25, inet_aton($server)));
  my $result = _get(SOCK);
  if ($result != 220) {
    CORE::close(SOCK);
    printSmtpDebug("SMTP: no response");
    return undef;
  }

  $result = _cmd(SOCK, "ehlo authsendmail");
  if ($result != 250) {
    CORE::close(SOCK);
    printSmtpDebug("SMTP: $_response");
    return undef;
  }

  if ($_response =~ /AUTH/) {
    $result = _cmd(SOCK, "AUTH LOGIN");
    if ($result != 334) {
      CORE::close(SOCK);
      printSmtpDebug("SMTP: $_response");
      return undef;
    }

    $result = _cmd(SOCK, encode_base64($user, ''));
    if ($result != 334) {
      CORE::close(SOCK);
      printSmtpDebug("SMTP: $_response");
      return undef;
    }

    $result = _cmd(SOCK, encode_base64($password, ''));
    if ($result != 235) {
      CORE::close(SOCK);
      printSmtpDebug("SMTP: $_response");
      return undef;
    }
  }

  ###print "SMTP: established connection";
  return SOCK;
}


sub printSmtpDebug { my ($infostring) = @_;
  if (defined $smtpdebug && $smtpdebug == 1) {
    if (!defined $infostring || $infostring eq '') {
      print STDERR "SMTP: no response\n";
    }
    else {
      print STDERR "SMTP: $infostring\n";
    }
  }
  return undef;
}


sub send { my ($smtp, $mail) = @_;
  if (!$smtp) {
    printSmtpDebug("SMTP: no conncted");
    return undef;
  }

  my $from  = '';
  my %rcpts = ();

  $mail =~ s/\r\n/\n/g;           # CRLF -> LF
  $mail =~ s/\r/\n/g;             # CR -> LF
  $mail =~ s/\n\.\n/\n\.\.\n/g;   # eine Zeile mit '.' gilt als "End of Mail", wird gemäß rfc2821 zu '..'

  if ($mail =~ /\A(.*?)\n\n(.*)\Z/s) {
    my $head = $1;
    my $body = $2;
    my @head = split /\n/, $head;
    my $newhead = '';

    foreach my $line (@head) {
      if ($line =~ /\A(from|to|bcc|cc):\s*(.*)\s*\Z/i) {
        my $type  = lc $1;
        my $addrs = $2;
        $addrs =~ s/\s*,\s*/,/g;

        foreach my $addr (split( ',', $addrs)) {
          if ($addr =~ /\<(.*)\>/) {
            $addr = $1;
          }

          if ($addr =~ /\A\s*(.*?)\s*\Z/) {
            $addr = $1;
          }
          $addr = lc $addr;

          if ($type eq 'from') {
            $from = $addr;
          }
          else {
            $rcpts{$addr} = 1;
          }
        }

        if ($type ne 'bcc') {
          $newhead .= "$line\n";
        }
      }
      else {
        $newhead .= "$line\n";
      }
    }
    $mail = "$newhead\n\n$body";
  }

  if (!$from) {
    printSmtpDebug("SMTP: no sender defined");
    return undef;
  }

  if (!keys(%rcpts)) {
    printSmtpDebug("SMTP: no recipient defined");
    return undef;
  }

  $result = _cmd(SOCK, "MAIL FROM:<$from>");
  if ($result != 250) {
    printSmtpDebug("SMTP: $result - $_response");
    return undef;
  }

  ##print "SMTP: sender <$from> accepted\n";
  foreach my $rcpt (sort keys %rcpts) {
    ##print "SMTP: sending mail to <$rcpt>\n";
    $result = _cmd(SOCK, "RCPT TO:<$rcpt>");
    if ($result != 250) {
      printSmtpDebug("SMTP: $result - $_response");
    }
  }
  $result = _cmd(SOCK, 'DATA');
  if ($result != 354) {
    printSmtpDebug("SMTP: $result - $_response");
    return undef;
  }

  $result = _cmd( SOCK, "$mail\r\n.");
  if ($result != 250) {
    printSmtpDebug("SMTP: $result - $_response");
    return undef;
  }

  ###print "SMTP: mail successfully sent\n";

  return 1;
}


package main;$form::utf8 = 1;
if (!defined $_form_action2 && defined $_form_action && ( form::checkForm() && (!defined($_form_onsuccess) || &$_form_onsuccess))) { if ($_form_action =~ /\A(.*)\/(.*?)\Z/) {  $_form_action2=$2;   chdir $1; } else {  $_form_action2=$_form_action; } undef $_form_action; require $_form_action2;} else {
if (!defined $internal::contenttype) {
$internal::contenttype='text/html'; print 'Content-Type: text/html

'; } print '';

print "Content-Type: text/html\n\n";
print '
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head><meta content="text/html; charset=UTF-8" http-equiv="Content-Type"><script charset="UTF-8" src="/js/form_utf8.js" type="text/javascript"></script>

<title>MailCom Adress-Designer</title>
<link href="/css/layout.css" rel="stylesheet" type="text/css">
<link href="/css/fonts.css" rel="stylesheet" type="text/css">
<link href="/css/form.css" rel="stylesheet" type="text/css">
<script charset="UTF-8" src="/js/form.js" type="text/javascript"></script>
<script charset="ISO-8859-1" src="/jquery/jquery-1.8.1.min.js" type="text/javascript"></script>
</head>
<body class="bestellung" onload="initForm(\'bestellen\',\'inputOK\',\'inputNeed\');">
<div id="wrapper">
<div id="header">
<div class="inside">
<div class="impressum_agb">
<p>
<a href="https://mailcom.eu/impressum">Impressum</a>
|
<a href="https://mailcom.eu/agb/">AGB</a>
|
<a href="https://mailcom.eu/Datenschutzerklaerung/index.html">DatenschutzerklÃ¤rung</a>
</p>
<a href="/index.html" id="headerlink">&nbsp;</a>
</div>
</div>
</div>
<div id="container">
<div id="main">
<div class="inside">
<div class="bestellung-mailcom-firmenadressen-flatrate">
<h2>
Bestellung MailCom Adress-Designer Version 8<br>
plus <span class="highlight">GRATIS</span> die MailCom Firmenadressen
</h2>
<p>
Hiermit bestelle ich verbindlich zu den "Allgemeinen GeschÃ¤ftsbedingungen" von MailCom e.K.
und den Lizenzvereinbarungen fÃ¼r die MailCom Firmenadressen folgendes Produkt:
</p>
<h3>
1 x MailCom Adress-Designer<br>
zum Preis von 790,- &euro; plus MwSt.
</h3>
<p>
<strong>AuÃŸerdem erhalte ich <span class="highlight">GRATIS</span> dazu die aktuelle Version der â€žMailCom Firmenadressenâ€œ.
Es gelten die Lizenzvereinbarungen der Anwenderversion.</strong>
</p>
<p>
<strong>Lieferung:</strong>
Der MailCom Adress-Designer und die MailCom Firmenadressen werden auf DVD bzw. CD geliefert.
Auf der CD der MailCom Firmenadressen befindet sich auÃŸerdem ein Selektionsprogramm zum Selektieren der Adressen.
Die Lieferung erfolgt <b>versandkostenfrei</b>.
</p>
<p>
<strong>Nutzungsvereinbarung fÃ¼r die MailCom Firmenadressen:</strong>
Die Firmenadressen kÃ¶nnen von dem in der Bestellung angegebene Unternehmen fÃ¼r eigene Zwecke
zeitlich unbegrenzt und laut Lizenzvereinbarung (Anwenderversion) genutzt werden.
<br>
<br>
Ausgeschlossen ist die Weitergabe oder der Verkauf der Adressen an andere Unternehmen oder Personen.
Ebenfalls ausgeschlossen ist die VerÃ¶ffentlichung in jeglicher Form im Internet.
HierfÃ¼r sind entsprechende anderweitige Lizenzvereinbarungen notwendig
(bitte nachfragen, wir unterbreiten Ihnen gerne ein Angebot).
</p>
<p>
<strong>Zahlungsart:</strong>
Wir akzeptieren die Zahlungsarten Lastschrift, Nachnahme oder Vorkasse.
Zahlung per Rechnung mit Ãœberweisung nur in AusnahmefÃ¤llen und nach vorheriger Absprache.
</p>
<p>
<strong>Lizenzvereinbarung:</strong>
Mit dieser Bestellung bestÃ¤tige ich, die Lizenzvereinbarung fÃ¼r die Firmenadressen (Punkt 1-9)
und die AGBs / DatenschutzerklÃ¤rung von MailCom e.K. vollstÃ¤ndig gelesen zu haben und erkenne diese an.
</p>
<ul>
<li><a href="https://mailcom.eu/mailcom/download/pdf/lizenzvereinbarung_mailcom_firmenadressen.pdf" target="_blank">Lizenzvereinbarung MailCom Firmenadressen</a></li>
<li><a href="https://mailcom.eu/agb/" target="_blank">AGBs</a></li>
</ul>
</div>
<div class="formular">
<h2>Bitte erfassen Sie fÃ¼r die Bestellung Ihre Adresse:</h2>
<form action="formular.php" method="get" name="bestellen" onsubmit="return checkForm(\'\',\'bestellen\');"><div class="invisible"><input name="_form_action" type="hidden" value="formulardanke.pl"></div><div class="invisible"><input name="_form_onsuccess" type="hidden" value="onBestellen"></div>
<p class="company-address"><strong>Firmenanschrift:</strong></p>
<p class="required-fields">* Pflichtfeld</p>
<br clear="all">
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<th>Firma 1 <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.anschrift_firma1" type="hidden" value="Bitte geben Sie eine Firmenanschrift an!"></div><input class="inputNeed" name="anschrift_firma1" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_firma1 ? convert::changeQuotes($anschrift_firma1) : '').'">
</td>
</tr>
<tr>
<th>Firma 2</th>
<td>
<input name="anschrift_firma2" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_firma2 ? convert::changeQuotes($anschrift_firma2) : '').'">
</td>
</tr>
<tr>
<th>Firma 3</th>
<td>
<input name="anschrift_firma3" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_firma3 ? convert::changeQuotes($anschrift_firma3) : '').'">
</td>
</tr>
<tr>
<th>StraÃŸe/Haus-Nr. <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.anschrift_strasse" type="hidden" value="Bitte geben Sie eine Strasse an!"></div><input class="inputNeed" name="anschrift_strasse" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_strasse ? convert::changeQuotes($anschrift_strasse) : '').'">
</td>
</tr>
<tr>
<th>PLZ <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.anschrift_plz" type="hidden" value="Bitte geben Sie eine PLZ an!"></div>
<input class="inputNeed" name="anschrift_plz" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_plz ? convert::changeQuotes($anschrift_plz) : '').'">
</td>
</tr>
<tr>
<th>Ort <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.anschrift_ort" type="hidden" value="Bitte geben Sie einen Ort an!"></div>
<input class="inputNeed" name="anschrift_ort" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_ort ? convert::changeQuotes($anschrift_ort) : '').'">
</td>
</tr>
<tr>
<th>Land<br>Bitte nur f&uuml;llen wenn nicht Deutschland</th>
<td>
<input name="anschrift_land" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $anschrift_land ? convert::changeQuotes($anschrift_land) : '').'">
</td>
</tr>
</table>
<p><strong>Ansprechpartner:</strong></p>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<th>Herr/Frau</th>
<td>
<input name="ansprechpartner_anrede" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $ansprechpartner_anrede ? convert::changeQuotes($ansprechpartner_anrede) : '').'">
</td>
</tr>
<tr>
<th>Titel</th>
<td>
<input name="ansprechpartner_titel" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $ansprechpartner_titel ? convert::changeQuotes($ansprechpartner_titel) : '').'">
</td>
</tr>
<tr>
<th>Vorname <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.ansprechpartner_vorname" type="hidden" value="Bitte geben Sie einen Vornamen an!"></div><input class="inputNeed" name="ansprechpartner_vorname" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $ansprechpartner_vorname ? convert::changeQuotes($ansprechpartner_vorname) : '').'">
</td>
</tr>
<tr>
<th>Nachname <span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.ansprechpartner_nachname" type="hidden" value="Bitte geben Sie einen Nachnamen an!"></div><input class="inputNeed" name="ansprechpartner_nachname" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $ansprechpartner_nachname ? convert::changeQuotes($ansprechpartner_nachname) : '').'">
</td>
</tr>
</table>
<p><strong>Kommunikationsdaten:</strong></p>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<th>Telefon<span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.kommunikation_telefon1" type="hidden" value="Bitte geben Sie eine Telefonnummer an!"></div><input class="inputNeed" name="kommunikation_telefon1" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $kommunikation_telefon1 ? convert::changeQuotes($kommunikation_telefon1) : '').'">
</td>
</tr>
<tr>
<th>Telefax<span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.kommunikation_fax" type="hidden" value="Bitte geben Sie eine Telefaxnummer an!"></div><input class="inputNeed" name="kommunikation_fax" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $kommunikation_fax ? convert::changeQuotes($kommunikation_fax) : '').'">
</td>
</tr>
<tr>
<th>Handy - Nr. des Ansprechpartners falls nicht anders zu erreichen</th>
<td>
<input name="kommunikation_handy" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $kommunikation_handy ? convert::changeQuotes($kommunikation_handy) : '').'">
</td>
</tr>
<tr>
<th>Email-Adresse<span class="required">*</span></th>
<td>
<div class="invisible"><input name="need.kommunikation_email" type="hidden" value="Bitte geben Sie eine E-Mailadresse ein!"></div><input class="inputNeed" name="kommunikation_email" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $kommunikation_email ? convert::changeQuotes($kommunikation_email) : '').'"><div class="invisible"><input name="email.kommunikation_email" type="hidden" value="Bitte geben Sie eine gÃ¼ltige E-Mailadresse ein!"></div>
</td>
</tr>
<tr>
<th>Anmerkungen</th>
<td>
<textarea name="kommunikation_anmerkungen">'.(defined $kommunikation_anmerkungen ? $kommunikation_anmerkungen : '').'</textarea>
</td>
</tr>
</table>
<p><strong>Bitte wÃ¤hlen Sie nachfolgend Ihre gewÃ¼nschte Zahlungsart:</strong></p>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<th rowspan="5">Zahlungsart<span class="required">*</span></th>
<td>
<input '.(!defined $zahlungsart ? 'CHECKED' : ($zahlungsart eq 'Nachnahme' ? 'CHECKED' : '') ).' class="radio" name="zahlungsart" onclick="checkField(this,1)" type="radio" value="Nachnahme">
</td>
<td>Nachnahme</td>
</tr>
<tr>
<td>
<input '.(!defined $zahlungsart ? '' : ($zahlungsart eq 'Vorkasse' ? 'CHECKED' : '') ).' class="radio" name="zahlungsart" onclick="checkField(this,1)" type="radio" value="Vorkasse">
</td>
<td>Vorkasse</td>
</tr>
<tr>
<td>
<input '.(!defined $zahlungsart ? '' : ($zahlungsart eq 'Rechnung' ? 'CHECKED' : '') ).' class="radio" name="zahlungsart" onclick="checkField(this,1)" type="radio" value="Rechnung">
</td>
<td>Rechnung (nur nach vorheriger Absprache)</td>
</tr>
<tr>
<td rowspan="2">
<input '.(!defined $zahlungsart ? '' : ($zahlungsart eq 'Lastschrift' ? 'CHECKED' : '') ).' class="radio" name="zahlungsart" onclick="checkField(this,1)" type="radio" value="Lastschrift">
</td>
<td>Lastschrift</td>
</tr>
<tr>
<td class="lastschrift">
<strong>Daten fÃ¼r Lastschrift</strong>
<p>
SEPA-Lastschriftmandat:<br>
GlÃ¤ubiger-Identifikationsnummer DE25ZZZ00001062445.
</p><p>
Die Mandatsreferenz wird separat mitgeteilt.
</p><p>
Ich ermÃ¤chtige MailCom e.K. Zahlungen von meinem Konto mittels Lastschrift einzuziehen. Zugleich weise ich mein Kreditinstitut an, die von MailCom e.K. auf mein Konto gezogene Lastschrift einzulÃ¶sen. Hinweis: Ich kann innerhalb von acht Wochen, beginnend mit dem Belastungsdatum, die Erstattung des belasteten Betrags verlangen. Es gelten dabei die mit meinem Kreditinstitut vereinbarten Bedingungen.
</p>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<th>Kontoinhaber</th>
<td>
<div class="invisible"><input name="need.kontoinhaber" type="hidden" value="Bitte Kontoinhaber angeben!"></div><input name="kontoinhaber" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $kontoinhaber ? convert::changeQuotes($kontoinhaber) : '').'"><div class="invisible"><input name="depend.kontoinhaber" type="hidden" value="Wenn Sie nicht per Lastschrift zahlen, benÃ¶tigen wir den Kontoinhaber nicht|$zahlungsart|Lastschrift"></div>
</td>
</tr>
<tr>
<th>Bank</th>
<td>
<div class="invisible"><input name="need.bank" type="hidden" value="Bitte Banknamen angeben!"></div><input name="bank" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $bank ? convert::changeQuotes($bank) : '').'"><div class="invisible"><input name="depend.bank" type="hidden" value="Wenn Sie nicht per Lastschrift zahlen, benÃ¶tigen wir die Angabe des Banknamen nicht|$zahlungsart|Lastschrift"></div>
</td>
</tr>
<tr>
<th>IBAN</th>
<td>
<div class="invisible"><input name="need.iban" type="hidden" value="Bitte IBAN angeben!"></div><input maxlength="34" name="iban" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $iban ? convert::changeQuotes($iban) : '').'"><div class="invisible"><input name="minlength.iban" type="hidden" value="16"></div><div class="invisible"><input name="depend.iban" type="hidden" value="Wenn Sie nicht per Lastschrift zahlen, benÃ¶tigen wir die IBAN nicht|$zahlungsart|Lastschrift"></div>
</td>
</tr>
<tr>
<th>BIC</th>
<td>
<div class="invisible"><input name="need.bic" type="hidden" value="Bitte BIC angeben!"></div><input maxlength="11" name="bic" onkeyup="checkField(this,1)" size="30" type="text" value="'.(defined $bic ? convert::changeQuotes($bic) : '').'"><div class="invisible"><input name="minlength.bic" type="hidden" value="8"></div><div class="invisible"><input name="depend.bic" type="hidden" value="Wenn Sie nicht per Lastschrift zahlen, benÃ¶tigen wir die BIC nicht|$zahlungsart|Lastschrift"></div>
</td>
</tr>
</table>

</td>
</tr>
</table>
<p><strong>Bestellung absenden:</strong></p>
<p>
Mit dem Absenden wird diese Bestellung verbindlich! Sie erhalten
nach Absenden per E-Mail eine Bestell-BestÃ¤tigung fÃ¼r den
MailCom Adress-Designer und die MailCom Firmenadressen.
</p>
<table border="0" cellpadding="0" cellspacing="0" class="lizenzbedingungen">
<tr>
<td>
<div class="invisible"><input name="need.accept_agb" type="hidden" value="Sie mÃ¼ssen die Lizenzbedingungen und AGB anerkennen, um eine Bestellung aufgeben zu kÃ¶nnen."></div><input '.(!defined $accept_agb ? '' : ($accept_agb eq '0' ? 'CHECKED' : '')).' name="accept_agb" onclick="checkField(this,1);checkField(this,1)" style="width: 30px; height: 30px; float: left; text-align: left; margin: 0px; padding: 0px;" type="checkbox" value="0">
</td>
<th>
Die Lizenzbedingungen fÃ¼r die MailCom Firmenadressen und
die AGBs von MailCom e.K. habe ich gelesen und anerkannt.*
</th>
</tr>
<tr>
<td>
<div class="invisible"><input name="need.accept_privacy" type="hidden" value="Sie mÃ¼ssen die DatenschutzerklÃ¤rung zur Kenntnis nehmen, um eine Bestellung aufgeben zu kÃ¶nnen."></div><input '.(!defined $accept_privacy ? '' : ($accept_privacy eq '1' ? 'CHECKED' : '')).' name="accept_privacy" onclick="checkField(this,1);checkField(this,1)" style="width: 30px; height: 30px; float: left; text-align: left; margin: 0px; padding: 0px;" type="checkbox" value="1">
</td>
<th>
Ich habe die <a href="https://mailcom.eu/Datenschutzerklaerung/index.html" target="_blank">DatenschutzerklÃ¤rung</a> zur Kenntnis genommen.*
</th>
</tr>
</table>
<div class="submit">
<p class="back">
<a class="button button-blue" href="/index.html">ZurÃ¼ck</a>
</p>
<input class="button button-blue" title="Kostenpflichtig bestellen" type="submit" value="Kostenpflichtig bestellen">
</div>
</form>
</div>
</div>
</div>
</div>
<div id="footer">
<div class="inside">
</div>
</div>
</div>


';

            if (   defined $form::errmsg
                && $form::errmsg ne ''
            ) {
                $message = $form::errmsg;
            }

            if (   defined $form::errfld
                && $form::errfld ne ''
            ) {
                $errfld = $form::errfld;
            };
print '
<script charset="utf-8" type="text/javascript">
            $(document).ready( function() {
                '.(defined $message && $message ne '' ? 'window.alert(\'' . $message . '\');' : '').'
                '.(defined $errfld && $errfld ne '' ? '$(\'[name="' . $errfld . '"]\').focus().select();' : '').'
            });
        </script>
</body>
</html>
';

    sub onBestellen {

        if ($zahlungsart eq 'Lastschrift') {

            # http://de.wikipedia.org/wiki/International_Bank_Account_Number
            # http://greyhound-software.com/community/index.php?page=Thread&threadID=1936

            if ($iban !~ /^[a-zA-Z]{2}[0-9]{2}[a-zA-Z0-9]{4}[0-9]{7}([a-zA-Z0-9]?){0,16}$/) {

                $form::errmsg = "Die IBAN ist fehlerhaft. Bitte Ã¼berprÃ¼fen Sie Ihre Eingabe.";
                $form::errfld = "iban";

                return 0;
            }

            if ($bic !~ /^([a-zA-Z]{4}[a-zA-Z]{2}[a-zA-Z0-9]{2}([a-zA-Z0-9]{3})?)$/) {

                $form::errmsg = "Die BIC ist fehlerhaft. Bitte Ã¼berprÃ¼fen Sie Ihre Eingabe.";
                $form::errfld = "bic";

                return 0;
            }
        }

        my $mail_to   = 'kontakt@mailcom.eu';
        my $mail_bcc  = 'oliver.reiff@trilobit.de';
        my $mail_from = 'kontakt@mailcom.eu';


        $message_adresse .= "Firma1: $anschrift_firma1\n";

        if ($anschrift_firma2 ne '') {
            $message_adresse .= "Firma2: $anschrift_firma2\n";
        }

        if ($anschrift_firma3 ne '') {
            $message_adresse .= "Firma3: $anschrift_firma3\n";
        }

        $message_adresse .= "Strasse: $anschrift_strasse\n"
                          . "PLZ: $anschrift_plz\n"
                          . "Ort: $anschrift_ort\n"
                          ;

        if ($anschrift_land ne '') {
            $message_adresse .=  "Land: $anschrift_land\n";
        }

        $message_adresse .= "\n\nAnsprechpartner\n";

        if ($ansprechpartner_anrede ne '') {
            $message_adresse .= "Anrede: $ansprechpartner_anrede\n";
        }

        if ($ansprechpartner_titel ne '') {
            $message_adresse .=  "Titel: $ansprechpartner_titel\n";
        }

        $message_adresse .= "Vorname: $ansprechpartner_vorname\n"
                          . "Nachname: $ansprechpartner_nachname\n"
                          . "Telefon: $kommunikation_telefon1\n"
                          ;

        if ($kommunikation_fax ne '') {
            $message_adresse .= "Telefax: $kommunikation_fax\n";
        }

        if ($kommunikation_handy ne '') {
            $message_adresse .= "Handy - Nr.: $kommunikation_handy\n";
        }

        $message_adresse .= "E-Mail: $kommunikation_email\n"
                          . "IP: $ENV{'REMOTE_ADDR'}\n"
                          . "Zeit: " . date::convert('%D. %MON %YYYY - %hh:%mm') . "\n"
                          ;

        if ($kommunikation_anmerkungen ne '') {
            $message_adresse .= "Anmerkungen: $kommunikation_anmerkungen\n";
        }

        # Speicherung auf dem Server
        $bestellnummer = time() . '_' . random::getString(10);
        my $message_save  = "BESTELLUNG fÃ¼r MailCom e.K.\n\n"
                              . "Es ist folgende Bestellung eingegangen:\n\n"
                              . "1 MailCom Adress-Designer und MailCom Firmenadressen Flatrate\n"
                              . "Zum Preis von 790,- Euro plus MwSt.\n\n"
                              . "Die AGB von MailCom und Lizenzvereinbarung fÃ¼r die MailCom Firmenadressen hat der Kunde gelesen\n"
                              . "und durch anklicken einer Check-Box anerkannt!\n\n"
                              . "Der Kunde hat folgende Zahlungsart gewÃ¤hlt:\n"
                              . "$zahlungsart\n\n"
                              . ($zahlungsart eq 'Lastschrift' ?
                                  "Bankverbindung:\n"
                                #. "  Kontoinhaber: $kontoinhaber\n"
                                #. "  Bank: $bank\n"
                                #. "  BLZ: $blz\n"
                                #. "  Kontonummer: $konto\n\n"

                                . "  Kontoinhaber: $kontoinhaber\n"
                                . "  Bank: $bank\n"
                                . "  IBAN: $iban\n"
                                . "  BIC: $bic\n\n"
                              : '')
                              . "_______________________________________________\n\n"
                              . "Liefer - und Rechnungsanschrift\n\n"
                              . $message_adresse
                              ;

        $message_save =~ s/\n/<br>/gs;

        $message_html = "<html><body><h1 style=\"padding-left: 100px;\">Bestellung $bestellnummer</h1>"
                      . "<h2 style=\"padding-left: 100px;\">" . date::convert('%D. %MON %YYYY - %hh:%mm') . "</h2>"
                      . "<p style=\"font-family: monospace; font-size: 14px; padding-left: 100px;\">"
                      . $message_save
                      . "</p>"
                      #. "<listing style=\"font-size: 14px; padding-left: 100px;\">"
                      #. $message_save
                      #. "</listing>"
                      . "</body></html>"
                      ;
        $message_html = convert::utf82win($message_html);
        file::set("../orders/$bestellnummer.html", $message_html);

        # Scramblen der Kontonummer
        #$konto =~ s/\A(?:.*)(...)\z/*****$1/;
        $iban =~ s/^([a-zA-Z]{2})([0-9]{2})([a-zA-Z0-9]{4})([0-9]{7})(.*)$/$1$2$3*****/;

        # Mail an MailCom
        my $message_mailcom = "BESTELLUNG fÃ¼r MailCom e.K.\n\n"
                              . "Es ist folgende Bestellung eingegangen:\n\n"
                              . "1 MailCom Adress-Designer und MailCom Firmenadressen Flatrate\n"
                              . "Zum Preis von 790,- Euro plus MwSt.\n\n"
                              . "Die AGB von MailCom und Lizenzvereinbarung fÃ¼r die MailCom Firmenadressen hat der Kunde gelesen\n"
                              . "und durch anklicken einer Check-Box anerkannt!\n\n"
                              . "Mehr Daten unter:\n"
                              . "https://adress-designer.de/orders/$bestellnummer.html"
                              ;

        my %mail_data_mailcom = (
            'to'        => $mail_to,
            'bcc'       => $mail_bcc,
            'from'      => $mail_from,
            'subject'   => convert::utf82win("Bestellung MailCom Adress-Designer und Firmenadressen-Flatrate ($bestellnummer)"),
            'textplain' => convert::utf82win($message_mailcom),
        );

        mailsecure::send(\%mail_data_mailcom);


        # Mail an Kunden
        my $message_customer = "BESTELLBESTÃ„TIGUNG\n\n"
                             . "Sie haben soeben folgende Produkte verbindlich bestellt:\n\n"
                             . "1 MailCom Adress-Designer und MailCom Firmenadressen Flatrate zum Preis von 790,- Euro plus MwSt. \n\n"
                             . "Bestellhinweis:\n"
                             . "Die AGBs von MailCom e.K. und die Lizenzvereinbarung fÃ¼r die MailCom Firmenadressen haben\n"
                             . "Sie gelesen und durch Anklicken der Check-Box anerkannt.\n\n"
                             . " - Die Lieferung erhalten Sie in den nÃ¤chsten 3-4 Tagen per Paketpost\n"
                             . " - Die Lieferung erhalten Sie versandkostenfrei\n\n"
                             . "Zahlungsart:\n"
                             . "Sie haben folgende Zahlungsart gewÃ¤hlt:\n"
                             . "$zahlungsart\n\n"
                             . ($zahlungsart eq 'Lastschrift' ?
                                 "Wir buchen den Rechnungsbetrag von folgendem Konto ab:\n\n"
                                . "  Kontoinhaber: $kontoinhaber\n"
                                . "  Bank: $bank\n"
                                . "  IBAN: $iban (zu Ihrer Sicherheit gekÃ¼rzt)\n"
                                . "  BIC: $bic\n\n"
                             : '')
                             . "\n\n____________________________________________________\n\n"
                             . "Ihre angegebene Liefer- und Rechnungsanschrift:\n\n"
                             . $message_adresse
                             . "\n____________________________________________________\n\n"
                             . "Ihr Lieferant:\n\n"
                             . "MailCom e.K.\n"
                             . "Inh. Mathias Laforsch\n"
                             . "Postfach 1447\n"
                             . "63204 Langen\n"
                             . "Telefon  06103/921360\n"
                             . "Telefax  06103/921361\n"
                             . "Email: kontakt\@mailcom.eu\n"
                             . "Internet: www.mailcom.eu\n\n"
                             . "Der Software- und Adressenspezialist seit 35 Jahren!\n"
                             ;

        my %mail_data_customer = (
            'to'        => $kommunikation_email,
            'bcc'       => $mail_bcc,
            'from'      => $mail_from,
            'subject'   => convert::utf82win('Bestellung MailCom Adress-Designer und Firmenadresse-Flatrate'),
            'textplain' => convert::utf82win($message_customer),
        );
        mailsecure::send(\%mail_data_customer);


        print "Status: 301 Moved Permanently\n";
        print "Location: formulardanke.php?bestellnummer=$bestellnummer\n\n";
        die();
    };
print '';

}
1;