| Current Path : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/DivBasicF/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/DivBasicF/CSV.pm |
package DivBasicF::CSV;
use strict;
use Data::Dumper;
use Digest::SHA1;
use Digest::MD5;
use DivBasicF::ParseDate;
use File::Copy;
sub DELIVER { 2 }
$Data::Dumper::Sortkeys = 1;
sub new {
my $class = shift;
my $self = {};
$self->{'lmax_normal'} = 10; # Standard-Einrueckung fuer Formatierung von CSV-Files
bless($self,$class);
return($self);
}
#*******************************************************************
# Diese Funktion exportiert Adressdaten.
#
# Das Template kann eines der beiden Standard-Templates sein.
# Allgemein kann es ein freier String sein, oder eine Datei
sub convert {
my $self = shift;
my @pars = @_;
my $csvs = [];
my $command = "";
$command = shift(@pars) if ($pars[0] eq "vcard");
# $command = shift(@pars) if ($pars[0] =~ s/^X(.*)/$1/);
my $file; my $o; my $o1; my $o2; my $text; my @entries; my @cells; my $bed;
my $zeile; my $entry; my @fields; my @ee; my $cells; my $cellscount; my $type;
my $trenner; my $filter_expr; my $id; my $ftyp; my $file1; my $file0; my @ee;
my $misccount; my $filecount1; my $double_counts;
my $text0 = "";
my $filter = "";
my $template = "";
my $sort = "";
my $filter_template = "";
my $content = "";
foreach $o (@pars) {
next if (!$o);
$o1 = $o;
$o1 =~ s/\\n/\n/gs;
if ($o =~ /^(.*?)(csv|xls|xlsx|txt)[\,\n](.*)$/s) {
$o1 = $1.$2;
push(@pars,$3);
}
if ((-f $o1) and $o1 =~ /\.(csv|xls|xlsx|txt)$/) {
push(@$csvs,$o1);
}
elsif ($o1 =~ /\n/) {
$text0 = $o1;
}
elsif ($o1 eq "-") {
push(@pars,join("",<STDIN>));
}
elsif (!$filter) {
$filter = $o1;
}
elsif ($o1 =~ s/^X\:(.*)/$1/) {
$command = $1;
}
elsif (!$template) {
$template = $o1;
}
elsif (!$sort) {
$sort = $o1;
}
elsif (!$filter_template) {
$filter_template = $o1;
}
elsif (!$content) {
$content = $o1;
}
}
if (!@$csvs and !$text0) {
$csvs = [$ENV{'ADRFILE'}];
}
$csvs = join(",",@$csvs);
$filter = $filter || ".";
$template = $template || ".";
$sort = $sort || "-ADRCOUNT-"; # Reihenfolge standardmaessig beibehalten
$filter_template = $filter_template || "-OBJ-";
if ($command eq "vcard") {
return($self->vcard($csvs,$text0));
}
$self->{'lmax'} = 0;
$self->{'free_entry_newline'} = "";
$sort = "-STARTTIME--OBJ-" if ($template =~ /\:/ and $sort eq "-ADRCOUNT-");
$template = "-NAME-,-VORNAME-,-xSTRASSE-,-xPLZ-,-xSTADT-,-xTEL-,-xMAIL-,-REST-" if ($template eq ".");
$template = "-NAME-,-VORNAME-,-xSTRASSE-,-xPLZ-,-xSTADT-,-xTEL-,-xMAIL-" if ($template eq "..");
$template = "-xDISTWARN--WTAG-,-DATE-,-TIME-,-ORT-,-REMARK-,-REST-" if ($template eq ":");
$template = "-xDISTWARN--WTAG-,-DATE-,-TIME-,-ORT-,-REMARK-" if ($template eq "::");
if (-f $template) { # wenn das Template ein File ist, entsprechende Kopien erzeugen
open(FFILE,"<".$template);
$content = join("",<FFILE>);
close(FFILE);
$template =~ s/^(.*)[\\\/](.*)$/$2/;
$template =~ s/^([a-zA-Z0-9\.]\-)/\-$1/;
}
my @pars = @_;
my $files = {};
$self->{'free_entry_newline'} = "\n" if ($csvs !~ s/^\-(.+)$/$1/);
if ($csvs eq "-") {
$csvs = join("",<STDIN>);
# print $csvs;
}
$o1 = [];
$id = sprintf("%08u",10000000+int(rand(89999990)));
@ee = split(/[\n \,\;]+/,$csvs);
while (0 == 0) { # hier werden alle Files durchgegangen
last if (!@ee);
$file = shift(@ee);
# next if (!(-f $file)); # ihr Identifier-Key ausgerechnet.
next if ($file !~ /\.(csv|adr|txt|xls|xlsx)$/);
$o = $self->convert_makekey($file); # dann werden die Key-Value-Paare
$files->{$o} = $file; # entsprechend abgespeichert
push(@$o1,$file) if ($file =~ /\.(xls|xlsx)$/);
if ($#$o1 > 10 or (!@ee and $#$o1 > -1)) {
system("libreoffice --headless --convert-to $id.csv " . join(" ",@$o1));
foreach $o2 (@$o1) {
$type = `file -i '$o2'`;
if ($type =~ /charset\=(\S+)/) {
$type = $1;
if ($type ne "utf-8" and $type =~ /(iso|ascii)/) {
system("cp " . $o2 . " " . $o2 . "~");
print("iconv -f $type -t utf-8 $o2\n");
system("iconv -f $type -t utf-8 $o2"."~ > $o2");
}
}
}
$o1 = [];
}
}
my $adr = [];
my $filecount = -1;
my $adrcount = 0;
foreach $file ($text0,values %$files) {
$file0 = $file;
# $id = "xxxxxx";
# if ($file =~ /^(.*?)(\_\_[a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9]|)\.(csv|adr|txt|xls|xlsx)$/) {
# $id = $2 || "xxxxxx"; # dies ist der Identifier, der ggfs. zu einer anderen Datei verweist
# $ftyp = $3;
# $id =~ s/\_//g;
# }
# next if (!(-f $file)); # skip, wenn die Datei schon gar nicht mehr existiert
#
# $file1 = $files->{$id}; # suchen nach der Datei, von der $file mal erzeugt worden ist
# $o = "xxxxxx";
# if ($file1 =~ /\_\_([a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9])\.(csv|adr|txt|xls|xlsx)/) {
# $o = $1;
# }
#
# if ($ftyp =~ /^xls/) { # wenn die zu bearbeitende Datei eine Excel-Datei ist ...
# if ($files->{$o} ne $file) { # keine csv-Datei gefunden, die sich ihrerseits von der Excel-Datei ableitet
# system("libreoffice --headless --convert-to csv $file");
# $id = $self->convert_makekey($file);
# $o = "";
# $file1 = "";
# if ($file =~ /^(.*)\.(.*)$/) { # hier wird das neue File-Paar erzeugt
# $file1 = "$1.csv";
# $o = $self->convert_makekey($file1);
# $o1 = $file;
# $file =~ s/^(.*?)(\_\_[a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9]|)\.([a-z]+)$/$1\_\_$o.$3/;
# $file =~ s/\_\_xxxxxx\./\./;
# move($o1,$file);
# $o1 = $file1;
# $file1 =~ s/^(.*?)(\_\_[a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9]|)\.([a-z]+)$/$1\_\_$id.$3/;
# $file1 =~ s/\_\_xxxxxx\./\./;
# move($o1,$file1);
# }
# }
# $file0 = $file1;
# delete($files->{$file1}); # verhindern, dass die CSV-Datei nochmal eingelesen wird,
# } # wenn sie schon ueber die Excel-Datei angesprochen wurde
#
# elsif ($ftyp =~ /^XXX(csv|adr|txt)$/) { # wenn die zu bearbeitende Datei eine CSV-Datei ist
# if ($files->{$o} ne $file) { # die ggfs. in $file1 gefundene Excel-Datei leitet sich ihrerseits
# unlink($file1); # nicht von der CSV-Datei ab. Da sie aber Vorgaenger der CSV-Datei
# # ist, soll sie geloescht werden, da alle Aenderungen in der CSV-Datei sind.
# # Beim naechsten Oeffnen der Datei muss dann eben die CSV-Datei genommen werden.
#
# $o1 = $file; # jetzt noch die CSAV-Datei renormieren, damit eine daraus entstehende Excel-Datei
# $id = $self->convert_makekey($file);
# $file =~ s/^(.*?)(\_\_[a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9][a-z0-9]|)\.([a-z]+)$/$1\_\_$id.$3/;
# $file =~ s/\_\_xxxxxx\./\./;
# move($o1,$file); # gleich den richtigen Identifier traegt
# $file0 = $file;
# }
# }
next if (!$file0);
next if ($file0 !~ /\n/ and !(-f $file0));
if ($file0 !~ /\n/) {
print "# " . $file0 . "\n" if (!$content or $template =~ /\-/);
if ($file0 =~ s/^(.*)\.(xls|xlsx)$/$1/) {
$file0 =~ s/^(.*)[\\\/](.*)/$2/;
$file0 = $file0 . ".$id.csv";
}
$filecount = $filecount + 1;
open(FFILE,"<".$file0);
$text = join("",<FFILE>);
close(FFILE);
} else {
$text = $text0;
}
$text =~ s/
//gs;
if ($text =~ s/^(.*?)\n(\#* *sub +\S+ +\{.*)/$1\n/s) {
eval($2); print ($@);
}
$text =~ s/\",\"[\n ]*/\",\"\n/gs;
$text =~ s/^([a-zA-Z0-9\_\-]+\: )/\"\n$1/gs;
$text =~ s/([^\"])\n([a-zA-Z0-9\_\-]+\: )/$1\",\"\n$2/gs;
$text =~ s/\n\",\"\n/\"\n\"\n/gs;
# $text = $text . "\"";
# unlink($file0) if ($file0 =~ /$id\.csv$/);
$text =~ s/^\s*//s;
@cells = ();
@fields = (); # Spaltenueberschriften
$cells = [split(/\"|$/," " . $text . " ")];
# print $text . "\n <-------------\n\n";
$text =~ s/\"(.*?)(\"|$)/---FIELD---/gs;
$cellscount = -1;
$trenner = ",";
foreach $zeile (split(/\n/,$text)) { # jeden Eintrag durchgehen
next if ($zeile =~ /\./ and !@fields); # alle Zeilen VOR der Spaltenueberschriftenzeile,
next if ($zeile !~ /\S/ and !@fields); # die nach Dateinamen aussehen oder leer sind, ueberspringen
next if ($zeile =~ /^\#/ and !@fields);
next if ($zeile =~ /^[ \-]*$/);
$misccount = 0;
$adrcount = sprintf("%08u",$adrcount+1);
@fields = ("REST") if (!@fields and $zeile =~ /---FIELD---/);
if (!@fields) {
if ($zeile =~ /^(.*?)([\;\,])/) { $trenner = $2; }
if ($template =~ /^COPY$/i) { # Korrektur der Spaltenueberschiften von Notation FELD auf -FELD-
$template = uc($zeile);
$template =~ s/(^|\,|\;)([^\-])/$1\-x$2/g;
$template =~ s/([^\-])($|\,|\;)/$1\-$2/g;
$template =~ s/\-xx/\-x/ig;
$template =~ s/\-X/\-x/g;
# $template = $template . ",-REST-";
# $template =~ s/^,//;
# print "TEMPLATE: $template\n";
}
@fields = split(/$trenner/,uc($zeile));
foreach $o (@fields) { $o =~ s/^\-(.*)\-$/$1/ }
} else {
@ee = @fields;
$entry = [];
foreach $o (split(/$trenner/,$zeile)) {
$o1 = $o;
if ($o1 eq "---FIELD---") {
$cellscount = $cellscount + 2;
$o1 = $cells->[$cellscount];
}
$o2 = shift(@ee) || "MISC" . sprintf("%1u",$misccount);
if ($o1 =~ s/^[\n ]*([a-zA-Z0-9\.\_]+)\: +//) {
$o2 = uc($1);
}
elsif ($o2 =~ /^MISC/) {
$misccount = $misccount + 1;
}
$o1 =~ s/^\s*(.*?)\s*$/$1/s;
push(@$entry,[$o2,$o1,$filecount]) if ($o1 =~ /\S/ and $o2 !~ /^(x?MD5KEY|DBL)$/i and $o2 !~ /\./);
}
$filter_expr = $self->ff($filter_template,$entry,$trenner); # nur die Eintraege verwenden
foreach $o1 (split(/~/,$filter)) { # die den Filterausdruck matchen
$bed = 1;
foreach $o2 (split(/,/,$o1)) {
next if ($filter_expr =~ /$o2/);
$bed = 0;
last;
}
last if ($bed);
}
next if (!$bed);
$o = $sort;
$o =~ s/-ADRCOUNT-/$adrcount/g;
unshift(@$entry,['sort',$self->ff($o,$entry,$trenner)]);
push(@$entry,['INDEX',$command]) if ($command);
push(@$adr,$entry);
}
}
}
#print Dumper(@fields);
#print "TT: $template\n";
#print Dumper($adr); exit;
# alle Eintraege sind jetzt in das Array $adr aufgenommen. Es folgt noch die
# Konsolidierung mit $sort;
my $adr1 = [];
my $entry1;
foreach $entry ( ( sort { $a->[0]->[1] cmp $b->[0]->[1] } @$adr ) , [[],[]]) {
if (!$entry1) {
$entry1 = $entry;
}
elsif ($entry1->[0]->[1] eq $entry->[0]->[1]) { # wenn der Sortierindex gleich ist, dann die Felder mergen
shift(@$entry);
$entry1 = [@$entry1,@$entry];
}
else { # noch Doubletten-Check machen:
$double_counts = {};
foreach $o1 (@$entry1) {
$o1->[2] = $o1->[2] . "." . $double_counts->{$o1->[0]} if ($double_counts->{$o1->[0]});
$double_counts->{$o1->[0]} = $double_counts->{$o1->[0]} + 1;
}
# print Dumper($entry1);
$o = {};
foreach $o1 (@$entry1) {
if ($o->{$o1->[0]}) { # wenn das Feld schon mit einem Wert belegt ist
$o->{'___COLLAPSE___'} = 1;
$cells = $self->merge_field($o1->[0],$o->{$o1->[0]},$o1->[1]);
if ($cells ne "") { # Eintrag kam schon genauso - oder aehnlich - vor, daher doppelten Eintrag loeschen
$o->{$o1->[0]} = $cells;
$o1->[1] = ""; # d.h. das gibt eine Leerstelle im $entry1 Array
} else {
$o->{'___DBL___'} = 1;
# print "doublette\n";
if ($o1->[2]) {
$o->{$o1->[0].":".$o1->[1]} = $o1->[2]; # Doublettenverhinderung in XXX.<nnn>-Feldern
$o1->[0] = $o1->[0] . "." . $o1->[2]; # markleren, aus welchem File die
}
} # doppelten Eintraege kommen
} else {
$o->{$o1->[0]} = $o1->[1];
}
}
push(@$entry1,["DBL","x"]) if ($o->{'___DBL___'});
# print Dumper($entry1);
# print Dumper($o);
if ($o->{'___COLLAPSE___'}) { # es gibt leere Eintraege
$o1 = []; # daher Neuaufbau des Entry-Arrays
foreach $o2 (@$entry1) {
next if (!($o2->[1])); # ... wobei die leeren Feld-Eintraege uebersprungen werden
next if ($o2->[0] =~ /^(.*?)\.(\d+\.?\d*)$/ and $o->{$1.":".$o2->[1]} != $o2->[2]); # Doublettenverhinderung in XXX.<nnn>-Feldern
push(@$o1,$o2);
$o2->[1] = $o->{$o2->[0]} || $o2->[1];
}
$entry1 = $o1;
}
push(@$adr1,$entry1) if (@$entry1);
$entry1 = $entry;
}
}
# push(@$adr1,$entry1);
# print Dumper($adr1); exit;
# print "-"x(length($template)) . "\n";
$o2 = $template;
$o2 =~ s/\-x/\-/g;
$o2 =~ s/-//g;
$o1 = "-"x(length($o2));
$o2 = "\n" . $o2 . "\n$o1\n";
foreach $entry (@$adr1) {
$self->{'lmax'} = $self->{'lmax_normal'} || $self->{'lmax_normal'};
$o = $self->ff($template,$entry,"",1);
$o =~ s/
//gs;
if ($content) {
$o1 = $self->ff($content,$entry,"");
$o1 =~ s/
//gs;
$bed = $o;
$bed =~ s/[\\\/ \-]//gs;
$bed =~ s/ä/ae/g;
$bed =~ s/ö/oe/g;
$bed =~ s/ü/ue/g;
$bed =~ s/Ä/Ae/g;
$bed =~ s/Ö/Oe/g;
$bed =~ s/Ü/Ue/g;
$bed =~ s/ß/ss/g;
if ($template ne $o) {
open(FFILE,">>$bed");
print FFILE $o1;
close(FFILE);
} else {
print $o1;
}
}
if ($template ne $o) {
$o =~ s/\n([A-Z0-9\_]+\.\d+\.?\d*\: )/\n $1/gs;
print $o2 . $o . "\n";
}
$o2 = "";
}
# if (!(-f($template))) {
# $template =~ s/\-(.*?)\-/\$ENV\{lc($1)\}/gs;
# open(FFILE,">__tmp__.pl");
# print FFILE "print <<XXX2;\n".$template."\nXXX2\n";
# close(FFILE);
# $template = "__tmp__.pl";
# }
# foreach $entry (@$adr) {
# map { $main::ENV{lc($_)} = $entry->{$_} } keys %$entry;
# system("perl $template " . join(",",keys %$entry) . " " . join(" ",@pars));
# system(join(";", map { " export $_=".$entry->{$_} } keys %$entry) . "; perl $template\n");
# }
# unlink("__tmp__.pl");
}
#*********************************************************************************
sub convert_makekey {
my $self = shift;
my $file = shift;
open(FFILE,"<$file");
my $o = Digest::SHA1::sha1_hex(join("",<FFILE>));
close(FFILE);
return(substr($o,0,6));
}
#*********************************************************************************
sub merge_field {
my $self = shift;
my $field = shift;
my $txt1 = shift;
my $txt2 = shift;
my $o; my $o1;
if ($field =~ /^(INDEX|CAL)$/i) {
$txt1 = $txt1 . " " . $txt2;
$txt2 = [];
$txt1 =~ s/[ \n\,\;]+/ /gs;
foreach $o (split(/ /,$txt1)) {
next if ($o1->{$o});
$o1->{$o} = 1;
push(@$txt2,$o);
}
$txt2 = join(" ",@$txt2);
# $txt2 = s/(............................................................\S*?) /$1\n/gs;
return($txt2);
}
if ($field =~ /^STRASSE$/i) {
$txt1 =~ s/strasse/str./;
$txt2 =~ s/strasse/str./;
}
return($txt1) if ($txt1 eq $txt2);
return("");
}
#*********************************************************************************
sub ff {
my $self = shift;
my $text = shift;
my $entry0 = shift;
my $trenner = shift || ",";
my $mark_fields = shift;
my $o; my $o0; my $o1; my $o2; my $o3; my $o9; my @ee; my $erg; my $nr;
my $entry = {};
if (ref($entry0) eq "ARRAY") {
foreach $o (@$entry0) {
$entry->{$o->[0]} = $entry->{$o->[0]} || $o->[1];
}
} else {
$entry = {%$entry0};
}
# print Dumper($entry0); sleep 0;
my $e = $entry;
my $worked_fields = {};
while ($text =~ /(^|-)(x?)(\d*[A-Z\_0-9\.]+?)(\d*)-/) {
$o0 = $1;
$o1 = $2;
$o2 = $3;
$o3 = $4;
$worked_fields->{lc($o2)} = 1;
$worked_fields->{lc($o2.$o3)} = 1;
$o = "";
eval("\$o = $o2$o3(\$entry)\n");
if (!$o) { $o = $entry->{lc($o2.$o3)}; }
if (!$o) { $o = $entry->{uc($o2.$o3)}; }
if (!$o) { $o = $entry->{lc($o2)}; }
if (!$o) { $o = $entry->{uc($o2)}; }
if (!$o) {
if ($o2 eq "TIME") {
$o = $self->time_mark();
if ($o3 == 1) {
$o = substr($o,2,4);
}
}
}
if (!$o) {
if ($o2 eq "INTERVAL") {
$o = $self->time_mark();
if ($o3 == 1) {
$o = substr($o,6,2) . "." . substr($o,4,2) . "." . substr($o,0,4);
}
}
}
if (!$o) {
if ($o2 eq "MD5KEY") { # Identity check
$o = Digest::MD5->md5_base64(Dumper($entry0));
$o =~ s/\//\_/g;
$o =~ s/\+/\-/g;
# $o = Dumper($entry0);
}
}
if (!$o) {
if ($o2 eq "OBJ") { # Identity check
$o = Dumper($entry0);
}
}
if (!$o) {
if ($o2 eq "REST" and ref($entry0) eq "ARRAY") {
$o = "\"" . $self->{'free_entry_newline'};
foreach $o9 (sort { $a->[0] cmp $b->[0] } @$entry0) {
next if ($o9->[3]);
next if ($o9->[0] =~ /^sort$/i);
next if (!($entry->{$o9->[0]}));
$self->{'lmax'} = length($o9->[0]) if ($self->{'lmax'} < length($o9->[0]));
$o = $o . uc($o9->[0]) . ":";
$o = $o . "---SPACE" . length($o9->[0]) . "---" if ($self->{'free_entry_newline'});
my $o7 = "";
eval("\$o7 = " . uc($o9->[0]) . "(\$entry)");
$o7 = $o7 || $o9->[1];
$o = $o . " " . $o7 . "\"$trenner\"" . $self->{'free_entry_newline'};
}
$o = $o . "\"";
}
while ($o =~ s/---SPACE(\d+)--- /---SPACE--- /) {
$o9 = " "x($self->{'lmax'}-$1);
$o =~ s/---SPACE--- /$o9 /gs;
}
}
# if (!$o) {
# if ($o =~ /(.*?)-(.*)/) {
# $nr = $2;
# $o2 = $1;
# $o = $entry->{lc($o2)};
# if (!$o) { $o = $entry->{uc($o2)}; }
# if ($o =~ /sub +\{/) {
# eval("\$o = " . $o);
# $o = $self->$o($nr) if (!$@);
# }
# }
# }
if ($o and $o3 and $o =~ /,/) {
$o =~ /^ *(.*?) *$/;
$o = $1;
$o = (split(/ *, */,$o))[$o3-1];
}
if (!$o) {
if (!($entry->{'ANREDE1'}) and $text =~ /PERSON: *(.*?),(.*?),(.*?),(.*?) *\n/) {
$entry = $self->anrede_entry({%$entry},$1,$2,$3,$4);
next;
}
}
if (!$o) {
# $bed = 1;
if (!$o1) {
$o = "-".$o2.$o3."-";
}
}
$o =~ s/^(\-?)(\d\d?\d?)\,(\d\d\d)\.(\d\d?)$/$1$2$3\.$4/;
push(@ee,$o);
$text =~ s/$o0$o1$o2$o3-/XqXqXqYqYqXqXqX/;
if ($mark_fields) {
foreach $o9 (@$entry0) { # Markieren der schon ausgewerteten Felder
next if ($o9->[0] ne $o2 and $o9->[0] ne "$o2$o3");
$o9->[3] = 1;
last;
}
}
}
while ($text =~ /XqXqXqYqYqXqXqX/) {
$o = shift(@ee);
$o = "\"" . $o . "\"" if ($o =~ /$trenner/s and $o !~ /\"/s);
$text =~ s/XqXqXqYqYqXqXqX/$o/;
}
# $o = eval($text);
# $text = $o if (!$@);
return($text);
}
#********************************************************************************
sub time_mark {
my $self = shift;
my $o1 = time();
$o1 = sprintf("%04u",(localtime($o1))[5]+1900) .
sprintf("%02u",(localtime($o1))[4]+1) .
sprintf("%02u",(localtime($o1))[3]) . "_" .
sprintf("%02u",(localtime($o1))[2]) .
sprintf("%02u",(localtime($o1))[1]);
return($o1);
}
#********************************************************************************
sub anrede_entry {
my $self = shift;
my $entry = shift;
my $title = shift; # Titel Absender
my $vorname = shift; # Vorname Absender
my $name = shift; # Name Absender
my @ids = @_; # Gruss-Identifier
my $modes = " xx9 " . $entry->{'SEX'} . " " .
$entry->{'ANREDE'} . " "; # Reihenfolge der zur Verfuegung stehenden Rollen
my $o; my $o1; my $o2;
foreach $o (keys %{$self->{'ENTRY'}}) {
if ($o =~ /^ANREDE\_(.*)$/) {
$o1 = lc($1);
$o2 = $self->{'ENTRY'}->{$o};
$o2 =~ s/(\d+)/ $o1$1 /;
$modes = $modes . " " . $o2 . " ";
}
}
my $v = $entry->{'VORNAME'};
my $n = $entry->{'NAME'};
my $t = $entry->{'TITLE'};
my $i = $entry->{'INST'};
my $t1 = $t ? $t . " " : "";
my $v1 = $v ? $v . " " : "";
my $title1 = $title ? $title . " " : "";
my $mw = "i";
$o1 = lc("," . $self->{'VORNAME'} . ",");
if ($modes =~ / m /) { $mw = "m"; }
elsif ($modes =~ / w /) { $mw = "w"; }
elsif ($modes =~ / i /) { $mw = "w"; }
elsif ($self->{'MALE'} =~ /$o1/) { $mw = "m"; }
elsif ($self->{'FEMALE'} =~ /$o1/) { $mw = "m"; }
$modes =~ s/ (m|w|i)/ /gs;
foreach $o (@ids,"xx") {
next if ($modes !~ /$o(\d+)/);
$modes = $1;
last;
}
if (!$v and $modes < 7) { $modes = 7; }
if (!$v and !$n) { $mw = "i"; }
if ($mw eq "i" and $modes < 8) { $modes = 8; }
if (!$i) {
if ($v and $n) {
$entry->{'ADR1'} = "An";
$entry->{'ADR1'} = "Herrn" if ($mw eq "m");
$entry->{'ADR1'} = "Frau" if ($mw eq "w");
$entry->{'ADR2'} = "$t1$v $n";
}
elsif ($n) {
$entry->{'ADR1'} = "An";
$entry->{'ADR2'} = "Herrn $t1$n" if ($mw eq "m");
$entry->{'ADR2'} = "Frau $t1$n" if ($mw eq "w");
}
} else {
$entry->{'ADR1'} = $i;
$entry->{'ADR2'} = "Herrn $t1$v1$n" if ($mw eq "m");
$entry->{'ADR2'} = "Frau $t1$v1$n" if ($mw eq "w");
}
$entry->{'ANREDE1'} = "Sehr geehrte Damen und Herren";
$entry->{'ANREDE1'} = "Sehr geehrter Herr $t1$n" if ($mw eq "m");
$entry->{'ANREDE1'} = "Sehr geehrte Frau $t1$n" if ($mw eq "w");
$entry->{'ANREDE2'} = "Mit freundlichen Grüßen";
$entry->{'ANREDE3'} = "$vorname $name";
$entry->{'ANREDE4'} = 2;
if ($modes < 3) {
$entry->{'ANREDE1'} = "Lieber $v" if ($mw eq "m");
$entry->{'ANREDE1'} = "Liebe $v" if ($mw eq "w");
$entry->{'ANREDE2'} = "Viele Grüße";
$entry->{'ANREDE3'} = $vorname if ($modes == 1);
$entry->{'ANREDE4'} = 1;
}
if ($modes == 9) {
$entry->{'ANREDE3'} = "$title1$vorname $name";
}
if ($modes == 7) {
$entry->{'ANREDE1'} = "Lieber Herr $n" if ($mw eq "m");
$entry->{'ANREDE1'} = "Liebe Frau $n" if ($mw eq "w");
$entry->{'ANREDE2'} = "Viele Grüße";
}
return($entry);
}
#*******************************************************************
sub vcard {
my $self = shift;
my $files = shift;
my $text0 = shift;
my $file; my $o; my $text; my $file1; my $zaehler;
foreach $file ($text0,split(/,/,$files)) {
$file1 = $file;
next if ($file1 !~ /\n/ and $file1 !~ s/^(.*)\.txt$/$1/);
if ($file1 !~ /\n/) {
open(FFILE,"<$file1.txt");
$text = join("",<FFILE>);
close(FFILE);
} else {
$file1 = "";
$text = $text0;
}
$text =~ s/
//gs;
$text =~ s/^[A-Z0-9\, ]+\n\-+ *\n//;
$text =~ s/^[ \n]+//s;
$text =~ s/^(.*?)[ \n\"]+$/$1/s;
$text = $text . "\n";
$text =~ s/\n/\",\"\n/gs;
$text =~ s/\"\",\"\n/\"\n/gs;
$text =~ s/\n\",\"\n/\n\"\n\"\n/gs;
# print $text; exit;
$text =~ s/(\n|^)([^\n\:]*)(ostfach|Straße|strasse|Strasse|straße|str\.|Str\.)/xxxxxSTRASSE: $2$3/gs;
$text =~ s/(,|\||\;) +(D-|)(\d\d\d\d\d)/\n$3/;
$text =~ s/(\n|^)(D-|)(\d\d\d\d\d) +/$1PLZ: $3\",\"\nSTADT: /gs;
$text =~ s/(\n|^)(http|www\S+)/$1HTTP: $2/gs;
$text =~ s/(\n|^)(Mailto\: *)/$1/gs;
$text =~ s/(\n|^)([^\n\:]+\@)/$1MAIL: $2/gs;
$text =~ s/(\n|^)([0123456789\(\)\-\/ \+]+)/$1Tel: $2/gs;
$text =~ s/(Telefon|Telefon\/Phone|Phone|Tel|Fon|Prione)[\.\:]? *([\+\/\(\) \-0123456789]+)/xxxxxTEL: [$2]/gs;
$text =~ s/(Telefax|Fax)[\.\:]? +([\+\/\(\) \-0123456789]+)/xxxxxFAX: [$2]/gs;
$text =~ s/(Mobil|Mob|Mobiltel)[\.\:]? *([\+\/\(\) \-0123456789]+)/xxxxxMOBIL: [$2]/gs;
$text =~ s/(\n|^)(Dr\.|Prof\. *Dr\.) +(\S+) +(\S+)/$1TITLE: $2\",\"\nVORNAME: $3\",\"\nNAME: $4/gs;
$text =~ s/(\n|^)([A-ZÖÄÜ][a-zäöüß]+) +([A-ZÖÄÜ][a-zäöüß]+) *\",\"\n/$1VORNAME: $2\",\"\nNAME: $3\",\"\n/gs;
$text =~ s/\nxxxxx/\n/gs;
$text =~ s/xxxxx/\n/gs;
while ($text =~ s/\[([\+\/\(\) \-0123456789]+)\]/---X-Y-Z---/) {
$o = $1;
$o =~ s/\((\d+)\)/$1\//;
$o =~ s/^(\+|00) *49 */0/;
$o =~ s/ /\// if ($o !~ /\//);
$o =~ s/[ \(\)]//g;
$text =~ s/---X-Y-Z---/$o/;
}
$text = [split(/\n/,$text)];
$zaehler = 0;
foreach $o (@$text) {
$zaehler = 0 if ($o =~ /^\"$/);
next if ($o =~ /^\"$/);
next if ($o =~ /\:/);
next if ($o =~ /^\"/);
$zaehler = sprintf("%02u",$zaehler+1);
$o = "INST$zaehler: " . $o;
}
$text = join("\n",@$text);
$text = "REST\n\----\n\"\n" . $text . "\n\"\n";
if (!$file1) {
print $text;
} else {
open(FFILE,">$file1.csv");
print FFILE $text;
close(FFILE);
print "$file1.csv\n";
}
}
}
#*******************************************************************
#*******************************************************************
sub xxanrede {
my $self = shift;
my @pars = @_;
$self->{'ADR'} = [ map { $self->anrede_entry($_,@pars) } @{$self->{'ADR'}} ];
}
#*******************************************************************
sub xxfilter { my $self = shift; $self->{'ADR'} = $self->find(@_); }
#*******************************************************************
sub xxfind {
my $self = shift;
my $pattern = shift || "~,";
my $erg = [];
my $o; my $o1; my $o2; my $o3;
foreach $o (@{$self->{'ADR'}}) {
next if ($o->{'DELETE'});
$o1 = Dumper($o);
foreach $o2 (split(/~/,$pattern)) {
foreach $o3 (split(/,/,$o2)) {
next if ($o1 =~ /$o3/i);
$o2 = "";
last;
}
if ($o2) {
push(@$erg,{%$o});
$o1 = "";
last;
}
last if (!$o1);
}
}
return($erg);
}
#*******************************************************************
sub xxcsv {
my $self = shift;
$self->export(@_);
my $text = $self->{'CSV'};
delete($self->{'CSV'});
return($text);
}
#*******************************************************************
sub xxexport {
my $self = shift;
my $template = shift;
my $sort = shift;
my $delete_doublettes = "";
if ($sort =~ s/^\.(.*)$/$1/) {
$delete_doublettes = "merge";
}
my $fields = "";
if ($template eq "PERL") {
$template = $template . ":NAME,VORNAME,TITEL,STRASSE,PLZ,STADT,TEL,MOBIL,MAIL,SEX,INDEX,BEMERKUNG,xKTO,xBANK,xBLZ,REST,xDBL";
}
elsif ($template eq "CSV") {
$template = $template . ":DBL,NAME,VORNAME,STRASSE,PLZ,STADT,TEL,MOBIL,MAIL,KTO,BLZ,BANK,INDEX,STIMM,BEMERKUNG";
}
if ($template =~ s/^(PERL|CSV)\://) {
$fields = $template;
$template = $1;
}
# if (!(ref($fields))) { $fields = [split(/,/,$fields)]; }
my $o; my $o1; my $o2; my $fields1;
my $text = <<'TEXT_ENDE';
package Adressen_export;
sub adressen {[
#map { bless($_,"adressen3") }
(
TEXT_ENDE
my $xls = "";
my $erg = [];
my $title = "";
my $bed = 0;
if (!$fields) { $bed = 1; }
my $doubleentry = "";
my $doubleentry0;
my $md5key;
my $entries = $self->{'ADR'};
my $mergeobj = "";
my $text3 = [];
my $xls3 = [];
foreach $o (sort { $self->ff($sort,$a) cmp $self->ff($sort,$b) } @$entries) {
# print "WW: $o->{'NAME'}\n";
$xls = "";
$text = "";
$text = $text . "\n\n\{\n" if ($template eq "PERL");
$doubleentry0 = $doubleentry;
$doubleentry = $self->ff($sort,$o);
$o->{'DBL'} = " ";
if ($doubleentry eq $doubleentry0) {
$o->{'DBL'} = "x";
}
# elsif ($doubleentry) {
# $md5key = $o->{'MD5KEY'};
# $o->{'xMD5KEY'} = " ";
# }
if ($delete_doublettes and $o->{'DBL'} =~ /\S/) {
$self->$delete_doublettes($o,$mergeobj);
if ($template eq "PERL") { pop(@$text3); }
elsif ($template eq "CSV") { pop(@$xls3); }
else { pop(@$erg); }
}
$mergeobj = $o;
if ($bed) { $fields = [keys %$o]; }
$title = "";
$fields1 = $fields;
if ($fields =~ /,REST,/) {
$o1 = { map { ($_,1) } sort keys %$o };
map { delete ($o1->{$_}) } split(/,/,$fields);
$o1 = join(",","",keys %$o1,"");
$fields1 =~ s/,REST,/$o1/;
}
foreach $o1 (split(/,/,$fields1)) {
next if (!$o1);
next if ($o1 !~ /^(x?)[\_A-Z0-9\.]+$/);
# $title = $title . $o1 . "\;";
$o2 = $o->{$o1};
$o2 =~ s/\n/ /gs;
$xls = $xls . $o2 . "\;" if ($template eq "CSV");
$o2 = length($o1);
$o2 = 20 if ($o2 < 20);
next if ($o->{$o1} !~ /\S/ and $o1 =~ /^x/);
if ($template eq "PERL") {
$text = $text . substr((($o1=~/^x(.*)$/) ? " $1":$o1)." ",0,$o2) . " => ";
if ($o->{$o1} =~ /\n/) {
$o->{$o1} =~ s/\n*$//s;
$text = $text . "<<'XXX',\n" . $o->{$o1} . "\nXXX\n";
} else {
$text = $text . "'" . $o->{$o1} . "',\n";
}
}
}
if ($template eq "PERL") { $text = $text . "\},\n"; push(@$text3,$text); }
elsif ($template eq "CSV") { $xls = $xls . "\n"; push(@$xls3,$xls); }
else {push(@$erg,$self->ff($template,$o)); }
}
$text = join("","sub adressen {\[(",@$text3);
$xls = join("",@$xls3);
if ($template eq "PERL") {
$text =~ s/,\n$//s;
$text = $text . "\n )\]\n\n\}\n\n\n1;\n";
$text =~ s/TITEL +\=\> +'',\n//gs;
return($text);
}
if ($template eq "CSV") {
$xls = $title . "\n" . $xls;
$xls =~ s/\; +\;/\;\;/gs;
$xls =~ s/\n\;/\n \;/gs;
return($xls);
}
return($erg);
}
#***************************************************************************
sub xxmerge {
my $self = shift;
my $obj = shift;
my $diff = shift || {};
my $o; my $o1; my $zaehler; my $name;
foreach $o (keys %$diff) {
$o1 = $diff->{$o};
if ($o1 =~ /\S/ and !($obj->{$o})) {
$obj->{$o} = $o1;
}
elsif ($o1 =~ /\S/ and $obj->{$o} ne $o1) {
$name = $o;
$zaehler = 0;
if ($name =~ s/^(.*)\_(\d+)$/$1/) {
$zaehler = $2;
}
while (0 == 0) {
$zaehler = $zaehler + 1;
next if (exists ($obj->{$name."_".$zaehler}));
if ($name =~ /^(STIMM|INDEX|BEMERKUNG)$/) { $obj->{$name} = $obj->{$name} . " " . $o1; }
elsif ($name =~ /^.+$/) { $obj->{$name} = $obj->{$name} . "|" . $o1; }
else { $obj->{$name."_".$zaehler} = $o1; }
last;
}
}
}
# print Dumper($obj);
}
#******************************************************************
sub xxnamerest {
my $self = shift;
my $x = shift;
my $fields = shift;
my $r = { map { ($_,1) } keys %$x };
my $o;
foreach $o (@$fields) {
delete ($r->{$o});
}
return(join(",",["",keys %$r,""]));
}
#*******************************************************************
sub xxdata {
my $self = shift;
my $text = shift;
$self->{'DATA'} = $text;
my $ee = [];
my $o;
foreach $o (split(/\n/,$text)) {
push(@$ee,$o."\n");
}
return($ee);
}
#*******************************************************************
sub xxff {
my $self = shift;
my $text = shift;
my $entry = shift;
my $o; my $o1;
$text =~ s/-(x[A-Z0-9\.\_]+)-/$entry->{$1}/gs;
while ($text =~ /(-[A-Z0-9\_]+-)/) {
$o = $1;
$o1 = $entry->{$o} || $o;
$text =~ s/$o/$o1/gs;
}
return($text);
}
#*******************************************************************
sub NAME { my $e = shift; _N($e); $e->{'NAME'} }
sub VORNAME { my $e = shift; _N($e); $e->{'VORNAME'} }
sub _N {
my $e = shift;
return() if ($e->{'N'} !~ /^(.+?\S) +(\S+)$/);
$e->{'NAME'} = $e->{'NAME'} || $2;
$e->{'VORNAME'} = $e->{'VORNAME'} || $1;
$e->{'N'} = "";
}
sub TEL { my $e = shift; _T($e,'TEL'); }
sub FAX { my $e = shift; _T($e,'FAX'); }
sub _T {
my $e = shift;
my $f = shift;
my $x = $e->{$f};
$x =~ s/ //gs;
$x =~ s/\++49\(?0?\)? */0/gs;
$x =~ s/\|/\//gs;
$x =~ s/\((\d+)\)/$1\//gs;
return($x);
}
sub STARTTIME { my $e = shift; _TIME($e); $e->{'STARTTIME'} }
sub ENDTIME { my $e = shift; _TIME($e); $e->{'ENDTIME'} }
sub VELOC { my $e = shift; _TIME($e); $e->{'VELOC'} }
sub DISTWARN { my $e = shift; _TIME($e); $e->{'DISTWARN'} }
sub DISTANCE { my $e = shift; _TIME($e); $e->{'DISTANCE'} }
sub WTAG { my $e = shift; _TIME($e); $e->{'WTAG'} }
sub _TIME {
my $e = shift;
return() if (exists ($e->{'VELOC'}));
if ($e->{'TIME'} =~ /^([^\-]*)\-([^\-]*)$/) {
$e->{'START'} = $1;
$e->{'END'} = $2;
$e->{'START'} = $e->{'START'} . ":00" if ($e->{'START'} !~ /[\.\:]/);
$e->{'END'} = $e->{'END'} . ":00" if ($e->{'END'} !~ /[\.\:]/);
}
my $o = [reverse (split(/[\.\:]/,$e->{'START'}))];
$e->{'STARTTIME'} = DivBasicF::ParseDate::parsedate($e->{'DATE'}." ".$o->[1].":".$o->[0],UK=>1) + 86400*($o->[2]);
$o = [reverse (split(/[\.\:]/,$e->{'END'}))];
$e->{'ENDTIME'} = DivBasicF::ParseDate::parsedate($e->{'DATE'}." ".$o->[1].":".$o->[0],UK=>1) + 86400*($o->[2]);
$e->{'KOORD'} = $e->{'ORT'};
$e->{'KOORD'} = "47.43 10.42" if ($e->{'ORT'} =~ /F(ü|ue)ssen/);
$e->{'KOORD'} = "48.02 11.11" if ($e->{'ORT'} =~ /Hechendorf/);
$e->{'KOORD'} = "48.02 11.11" if ($e->{'ORT'} =~ /Hechendorf/);
$e->{'KOORD'} = "48.08 11.34" if ($e->{'ORT'} =~ /M(ü|ue)nchen/);
$e->{'KOORD'} = "49.29 10.59" if ($e->{'ORT'} =~ /F(ü|ue)rth/);
$e->{'KOORD'} = "51.40 8.21" if ($e->{'ORT'} =~ /Lippstadt/);
$e->{'KOORD'} = "53.33 10.00" if ($e->{'ORT'} =~ /Hamburg/);
$e->{'KOORD'} = "52.09 9.57" if ($e->{'ORT'} =~ /Hildesheim/);
$e->{'KOORD'} = "47.00 10.30" if ($e->{'ORT'} =~ /Tirol/);
$e->{'DISTANCE'} = 0;
$o = join(" ",sort($e->{'KOORD'},$main::___csv___->{'koord'}));
if ($o =~ /^ *(\d+)\.(\d+) +(\d+)\.(\d+) +(\d+)\.(\d+) +(\d+)\.(\d+) *$/) {
$e->{'DISTANCE'} = sprintf("%3.4f", sqrt( 111**2*($1+$2/60 - $5-$6/60)**2 + 75**2*($3+$4/60 - $7-$8/60)**2 ));
}
else {
$e->{'DISTANCE'} = 0;
}
# print "SD: $e->{'STARTTIME'} --- $main::___csv___->{'endtime'}\n";
$e->{'VELOC'} = 3600 * sqrt($e->{'DISTANCE'})/($e->{'STARTTIME'} - $main::___csv___->{'endtime'} + 30) || "0.0";
$e->{'DISTWARN'} = "XX" if ($e->{'VELOC'} < 0);
$e->{'DISTWARN'} = "X" if ($e->{'VELOC'} > 1);
$e->{'WTAG'} = ("So","Mo","Di","Mi","Do","Fr","Sa")[ (localtime($e->{'STARTTIME'}))[6] ];
$main::___csv___->{'koord'} = $e->{'KOORD'};
$main::___csv___->{'endtime'} = $e->{'ENDTIME'};
}
1;