#! /usr/bin/perl use strict; 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 $dbh = DBI->connect( "dbi:ODBC:Daten",'','') || die "$DBI::errstr\n"; my $tabname = ""; my $satznr = 0; my @spalte = (); my @sptyp = (); my @spkey = (); my $start = -1; 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/\\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; } 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"; } } 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]; } # elsif( $sref->[0] eq "I" ) # { # my $sql = "insert into ".$tabname." ("; # for( my $i=1; $i<=@spalte; $i++ ) # { # if( $spalte[$i] ne "" ) # { $sql .= $spalte[$i].","; } # } # $sql =~ s/,$//; # $sql .= ") values ("; # for( my $i=1; $i<=@spalte; $i++ ) # { # if( $spalte[$i] ne "" ) # { # 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"; # # my $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"; } # } elsif( $sref->[0] eq "U" ) { my $sql = "update ".$tabname." set "; # 1. Teil des SQL-Strings erzeugen: "update set " for( my $i=1; $i<=@spalte; $i++ ) # Jetzt gehe ich alle Spalten durch { if( $spkey[$i]==0 && $sref->[$i] ne "" ) # Wenn kein Primärschlüssel... { if( $sptyp($i] eq "N") # Wenn numerisch... { $sql .= $spalte[$i]."=".$sref->[$i].","; } # dann anhängen "=," else # ansonsten { $sql .= $spalte[$i]."='".$sref->[$i]."',"; } # anhängen "=''," } } $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( $spkey[$i]!=0 && $sref->[$i] ne "") # Wenn Primärschlüssel { if( $sptyp[$i] eq "N" ) # Wenn numerisch... { $sql .= $spalte[$i]."=".$sref->[$i]." and "; } # dann anhängen "= and " else # ansonsten { $sql .= $spalte[$i]."='".$sref->[$i]."' and "; } # anhängen "='' 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() { chomp $_; my $line = substr($_, 0, 2); my $content = substr($_, 2); if( $line<=$last ) { process_satz( \@satz, $typ ); @satz=(); } $satz[$line] = decode($content); $last = $line; } } opendir DIR, "."; my @files = grep { /\.GES$/ && -f "$_" } readdir(DIR); closedir DIR; foreach my $file (@files) { process_file( $file ); } opendir DIR, "."; my @files = grep { /\.UPD$/ && -f "$_" } readdir(DIR); closedir DIR; foreach my $file (@files) { process_file( $file ); } $dbh->disconnect;