#! /usr/bin/perl

use strict;
use warnings;
use DBI;

# MYSQL CONFIG VARIABLES
my $host   = "localhost";
my $db     = "Pharma";
my $driver = "DBI:mysql:$db:$host";
my $user   = "******";
my $pw     = "******";

# PERL CONNECT()
my $dbh = DBI->connect( $driver, $user, $pw ) || die "$DBI::errstr\n";

my $tabname = "";
my $satznr  = 0;
my @spalte  = ();
my @sptyp   = ();
my @spkey   = ();
my $start   = -1;

$| = 1;

sub DEBUG {
    my @a = @_;
    print STDERR "DEBUG:\n-------------\n";
    print STDERR "$_\n" for @a;
    print STDERR "\n-------------\n";
}

sub process_satz {
    my $sref = $_[ 0 ];
    my $typ  = $_[ 1 ];

    if ( $sref->[ 0 ] eq "K" ) {
        $tabname = $sref->[ 6 ];
        $tabname =~ s/-/_/g;
        print "Bearbeite Tabelle " . $tabname . "\n";
        $satznr = 0;
        if ( $typ eq "GES" ) {
            print "-- Tabelleninhalte löschen.\n";
            my $sql = "delete from $tabname";
            my $sth = $dbh->prepare( $sql ) || die "$DBI::errstr\n";
            $sth->execute() || die "$DBI::errstr\n";
        }
    }

    # Felder definieren
    elsif ( $sref->[ 0 ] eq "F" ) {
        if ( $sref->[ 2 ] eq "Text" ) { $sref->[ 2 ] = "Text1"; }

        $spalte[ $sref->[ 1 ] ] = $sref->[ 2 ];

        #$sptyp[$sref->[1]]  = ($sref->[7]=~/^NU/?"N":"S");
        $sptyp[ $sref->[ 1 ] ] = (
            $sref->[ 7 ] eq (
                     "NU1"
                  or "NU2"
                  or "NU3"
                  or "PNH"
                  or "PZN"
                  or "IKZ"
                  or "GRU"
                  or "FLA"
                  or "GK1"
                  or "DTA"
              ) ? "N" : "S"
        );
        $spkey[ $sref->[ 1 ] ] = $sref->[ 3 ];
    }

    # Einfügen von Datensätzen
    elsif ( $sref->[ 0 ] eq "I" ) {
        my $sql;

        # prüfe ob der Datensatz mit dem Key existiert
        $sql =
          "select $spalte[1] from $tabname where $spalte[1] = $sref->[1]";
        print $sql. "\n";

        my $sth = $dbh->prepare( $sql ) || die "$DBI::errstr\n";
        $sth->execute() || die "$DBI::errstr\n";

        my @row = $sth->fetchrow_array();    # hole eine Ergebniszeile
        if ( @row == 0 ) {    # keine Datensätze mit existierendem Schlüssel
            $sql = "insert into $tabname (";
            for ( my $i = 1 ; $i <= @spalte ; $i++ ) {
                if ( defined $spalte[ $i ] ) {
                    $sql .= $spalte[ $i ] . ",";
                }
            }
            $sql =~ s/,$//;
            $sql .= ") values (";
            for ( my $i = 1 ; $i <= @spalte ; $i++ ) {
                if ( defined $spalte[ $i ] ) {
                    if ( $sptyp[ $i ] eq "N" && $sref->[ $i ] eq "" ) {
                        $sql .= "NULL,";
                    }
                    elsif ( $sptyp[ $i ] eq "N" ) {
                        $sql .= $sref->[ $i ] . ",";
                    }
                    else { $sql .= "'" . $sref->[ $i ] . "',"; }
                }
            }
            $sql =~ s/,$//;
            $sql .= ")";
            print $sql. "\n";

            $sth = $dbh->prepare( $sql ) || die "$DBI::errstr\n";
            $sth->execute() || die "$DBI::errstr\n";
            $satznr++;
            if ( $satznr % 100 == 0 ) {
                print "-- " . $satznr . " Datensätze importiert.\n";
            }
        }
        else {
            warn "Datensatz $sref->[1] existiert schon\n";
        }
    }

    # Update von Datensätzen
    elsif ( $sref->[ 0 ] eq "U" ) {

        my $sql = "update $tabname set "
          ;    # 1. Teil des SQL-Strings erzeugen: "update <tabelle> set "

        for ( my $i = 1 ;
            $i <= @spalte ; $i++ )    # Jetzt gehe ich alle Spalten durch
        {
            if (    defined( $spkey[ $i ] )
                and $spkey[ $i ] eq "0"
                and defined( $spalte[ $i ] )
                and defined( $sref->[ $i ] )
              )                       # Wenn kein Primärschlüssel...
            {
                if ( "$sptyp[$i]" eq "N" )    # Wenn numerisch...
                {
                    $sql .= $spalte[ $i ] . "=" . $sref->[ $i ] . ",";
                }       # dann anhängen "<spaltenname>=<wert>,"
                else    # ansonsten
                {
                    $sql .= $spalte[ $i ] . "='" . $sref->[ $i ] . "',";
                }       # anhängen "<spaltenname>='<wert>',"
            }
        }

        $sql =~
          s/,$//;  # Am Ende ist hinten ein Komma zu viel - das wird gelöscht
        $sql .= " where ";    # anhängen " where "

        for ( my $i = 1 ;
            $i <= @spalte ; $i++ )    # Nochmal alle Spalten durchgehen
        {
            if (    defined( $spkey[ $i ] )
                and $spkey[ $i ] != "0"
                and defined( $spalte[ $i ] )
                and defined( $sref->[ $i ] ) )    # Wenn Primärschlüssel
            {
                if ( $sptyp[ $i ] eq "N" )        # Wenn numerisch...
                {
                    $sql .= $spalte[ $i ] . "=" . $sref->[ $i ] . " and ";
                }       # dann anhängen "<spaltenname>=<wert> and "
                else    # ansonsten
                {
                    $sql .= $spalte[ $i ] . "='" . $sref->[ $i ] . "' and ";
                }       # anhängen "<spaltenname>='<wert>' and "
            }

        }
        $sql =~ s/ and $//
          ;    # Am Ende ist hinten ein " and " zu viel - das wird gelöscht

        print $sql. "\n";
        my $sth = $dbh->prepare( $sql )
          || die "$DBI::errstr\n";    # SQL-Statement vorbereiten...
        $sth->execute() || die "$DBI::errstr\n";    # ... und ausführen
    }

    elsif ( $sref->[ 0 ] eq "D" ) {
        my $sql = "delete from " . $tabname . " where ";
        for ( my $i = 1 ; $i <= @spalte ; $i++ ) {
            if ( $spkey[ $i ] != 0 ) {
                if ( $sptyp[ $i ] eq "N" ) {
                    $sql .= $spalte[ $i ] . "=" . $sref->[ $i ] . " and ";
                }
                else {
                    $sql .= $spalte[ $i ] . "='" . $sref->[ $i ] . "' and ";
                }
            }
        }
        $sql =~ s/ and $//;
        print $sql. "\n";
        my $sth = $dbh->prepare( $sql ) || die "$DBI::errstr\n";
        $sth->execute() || die "$DBI::errstr\n";
    }
}

sub process_file {
    my $file = $_[ 0 ];

    $tabname = "";
    @spalte  = ();
    @sptyp   = ();
    @spkey   = ();
    $start   = -1;

    print "Bearbeite Datei " . $file . "\n";

    my $typ = substr( $file, -3 );

    open IN, "<", $file;
    my $last = -1;
    my @satz = ();
    while ( <IN> ) {
        chomp $_;
        my $line = substr( $_, 0, 2 );
        my $content = substr( $_, 2 );
        if ( $line <= $last ) {
            process_satz( \@satz, $typ );
            @satz = ();
        }
        $satz[ $line ] = decode( $content );
        $last = $line;
    }
}

sub decode {
    my $s = $_[ 0 ];

    $s =~ s/\\A25/Ä/g;
    $s =~ s/\\A29/Ä/g;
    $s =~ s/\\a22/ä/g;
    $s =~ s/\\a23/ä/g;
    $s =~ s/\\a24/ä/g;
    $s =~ s/\\a25/ä/g;
    $s =~ s/\\a29/ä/g;
    $s =~ s/\\a33/ä/g;
    $s =~ s/\\a63/a/g;
    $s =~ s/\\b63/ß/g;
    $s =~ s/\\C49/Ç/g;
    $s =~ s/\\c22/c/g;
    $s =~ s/\\c49/ç/g;
    $s =~ s/\\D63/?/g;
    $s =~ s/\\d63/d/g;
    $s =~ s/\\E22/É/g;
    $s =~ s/\\E33/E/g;
    $s =~ s/\\E63/?/g;
    $s =~ s/\\e22/é/g;
    $s =~ s/\\e23/è/g;
    $s =~ s/\\e24/ê/g;
    $s =~ s/\\e25/ë/g;
    $s =~ s/\\e63/e/g;
    $s =~ s/\\g63/Y/g;
    $s =~ s/\\H63/T/g;
    $s =~ s/\\I25/Ï/g;
    $s =~ s/\\i22/í/g;
    $s =~ s/\\i23/ì/g;
    $s =~ s/\\i24/î/g;
    $s =~ s/\\i25/ï/g;
    $s =~ s/\\J63/H/g;
    $s =~ s/\\j63/?/g;
    $s =~ s/\\k63/?/g;
    $s =~ s/\\L63/?/g;
    $s =~ s/\\I63/?/g;
    $s =~ s/\\M33/M/g;
    $s =~ s/\\m33/m/g;
    $s =~ s/\\m63/µ/g;
    $s =~ s/\\N26/Ñ/g;
    $s =~ s/\\n26/ñ/g;
    $s =~ s/\\n63/?/g;
    $s =~ s/\\O25/Ö/g;
    $s =~ s/\\o22/ó/g;
    $s =~ s/\\o23/ò/g;
    $s =~ s/\\o24/ô/g;
    $s =~ s/\\o25/ö/g;
    $s =~ s/\\o35/o/g;
    $s =~ s/\\o42/ø/g;
    $s =~ s/\\o63/d/g;
    $s =~ s/\\p63/p/g;
    $s =~ s/\\s39/ß/g;
    $s =~ s/\\s63/s/g;
    $s =~ s/\\t63/T/g;
    $s =~ s/\\U25/Ü/g;
    $s =~ s/\\u22/ú/g;
    $s =~ s/\\u23/ù/g;
    $s =~ s/\\u24/û/g;
    $s =~ s/\\u25/ü/g;
    $s =~ s/\\W63/O/g;
    $s =~ s/\\w63/?/g;
    $s =~ s/\\x63/X/g;
    $s =~ s/\\y25/ÿ/g;
    $s =~ s/\\y63/?/g;
    $s =~ s/\\z63/?/g;
    $s =~ s/\\321/,/g;
    $s =~ s/\\323/:/g;
    $s =~ s/\\324/!/g;
    $s =~ s/\\325/?/g;
    $s =~ s/\\326/-/g;
    $s =~ s/\\327/=/g;
    $s =~ s/\\328/#/g;
    $s =~ s/\\329/’/g;
    $s =~ s/\\330/‘/g;
    $s =~ s/\\333/#/g;
    $s =~ s/\\340/*/g;
    $s =~ s/\\341/|/g;
    $s =~ s/\\344/§/g;
    $s =~ s/\\345/?/g;
    $s =~ s/\\346/—/g;
    $s =~ s/\\347/°/g;
    $s =~ s/\\348/‰/g;
    $s =~ s/\\351/?/g;
    $s =~ s/\\360/+/g;
    $s =~ s/\\361/&/g;
    $s =~ s/\\362/*/g;
    $s =~ s/\\363/§/g;
    $s =~ s/\\364/#/g;
    $s =~ s/\\365/_/g;
    $s =~ s/\\367/#/g;
    $s =~ s/\\372/#/g;
    $s =~ s/\\375/#/g;
    $s =~ s/\\380/®/g;
    $s =~ s/\\420/(/g;
    $s =~ s/\\421/)/g;
    $s =~ s/\\422/[/g;
    $s =~ s/\\423/]/g;
    $s =~ s/\\424/{/g;
    $s =~ s/\\425/}/g;
    $s =~ s/\\426/</g;
    $s =~ s/\\427/>/g;
    $s =~ s/\\428/«/g;
    $s =~ s/\\429/»/g;
    $s =~ s/\\430/“/g;
    $s =~ s/\\431/”/g;
    $s =~ s/\\432/?/g;
    $s =~ s/\\435/?/g;
    $s =~ s/\\460/±/g;
    $s =~ s/\\462/#/g;
    $s =~ s/\\463/<->/g;
    $s =~ s/\\465/~/g;
    $s =~ s/\\466/?/g;
    $s =~ s/\\467/?/g;
    $s =~ s/\\473/Ø/g;
    $s =~ s/\\520/<=/g;
    $s =~ s/\\521/>=/g;
    $s =~ s/\\535/?/g;
    $s =~ s/\\565/#/g;
    $s =~ s/\\900/€/g;

    return $s;
}

opendir DIR, ".";
my @files = grep { /\.GES$/ && -f "$_" } readdir( DIR );
closedir DIR;

foreach my $file ( @files ) { process_file( $file ); }

opendir DIR, ".";
@files = grep { /\.UPD$/ && -f "$_" } readdir( DIR );
closedir DIR;

foreach my $file ( @files ) { process_file( $file ); }

$dbh->disconnect;