| Current Path : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/Application/ |
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/Application/IfTFiBu.pm |
#print Dumper (Application::IfTFiBu->new()->shell(@ARGV));
package Application::IfTFiBu;
use strict;
use Algorithm::Diff;
use Digest::SHA1;
use Data::Dumper;
use Cwd;
use Application::IfTRules;
use DBI;
use DBD::SQLite;
our $extern_gesamt;
our $extern_rules;
# our $slash = "/";
#*****************************************************************
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = {};
$self->{'KONTEN'} = shift;
bless($self,$class);
return($self);
}
#*****************************************************************
sub shell {
my $self = shift;
my $cmd = shift;
my $dir = shift;
my $active = shift; # Versions-File
my $merge = shift; # Merge-File
my $pars = [@_];
$dir =~ s/[\\\/]+$//;
my $o; my $o1; my $kto;
if ($cmd eq "c") { $cmd = "csv"; }
elsif ($cmd eq "k") { $cmd = "kto"; }
elsif ($cmd eq "s") { $cmd = "sql"; }
elsif ($cmd eq "i") { $cmd = "import"; }
elsif ($cmd eq "j") { $cmd = "import"; $dir = "." . $dir; }
elsif ($cmd eq "e") { $cmd = "edit"; }
elsif ($cmd eq "p") { $cmd = "prune"; }
elsif ($cmd eq "r") { $cmd = "rule"; }
elsif ($cmd eq "a") { $cmd = "edit"; if ($dir) { $dir = $dir . "/REARRANGE" } else { $dir = "REARRANGE" } }
if ($cmd =~ /^(csv|kto)$/) { # Exportieren des entsprechenden Kontos
$main::XCONSOLE = 1;
if ($dir =~ s/^(.*[\\\/])(.*)$/$1/) {
$kto = $2;
}
elsif ($dir) {
$kto = $dir;
$dir = "";
}
if (!$kto and !$dir) {
$kto = Cwd::cwd();
$kto =~ s/^(.*)[\\\/](.*)$/$2/;
chdir("..");
}
$active = $self->shell_versions($dir,$active);
return($active) if (!(ref($active)));
if ($merge) { # Im Falle eines Merge
foreach $o (@$active) {
$o1 = $self->mergekonto_txt($kto,$cmd,$o,$dir,$merge);
#print $o1;
#exit;
return($o1) if ($o1 !~ s/^ERROR/WARNING/);
print $o1 . "\n";
}
return("ERROR: File could not be merged, no target found anymore.");
} else {
return(join("\n ","ERROR: Ambiguous source file, please take it from the list:",@$active)) if ($#$active > 0);
return($self->mergekonto_txt($kto,$cmd,$active->[0],$dir));
}
}
elsif ($cmd eq "import") { # Importieren in das uebergeordnete Konto
$o1 = "";
$o1 = "." if ($dir =~ s/^\.//); # Import OHNE Re-Formatting
$active = $self->shell_versions($dir,$active);
return($active) if (!(ref($active)));
return(join("\n ","ERROR: Ambiguous source file, please take it from the list:",@$active)) if ($#$active > 0);
if (!$dir) {
$dir = Cwd::cwd();
$dir =~ s/^(.*)[\\\/](.*)$/$2/;
chdir("..");
}
$o = shift(@$active);
if ($o =~ /^(.*)\.(.*)$/) {
$cmd = substr($2,0,1);
$self->shell($cmd,$dir,"",$o1.$o);
}
}
elsif ($cmd eq "prune") { # alle Unterkonten loeschen
$dir = $dir || ".";
$dir =~ s/[\\\/]+$//;
opendir(DDIR,$dir);
$kto = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
if ($active and (-f "$dir/$o")) {
if ($o =~ /\~$/ or ($o =~ /\.(csv|kto|sql)$/ and $o !~ /^sync/)) {
unlink("$dir/$o");
}
}
next if ($o =~ /^\./);
push(@$kto,$o) if (-d "$dir/$o");
}
closedir(DDIR);
foreach $o (@$kto) {
$self->shell("prune","$dir/$o","all");
rmdir("$dir/$o");
}
return("OK: Directory $dir cleared.");
}
elsif ($cmd eq "rule") {
if (!$dir) {
$dir = Cwd::cwd();
$dir =~ s/^(.*)[\\\/](.*)$/$2/;
chdir("..");
$o1 = 1;
}
$self->shell("kto",$dir);
system("cd $dir; perl rule.pl $active $merge " . join(" ",@$pars));
$self->shell("a","$dir");
$self->shell("import",$dir);
chdir($dir) if ($o1);
return("OK: Rule applied");
}
# Rules
# elsif (-f $dir) {
# $self->rule($cmd,$dir);
# }
else {
if (!$dir) {
$dir = Cwd::cwd();
$dir =~ s/^(.*)[\\\/](.*)$/$2/;
chdir("..");
$o1 = 1;
}
$o = $self->shell("kto",$dir,$active);
return($o) if ($o !~ /^OK\: +(\S+)/);
$self->editor($1);
chdir($dir) if ($o1);
$self->shell("import",$dir);
}
}
#*****************************************************************
sub shell_versions {
my $self = shift;
my $dir = shift || ".";
my $active = shift;
my $o; my $o1;
if ($active) { # wenn ein Versions-File mit angegeben wurde
return("ERROR: Source file $active does not exist in " . ($dir||".")) if (!(-f($dir."/".$active)));
$active = [[$active,"A"]];
} else {
opendir(DDIR,$dir||"."); # ansonsten eine Liste aller Versions-Files erstellen
$active = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o !~ /^(.*)\.(csv|kto|sql)$/);
next if ($o =~ /^sync/);
next if ($o =~ /~$/);
$o1 = $2;
if ($o1 eq "kto") { $o1 = "A"; }
if ($o1 eq "csv") { $o1 = "B"; }
if ($o1 eq "sql") { $o1 = "C"; }
push(@$active,[$o,$o1]);
}
closedir(DDIR);
}
return("ERROR: No source file") if (!@$active);
$active = [ sort { $a->[1] cmp $b->[1] } @$active ];
$active = [ map { $_->[0] } @$active ];
foreach $o (@$active) {
return($o) if ($o =~ /$dir\./ and $#$active > 1); # Standard-File
}
return($active);
}
#*****************************************************************
# Exportiert eine Unterbuchhaltung aus einer gegebenen
#
sub mergekonto_txt {
my $self = shift;
my $kto = shift; # zu ermittelnde Unterbuchhaltung
my $format = shift; # Zielformat
my $active = shift; # Quell-Version
my $dir = shift; # Verzeichnis, in dem sich das Quellfile befindet
my $merge = shift; # Versions-File, welches zu mergen ist
my $diff; my $merged; my $anzahl_zeilen; my $zeile; my $zeile1;
my $o; my $o1; my $zaehler; my $kto0; my $kto1; my $kto2;
my $rearrange = ($merge !~ s/^\.//);
# my $merge_raw = $merge;
# $merge_raw =~ s/([a-z0-9][a-z0-9][a-z0-9][a-z0-9]\.$format)$/$1/;
# 1. Auslesen der Quelldaten
$self->mm("Start Unterkonto-Berechnung");
open(FFILE,"<$dir$active");
my $text = [<FFILE>];
my $text0 = join("",@$text);
$text0 =~ s/
//g;
close(FFILE);
return("ERROR: Kto has to be re-formatted firstly\n") if ($merge and $kto ne "REARRANGE" and $text0 =~ /^[^\n]+ /);
# $active =~ /^(.*)[a-z0-9][a-z0-9][a-z0-9][a-z0-9]\.[^\.]*$/; # hier waere die Versionierung
$active =~ /^(.*)\.[^\.]*$/;
my $file = $dir . $kto . "/" . $1 . "_" . $kto .
# $self->ident_key($text0,$active) .
"." . $format; # Ergebnisfile
$self->mm("Berechne Zielfilename $file");
if ($merge) {
# if ("$dir$kto/$merge_raw" ne $file) {
# return("ERROR: Merge file $active not matching");
# }
if (!(-f("$dir$kto/$merge"))) {
return("ERROR: Merge file not found"); # Merge-File wurde nicht gefunden
}
}
elsif (-f($file)) {
return("ERROR: Version $active of Subkto $kto already exists, please move it away.");
}
$o = $kto;
$o =~ s/\-(SUM|)[123456789ABCIJKLMNP]$//; # Monats- und Quartalsunterkonten ausschliessen
$text = join("","\n",grep(/$o/,@$text));
# $text =~ s/ \-$o/ \-__XX_YY_ZZ__/g;
# $text =~ s/\n$o/\n__XX_YY_ZZ__/gs;
# $text = join("\n","\n",grep(/__XX_YY_ZZ__/,split(/\n/,$text)));
# $text =~ s/__XX_YY_ZZ__/$o/g;
$text = $kto."\n".$self->to_txt($kto,$text,$format,$dir.$kto."/"); # Urspruenglicher Export
mkdir($dir.$kto);
# 1. --- Change mode -----------------------------------------------
if ($merge) {
if ($kto =~ /\-(SUM|)([123456789ABCIJKLMNP])$/) {
unlink($file);
unlink($file."~");
rmdir($dir.$kto);
return("OK: No merge possible.");
}
$kto0 = Cwd::abs_path($dir.$kto);
$kto0 =~ s/^(.*)[\\\/](.*)[\\\/](.*)$/$2/; # uebergeordnete Konten
$diff = $self->compute_diff($text,"$dir$kto/$merge");
$self->mm("... berechne Diff dazu");
return($diff) if (!(ref($diff)));
$merged = 0;
# $anzahl_zeilen = $text0;
# $anzahl_zeilen =~ s/[^\n]//gs;
# $anzahl_zeilen = length($anzahl_zeilen);
foreach $zeile (split(/\n/,$diff->[0])) { # delete list
$zeile =~ s/
//g;
$zeile1 = "";
$zeile = $self->reformat_formel($zeile,$kto,1);
$zeile =~ s/[\/\\\[\]\+\(\)\?\.\*]/\./g;
$zeile =~ s/\{/\{.?.?/g; # wegen evtl. umgekehrter Reihenfolge ...
$zeile =~ s/\}/.?\}/g; # ... der Konten
if ($zeile !~ /\{/ and
$zeile =~ /^(\d\d\d\d\d\d\d\d)[; ]+-?(\d+\.\d\d)[; ]+\:*([^ :;]*?)\-?[; ]+\:*([^ :;]*?)\-?[; ]+-?\d+\.\d\d[ ;]+(.*?)[ ;]*$/) {
$zeile1 = "($1\[ ;\]+-?$2\[ ;\]+?\[^ ;\]*?$kto-?$3\[ ;\]+?\[^ ;\]*?$4\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5" .
"|$1\[ ;\]+-?$2\[ ;\]+?\[^ ;\]*?$4\[ ;\]+?\[^ ;\]*?$kto-?$3\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5)";
}
elsif (
$zeile =~ /^(\d\d\d\d\d\d\d\d)[; ]+-?(\d+\.\d\d)[; ]+\:*([^ :;]*?)\-?[; ]+\:*([^ :;]*?)\-?[; ]+-?\d+\.\d\d[ ;]+(.*?)[ ;]*$/) {
$zeile1 = "($1\[ ;\]+-?\\d+\.\\d\\d\[ ;\]+?\[^ ;\]*?$kto-?$3\[ ;\]+?\[^ ;\]*?$4\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5" .
"|$1\[ ;\]+-?\\d+\.\\d\\d\[ ;\]+?\[^ ;\]*?$4\[ ;\]+?\[^ ;\]*?$kto-?$3\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5)";
# $zeile1 = "($1\[ ;\]+-?$2\[ ;\]+?\[^ ;\]*$3\[ ;\]+?\[^ ;\]*$4\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5" .
# "|$1\[ ;\]+-?$2\[ ;\]+?\[^ ;\]*$4\[ ;\]+?\[^ ;\]*$3\[ ;\]+?\-?\\d+\\.\\d\\d\[ ;\]+?$5)";
}
elsif ($zeile =~ /^([^ ;]*)[ ;]+([^ ;\-0123456789][^ ;]*)[ ;]*(.*)/) { # Konto-Bezeichner
# $zeile1 = "$kto\-$1\-?\[ ;\]+$2\[ ;\]+\-?\\d+\\.\\d\\d";
$zeile1 = "$kto\-?$1\-?\[ ;\]+$2";
}
if ($zeile1) { # hier die eigentliche DELETE-Operation
# $o1 = $zeile1;
# $o1 =~ s/[^\n]//gs;
$merged = $merged + 1;
# return("ERROR: Line not found: $zeile $zeile1\n") if ($zeile1 and $text0 !~ s/\n$zeile1[ ;]*//gs);
return("ERROR: Line not found: $zeile with $zeile1\n") if ($text0 !~ s/\n$zeile1[^\n]*//s);
return("ERROR: Double line: $zeile with $zeile1\n") if ($text0 =~ /\n$zeile1[^\n]*/s);
} # mit diesen beiden Zeilen genauere Angabe bei Double line als mit der einen darueber, aber aufwendiger
}
# $o1 = $text0;
# $o1 =~ s/[^\n]//gs;
# $o1 = length($o1);
# return("ERROR: Double line, check the original file\n") if ($anzahl_zeilen - $merged != $o1);
$self->mm("... delete actions done");
foreach $zeile (split(/\n/,$diff->[1])) { # add list
$merged = 1;
if ($zeile =~ s/^(\d\d\d\d\d\d\d\d[; ]+)([^ ;]+)([; ]+)([^ ;]+)([; ]+)([^ ;]+)(.*?)[ ;]*$/$1---BETRAG---$3---KTO1---$5---KTO2---$7/) {
$kto1 = $4;
$kto2 = $6;
$o1 = sprintf("%3.2f",eval($2));
if ($kto1 !~ s/^\-/\-$kto\-/) { if ($kto1 !~ s/^\://) { $kto1 = "-" . $kto1; }} else { $kto1 =~ s/\-$//; }
if ($kto2 !~ s/^\-/\-$kto\-/) { if ($kto2 !~ s/^\://) { $kto2 = "-" . $kto2; }} else { $kto2 =~ s/\-$//; }
$zeile =~ s/---BETRAG---/ $o1 /;
$zeile =~ s/---KTO1---/ $kto1 /;
$zeile =~ s/---KTO2---/ $kto2 /;
$zaehler = 1;
$o = [];
$zeile = $self->reformat_formel($zeile,$kto); # Auswerten der Formeln
}
elsif ($zeile =~ /^\S/) {
$zeile = $kto . "-" . $zeile;
}
else {
$zeile = $kto . $zeile;
}
$text0 = $text0 . $zeile . "\n";
}
$merged = 1 if ($kto eq "REARRANGE");
if ($merged and $active =~ /^(.*)\.(.*)$/) {
$o = $2;
$self->mm("Diff anwenden");
if ($rearrange) {
$text = $kto0."\n".$self->to_txt("",$text0,$o,$dir);
} else {
$text = $text0;
}
} else {
$self->mm("... keine Aenderung");
}
unlink($file);
unlink($file."~");
rmdir($dir.$kto);
$file = $dir.$active;
return("OK: Merge was not necessary.") if (!$merged);
}
# 7. Abspeichern der Ergebnisdatei ----------------------------------------
open(FFILE,">$file");
$text =~ s/
//g;
print FFILE $text;
close(FFILE);
return("OK: $kto merged into its ancestor") if ($merged);
return("OK: $file created.");
}
#******************************************************************************
sub reformat_formel {
my $self = shift;
my $zeile = shift;
my $kto = shift;
my $mode = shift;
my $o; my $o1;
my $zaehler = 0;
$zeile =~ s/\{(.*?)\}/\{ $1 \}/;
while (0 == 0) { # Auswerten der Formeln
last if ($zeile !~ s/\{(.*?)([ ;\(\)\[\]\{\}\+\*])([\:a-zA-Z0-9][\:a-zA-Z0-9\-\_]*)([ ;\(\)\[\]\{\}\+\*])(.*?)\}/\{$1$2...FORMEL...$4$5\}/g);
push(@$o,$3);
$zaehler = $zaehler + 1;
}
foreach $o1 (@$o) {
if ($o1 !~ s/^\://) { $o1 = $kto . "-" . $o1 }
$zeile =~ s/\.\.\.FORMEL\.\.\./$o1/;
}
$zeile =~ s/\{ *(.*?) *\}/\{$1\}/;
# if ($mode) { $zeile =~ s/ +([^\+\*])/ \*$1/gs; }
return($zeile);
}
#******************************************************************************
sub to_txt {
my $self = shift;
my $kto = shift;
my $text = shift;
my $format = shift;
my $dir = shift;
print "ENTERED $dir....\n";
my $zeile; my $datum; my $betrag; my $kto1; my $kto2; my $remark;
my $o; my $o1; my $o2; my $space; my $tab; my $sum; my $kto3; my $xtab; my $ytab;
my $buchh; my $md5; my $kto9; my $neg; my $buchh0; my $ident_key;
my $name; my $formel; my $formel1; my $text1; my $monat; my $quartal;
my $kto4; my $kto5; my $kto7; my $dir1; my $dir2; my $buchh;
my $bezeichner = {};
my $gesamt = {};
my $rules = [];
$extern_gesamt->{$dir} = $gesamt;
$extern_rules->{$dir} = $rules;
# $extern_dirs = [reverse sort keys %$extern_gesamt];
my $o3 = 0; if (ref($kto)) { $kto = ""; $o3 = 1; }
#----------------------------------
# 0. Abgrenzung von Buchungen zu gewissen Unterkonten
my $ukto = "";
if ($kto =~ s/\-(SUM|)([123456789ABCIJKLMNP])$//) {
$ukto = $1 . $2 . ",";
$ukto =~ s/(\d)/0$1/;
$ukto =~ s/A,/10,/;
$ukto =~ s/B,/11,/;
$ukto =~ s/C,/12,/;
$ukto =~ s/I,/01,02,03,/;
$ukto =~ s/J,/04,05,06,/;
$ukto =~ s/K,/07,08,09,/;
$ukto =~ s/L,/10,11,12,/;
$ukto =~ s/M,/01,02,03,04,05,06,/;
$ukto =~ s/N,/07,08,09,10,11,12,/;
$ukto =~ s/P,/01,02,03,04,05,06,07,08,09,10,11,12,/;
while ($ukto =~ s/^SUM(\d\d)/,$1/) {
$ukto = "SUM" . sprintf("%02u",$1-1) . $ukto;
$ukto =~ s/^SUM00//;
}
}
$ukto =~ s/^([^,])/,$1/;
# print "UU: $ukto $kto\n"; exit;
# print "Q $o3 " . Dumper($extern_gesamt);
#---------------------------------
# 1. Auswerten aller Zeilen
my $text1 = [];
my $text0 = [split(/\n/,$text)];
$self->mm("Start Auswerten ($dir)");
foreach $zeile (@$text0) {
if ($zeile =~ /^(\d\d\d\d\d\d\d\d)[; ]+(-?\d+\.\d\d)[; ]+([^ ;]+?)[; ]+([^ ;]+?)([; ]+)(.*)/) {
# 1.1. Auslesen der Elemente der Zeile
$datum = $1;
$betrag = $2;
$kto1 = $3;
$kto2 = $4;
$o = $5;
$remark = $6;
$remark =~ s/^\-?\d+\.\d\d[; ]+//;
if ($remark =~ /^(19|7) v\.H\./) { # Einrueckung, falls $remark mit einer Ziffer beginnt (f. Umsatzsteuerangaben)
if ($format =~ /^(kto|lgh)$/) { $remark = " " . $remark }
else { $remark = ";" . $remark }
}
if ($kto) { # Renormierung
if ($kto1 !~ s/^\-$kto//) { if ($kto1 !~ s/^\-//) { $kto1 = ":" . $kto1; }}
if ($kto2 !~ s/^\-$kto//) { if ($kto2 !~ s/^\-//) { $kto2 = ":" . $kto2; }}
}
$kto3 = 1;
$kto4 = 1;
$kto3 = 0 if ($kto1 =~ /^\-/ or !$kto1); # ist relatives Konto
$kto4 = 0 if ($kto2 =~ /^\-/ or !$kto2); # ist relatives Konto
$kto5 = 0; # kein Umdrehen der Konten
if ($kto3 and $kto4) {
$kto5 = 9;
}
elsif ($kto3 and !$kto4) {
$kto5 = 1;
}
elsif (!$kto3 and $kto4) {
$kto5 = 0;
}
elsif (!$kto3 and !$kto4) {
if ($kto2 =~ /RULE$/) {
$kto5 = 1;
} else {
$kto5 = 0;
}
}
$monat = substr($datum,4,2);
# print "RR: $monat $ukto\n"; sleep 1;
next if ($kto5 == 9);
if ($kto5) {
$betrag = (-1) * $betrag;
$kto3 = $kto1;
$kto1 = $kto2;
$kto2 = $kto3;
if ($remark !~ s/\{ *\-(.*?)\}/\{$1\}/) {
$remark =~ s/\{(.*?)\}/\{\-\($1\)\}/;
}
}
# 1.2. Monats- und Quartal-Unterkonten
next if ($ukto and ($ukto !~ /,$monat,/ or substr($datum,4) eq "0101"));
if ($monat == 10) { $monat = "A" }
elsif ($monat == 11) { $monat = "B" }
elsif ($monat == 12) { $monat = "C" }
else {$monat = sprintf("%1u",$monat); }
if ($monat =~ /[123]/) { $quartal = "I"; }
elsif ($monat =~ /[456]/) { $quartal = "J"; }
elsif ($monat =~ /[789]/) { $quartal = "K"; }
else { $quartal = "L"; }
# 1.3. Formeln formatieren und evaluieren
#if ($o3) {
# print Dumper($extern_gesamt); exit; }
$formel = "";
if ($remark =~ s/\{(.*?)\}/\.\.\.FORMEL\.\.\./) {
$formel = " " . $1 . " ";
while ($formel =~ s/^ *\( *(.*?) *\) *$/$1/) { 1; }
$formel = "\{ " . $formel . " \}";
$formel =~ s/([ ;\(\)\[\]\{\}\+\*])/ $1 /g;
$formel =~ s/ \-/ \- /g;
$formel =~ s/ \+ *\- / \- /g;
if ($kto) { # Renormierung
$formel =~ s/ ([a-zA-Z0-9\:][a-zA-Z0-9\-\_]*) / :$1 /g;
$formel =~ s/ \:$kto\-([a-zA-Z0-9\_\-]+) / $1 /g;
}
$o = $formel;
$o =~ s/ *([ ;\(\)\[\]\{\}\+\*]) */$1/g;
$o =~ s/^ *\{ *(.*?) *\} *$/\{$1\}/;
$remark =~ s/\.\.\.FORMEL\.\.\./$o/;
$tab = $o;
$o = "\(\$gesamt->\{'-";
$formel =~ s/([ ;\(\)\[\]\{\}\+\*])(\:*[a-zA-Z0-9][a-zA-Z0-9\-\_]*)([ ;\(\)\[\]\{\}\+\*])/$1$o$2\'\}\)$3/g;
# $formel =~ s/([ ;\(\)\[\]\{\}\+\*])$kto([a-zA-Z0-9\-][a-zA-Z0-9\-\_]*)([ ;\(\)\[\]\{\}\+\*])/$1$o$2\'\}\)$3/g;
# print "FORMEL: $formel\n";
while (0 == 0) {
$kto7 = "";
last if ($formel !~ s/\(\$gesamt->\{\'\-(\:+.*?)\'\}\)/---XX-YY-ZZ---/); # die externen Kontoverweise durchgehen
$kto7 = $1;
$dir1 = $dir;
$dir1 =~ s/^(.*?)[\\\/]*([\\\/])$/$1$2/;
while ( $dir1 =~ /[\\\/]/ ) {
last if ($kto7 !~ /\:/);
last if ($dir1 !~ s/^(.*?)([^\\\/]+[\\\/])$/$1/); # auch das aktuelle Verzeichnis einbeziehen
$kto7 =~ s/^\://;
}
last if ($kto7 =~ /\:/); # Formelaufloesung ist ausserhalb des Fokus des aktuellen Directories
$kto7 = $dir1 . $kto7;
# foreach $o (@$extern_dirs) { # wenn der Verweis sich schon in einem geoeffneten Konto befindet ...
# $o1 = $o;
# $o1 =~ s/[\\\/]/-/g;
# next if ($kto7 !~ /^$o1(.*)$/);
# $o1 = "\(\$extern_gesamt->\{'$o1'\}->\{\'$1\'\}\)";
# $formel =~ s/---XX-YY-ZZ---/$o1/;
# }
$dir2 = $dir1;
while (0 == 0) {
# last if (!(opendir(DDIR,"./$dir2"))); # Suchen des 'tiefsten' Unterkontos
$o1 = $self->shell_versions($dir2); # ... eine Kontodatei
last if (!(ref($o1)) or $#$o1); # ... muss vorhanden sein
opendir(DDIR,"./$dir2");
while (0 == 0) {
$o1 = readdir(DDIR);
last if (!$o1);
next if ($o1 =~ /^\./);
$o1 = $dir2 . $o1;
$o2 = $o1;
$o2 =~ s/[\\\/]/\-/g;
# print "XXX:: $kto7 $o1 -- $o2\n";
next if ($kto7 !~ /^$o2/);
$dir2 = $o1 . "/";
# $dir2 =~ s/\-/\//g;
last;
}
#print "GGG\n"; sleep 3;
last if (!$o1);
closedir(DDIR);
}
#print "$kto7 $dir1 \n";
#print "DD: - $dir1 - $dir2\n"; sleep 1;
if (!(exists($extern_gesamt->{$dir2}))) {
#print "NOT FOUND\n";
# print "OPEN: " . join("---",sort keys %$extern_gesamt) . "\n\n\n\n";
while (0 == 0) {
$o1 = $self->shell_versions($dir2);
last if ($o1 !~ /^ERROR/);
last if ($dir2 !~ s/^(.*?)([^\\\/]+[\\\/])$/$1/);
}
last if ($o1 =~ /^ERROR/);
open(FFILE,"<$dir2" . $o1->[0]); # Datei oeffnen
$o2 = join("",<FFILE>);
close(FFILE);
$o1 =~ /^(.*)\.(.*)$/; # Format suchen
if (!(exists($extern_gesamt->{$dir2}))) {
$o2 = $self->to_txt([],$o2,$2,$dir2); # if ($dir2); # ... warum war mal dieses if ???
}
}
$o1 = $dir2;
$o1 =~ s/[\\\/]/-/g;
$kto7 =~ s/[\\\/]/-/g;
# print "DDD1: $o1 $kto7 $dir2\n";
if ($kto7 =~ /^$o1(.*)$/) {
$o1 = "\(\$extern_gesamt->\{'$dir2'\}->\{\'-$1\'\}\)";
$formel =~ s/---XX-YY-ZZ---/$o1/;
}
}
# print "FF $kto $kto7 $formel\n";
if ($kto7 =~ /\:/) {
$formel = "";
} else {
$o1 = eval ( "sub " . $formel ); # print $@;
# print "FORMEL: --> " . $formel . "\n" if ($@);
# sleep 10 if ($@);
$formel = $o1;
}
# $betrag = 0; # neue Werteberechnung
}
#---------------------------------------------------------------
$zeile = [$datum,$betrag,$kto1,$kto2,$remark,$monat,$quartal,$formel,$tab];
push(@$text1,$zeile);
# print "XX: $formel\n";
push(@$rules,$zeile) if (ref($formel));
# print "QQ $formel $zeile\n";
#---------------------------------------------------------------
# 1.4. Daten fuer Kontenliste sammeln
$self->summen_kontoliste($kto1,$monat,$quartal,$gesamt,$betrag);
$self->summen_kontoliste($kto2,$monat,$quartal,$gesamt,(-1) * $betrag);
}
#---------------------------------------------------------------
# 1.5. Kontobezeichnungen renormieren
elsif ($zeile =~ /^\-?$kto(\-?[^ ;]*)([ ;]+)([^ ;\-0123456789][^ ;]*)/) {
$o = $1;
$tab = $3;
if ($o and $o !~ /^\-/) {
$o = "-" . $o;
}
$bezeichner->{$o} = $tab;
$gesamt->{$o} = "___EMPTY___" if (!(exists ($gesamt->{$o})));
}
}
#print Dumper($rules);
# print Dumper ($extern_gesamt) if (!$o3);
# 0221 / 13930036 -- 0800 3301000
# exit;
return() if ($o3);
#------------------------------------------------------------------------
$self->mm("Auswerten beendet");
# 2. Fixpunkt der Formeln ausrechnen
my $zaehler = " 0";
$tab = 0;
while (0 == 0) {
$self->mm("$zaehler. Iteration");
$tab = $tab + 1;
$zaehler = sprintf("%3u",$zaehler+1);
foreach $buchh (reverse sort keys %$extern_gesamt) {
# next if (!$buchh); # nicht wegkommentieren, das ist die lokale Buchhaltung!
$rules = $extern_rules->{$buchh};
$gesamt = $extern_gesamt->{$buchh};
print "Check $buchh\n";
foreach $zeile (@$rules) {
$o = $zeile->[7];
$o = sprintf("%3.2f",&$o());
#print "WW: $o " . join(" ",@$zeile) . "\n";
$betrag = - $zeile->[1] + $o;
$kto1 = $zeile->[2];
$kto2 = $zeile->[3];
$monat = $zeile->[5];
$quartal = $zeile->[6];
#if ($zaehler > 0 and $betrag) {
# print " " . sprintf("%9.2f",$zeile->[1]) . " " . sprintf("%9.2f",$o) . " " . $zeile->[8] . " ($buchh)\n";
#}
$zeile->[1] = $o;
next if ($betrag == 0.00);
$self->summen_kontoliste($kto1,$monat,$quartal,$gesamt,$betrag);
$self->summen_kontoliste($kto2,$monat,$quartal,$gesamt,(-1) * $betrag);
$tab = 0;
}
}
last if ($tab > 0); # Anzahl zusaetzliche Iterationen OHNE Aenderung - es muesste der Wert 0 reichen!
last if ($zaehler > 990);
}
#-------------------------------------------------------------
$gesamt = $extern_gesamt->{$dir};
$self->mm("Fixpunkt");
# exit if (!$o3);
# 3. Formatieren des Kontoblatts
my $text2 = "";
my $sum = 0;
my $text_internal = ""; # Interne Buchungen werden abgezweigt und ans Ende von $text2 gestellt
my $doublette = [];
my $dbl_key0 = "___START___";
my $dbl_key = "";
$text1 = [ sort { $self->sortbuchung($a) cmp $self->sortbuchung($b) } @$text1 ];
$self->mm("Start Buchungen berechnen");
foreach $zeile ( @$text1 ) {
$datum = $zeile->[0];
$betrag = $zeile->[1];
$kto1 = ($zeile->[2]) || "-";
$kto2 = ($zeile->[3]) || "-";
$remark = $zeile->[4];
$remark =~ s/^(.*?) +$/$1/;
#----------------------------------
$dbl_key = $betrag;
$dbl_key = (-1) * $dbl_key if ($dbl_key < 0);
$dbl_key = sprintf("%1u",100*$dbl_key)."xx".$datum;
# print "Doublette check: $dbl_key $dbl_key0 $kto1 $kto2 $remark\n" if ($remark =~ /BLAUER/);
# print Dumper($doublette) if ($remark =~ /BLAUER/);
if ($dbl_key ne $dbl_key0) { # Doubletten-Check
$doublette = [];
$dbl_key0 = $dbl_key;
}
$xtab = $remark;
$xtab =~ s/^(qq|qw)//;
foreach $o (@$doublette) {
#print "Doublette ....: $o->[0] $o->[1] $kto1 $kto2 $o->[2]\n";
$datum = "" if ($o->[0] eq $kto1 and $o->[1] eq $kto2 and $o->[2] eq $xtab);
$datum = "" if ($o->[0] eq $kto2 and $o->[1] eq $kto1 and $o->[2] eq $xtab);
$datum = "" if ($o->[0] eq $kto1 and $kto2 =~ /13-9999$/);
$datum = "" if ($o->[0] eq $kto2 and $kto1 =~ /13-9999$/);
$datum = "" if ($o->[1] eq $kto1 and $kto2 =~ /13-9999$/);
$datum = "" if ($o->[1] eq $kto2 and $kto1 =~ /13-9999$/);
print "Doublette found: $o->[0] $o->[1] $kto1 $kto2 $o->[2]\n" if (!$datum);
if (!$datum) {
if ($monat == 10) { $monat = "A" }
elsif ($monat == 11) { $monat = "B" }
elsif ($monat == 12) { $monat = "C" }
else {$monat = sprintf("%1u",$monat); }
if ($monat =~ /[123]/) { $quartal = "I"; }
elsif ($monat =~ /[456]/) { $quartal = "J"; }
elsif ($monat =~ /[789]/) { $quartal = "K"; }
else { $quartal = "L"; }
$self->summen_kontoliste($kto2,$monat,$quartal,$gesamt,$betrag);
$self->summen_kontoliste($kto1,$monat,$quartal,$gesamt,(-1) * $betrag);
}
last if (!$datum);
}
next if (!$datum);
push(@$doublette,[$kto1,$kto2,$xtab]);
#print Dumper($doublette);
#----------------------------------
if ($kto2 !~ /^\-/) {
$sum = $sum + $betrag;
}
if ($format eq "kto") {
if (length($kto1) < 11) { $kto1 = substr($kto1." "x11,0,11); }
if (length($kto2) < 11) { $kto2 = substr($kto2." "x11,0,11); }
while ($remark =~ s/^\;/ /) { 1; }
$zeile = $datum . " " . sprintf("%11.2f",$betrag) . " " .
$kto1 . "___TAB1___" . (sprintf("%09b",1023-length($kto1))) . "___ " .
$kto2 . "___TAB2___" . (sprintf("%09b",1023-length($kto2))) . "___ " .
sprintf("%11.2f",$sum) . " " . $remark;
}
elsif ($format eq "lgh") {
$zeile = $datum . " " . sprintf("%11.2f",$betrag) . " " .
$kto1 . " " .
$kto2 . " " .
sprintf("%11.2f",$sum) . " " . $remark;
}
else {
$zeile = $datum . ";" . sprintf("%3.2f",$betrag) . ";" .
$kto1 . ";" .
$kto2 . ";" .
sprintf("%3.2f",$sum) . ";" . $remark;
}
if ($kto2 =~ /^\-/ or $kto1 =~ /\-XRXUXLXEX( |;|$)/) {
$zeile = "A " . $zeile;
} else {
$zeile = "B " . $zeile;
}
}
$text_internal = join("\n","\n",grep(/^A /,@$text1));
$text2 = join("\n","\n",grep(/^B /,@$text1));
$text_internal =~ s/\nA /\n/gs;
$text2 =~ s/\nB /\n/gs;
$text_internal =~ s/^[\n ;]+//gs;
$text2 =~ s/^[\n ;]+//gs;
#---------------------------------------------------------------------
$self->mm("Buchungen eintragen");
# 4. Anfuegen der Kontobezeichnungen
$text2 = $text2 . "\n\n";
# print "ZZ $text2 $text_internal\n"; exit;
foreach $kto1 (keys %$gesamt) { # Monats- und Quartalskonten rausnehmen
# delete ($gesamt->{$kto1}) if ($kto1 =~ /.\-[0123456789ABCIJKLMNP]\d?$/);
delete ($gesamt->{$kto1}) if ($kto1 =~ /.\-[0123456789ABCIJKLMNP]$/);
}
delete ($gesamt->{"-"});
$text0 = [keys %$gesamt];
foreach $kto1 (sort { $self->sortktobez($a) cmp $self->sortktobez($b) } @$text0) {
$kto2 = $kto1;
$kto2 =~ s/^\-//;
$betrag = $gesamt->{$kto1};
if ($betrag eq "___EMPTY___") {
$betrag = "";
} else {
$betrag = sprintf("%13.2f",$betrag);
}
$betrag =~ s/^(.*?)( *)$/$2$1/;
$betrag =~ s/ /\\/g;
$ytab = $kto1;
$ytab =~ s/[^-]//g;
$ytab =~ s/^$xtab//;
if ($format eq "kto") {
$o = $bezeichner->{$kto1} || ""; # "___undefined___"; # Kontobezeichner
if (length($betrag) < 11) { $betrag = substr($betrag." "x11,0,11); }
if (length($kto2) < 11) { $kto2 = substr( $kto2." "x11,0,11); }
$ytab =~ s/\-/\\/g;
if ($kto2 !~ /\S/) {
if (length($o) < 11) { $o = substr( $o." "x11,0,11); }
$zeile = " " . $o . $betrag;
} else {
if (length($o) < 11) { $o = substr( $o." "x11,0,11); }
$zeile = $kto2 . "___TAB3___" . (sprintf("%09b",1023-length($kto2))) . "___ " . $o;
$zeile = $zeile . "___TAB4___" . (sprintf("%09b",1023-length($o)))
. "___ " . $ytab . $ytab . $ytab . $ytab . $betrag; # if ($betrag);
}
} else {
$ytab =~ s/\-/\;/g;
$zeile = $kto2 . ";" .
$bezeichner->{$kto1} . ";" .
$ytab . $betrag;
}
if ($kto2 =~ /\S/) { # Unterkonten
if ($kto2 !~ /\-/ and (substr($kto2,0,3) =~ / +/)) { $zeile = "\n" . $zeile; }
elsif ($kto2 =~ /^(meldung|zahlung)/) { $zeile = "\n" . $zeile; }
# if ($kto2 =~ /^(ZAHL|LST|LSTU|meldung)( |$)/) { $zeile = "\n" . $zeile; }
if ($kto2 =~ /^57\-(\d+) *$/) { $zeile = "\n" . $zeile; }
$text2 = $text2 . $zeile . "\n";
} else {
# $zeile = $zeile . "\n"; # Bezeichnung des Kontoblattes selbst
$text2 = $zeile . "\n\n" . $text2;
}
}
# $text2 = $text2 . join("\n",@$text0);
$text2 = $text2 . "\n\n" . $text_internal . "\n" if ($text_internal);
#-------------------------------------------------
$self->mm("Kontobezeichnungen");
# 5. Tabulatorabstaende ausrechnen
if ($format eq "kto") {
foreach $tab (1,2,3,4) { # minimale Einrueckung bestimmen
my $space1 = "";
while (0 == 0) {
$space1 = $space1 . "0";
next if ($text2 =~ /___TAB$tab\___$space1/);
$space1 = substr($space1,0,length($space1)-1) . "1";
last if ($text2 !~ /___TAB$tab\___$space1/);
}
$space1 = eval("0b".substr($space1,0,length($space1)-1));
while (0 == 0) { # Spezielle Einrueckungen vornehmen
last if ($text2 !~ /___TAB$tab\___([01]+)\___/);
$o = $1;
$space = " " x (eval("0b".$o) - $space1);
$text2 =~ s/___TAB$tab\___$o\___/$space/gs;
}
}
$text2 =~ s/\\/ /g;
} else {
$text2 =~ s/\\//g;
}
$text2 =~ s/( *)\n/\n/gs;
# $o = $kto;
if ($format eq "kto") {
# if (length($o) < 14) { $o = substr($o." "x14,0,14); }
# $text2 = $o . " " . $bezeichner->{''} . "\n\n" . $text2;
$text2 =~ s/ \-0.00 / 0.00 /g;
} else {
# $text2 = $o . ";; " . $bezeichner->{''} . "\n\n" . $text2;
$text2 =~ s/\;\-0.00\;/\;0.00\;/g;
}
$self->mm("Tabulator minimieren");
# $text2 = $text2 . "\n" . $self->ident_key($text2) . "\n"; # Ident_key wird nicht mehr benoetigt
return($text2);
}
#******************************************************************
sub summen_kontoliste {
my $self = shift;
my $kto = shift;
my $monat = shift;
my $quartal = shift;
my $gesamt = shift;
my $betrag = shift;
return() if ($kto and $kto !~ /^\-/);
while (0 == 0) {
$gesamt->{$kto} = $gesamt->{$kto} + $betrag;
last if (!$kto);
$gesamt->{$kto."-".$monat} = $gesamt->{$kto."-".$monat} + $betrag;
$gesamt->{$kto."-".$quartal} = $gesamt->{$kto."-".$quartal} + $betrag;
$kto =~ s/^(.*)\-(.*)$/$1/;
}
}
#***********************************************************************
sub compute_diff { # compute a diff for changing the Buchungs-Liste
my $self = shift;
my $list0 = shift;
my $list = shift;
my $o; my $o0; my $o1; my $erg; my $erg0;
if (-f $list0) {
open(FFILE,"<".$list0);
$list0 = join("",<FFILE>);
$list0 =~ s/
//g;
close(FFILE);
}
if (-f $list) {
open(FFILE,"<".$list);
# $o = Application::IfTRules->new();
# $o1 = $list;
$list = join("",<FFILE>);
$list =~ s/
//g;
close(FFILE);
# $list = $o->rule($list,$o1);
}
# $list =~ s/ +/ /g;
# $list =~ s/;+/;/g;
$list =~ s/[ ;]+-?\d+\.\d\d\n/\n/gs;
# $list0 =~ s/ +/ /g;
# $list0 =~ s/;+/;/g;
$list0 =~ s/[ ;]+-?\d+\.\d\d\n/\n/gs;
$o1 = "0.00";
$list =~ s/(\d\d\d\d\d\d\d\d[ ;])[ ;]*(-?\d+\.\d\d[ ;])[ ;]*([^ ;]+[ ;])[ ;]*([^ ;]+[ ;])[ ;]*-?\d+\.\d\d([ ;])[ ;]*(.*)/$1$2$3$4$o1$5$6/g; #
$list0 =~ s/(\d\d\d\d\d\d\d\d[ ;])[ ;]*(-?\d+\.\d\d[ ;])[ ;]*([^ ;]+[ ;])[ ;]*([^ ;]+[ ;])[ ;]*-?\d+\.\d\d([ ;])[ ;]*(.*)/$1$2$3$4$o1$5$6/g; #
# print $list; exit;
# $list0 =~ s/(\d\d\d\d\d\d\d\d[ ;]+-?\d+\.\d\d[ ;]+[^ ;]+[ ;]+[^ ;]+[ ;]+)-?\d+\.\d\d/$1 0.00/g; #
if ($list =~ /\{/ and $list0 =~ /\{/ and $list !~ /\{.*\:/ and $list0 !~ /\{.*\:/) {
$list =~ s/(\d\d\d\d\d\d\d\d[ ;]+)-?\d+\.\d\d(.*?0.00.*?\{)/$1 0.00$2/g; # Betrag auf Null setzen bei
$list0 =~ s/(\d\d\d\d\d\d\d\d[ ;]+)-?\d+\.\d\d(.*?0.00.*?\{)/$1 0.00$2/g; # internen Formeln
}
# while ($list =~ s/\n\S+\n/\n/gs) { 1; }
# while ($list0 =~ s/\n\S+\n/\n/gs) { 1; }
return(['','']) if ($list0 eq $list);
$list0 = [ sort { $self->sortbuchung($a) cmp $self->sortbuchung($b) }
split(/\n/,$list0) ];
$list = [ sort { $self->sortbuchung($a) cmp $self->sortbuchung($b) }
split(/\n/,$list) ];
my $addlist = "";
my $dellist = "";
$o = ""; $o0 = "";
foreach $o ( Algorithm::Diff::diff( $list0,$list ) ) {
foreach $o1 (@$o) {
if ($o1->[0] eq "+") {
$addlist = $addlist . $o1->[2] . "\n";
} else {
$dellist = $dellist . $o1->[2] . "\n";
}
}
}
return([$dellist,$addlist]);
}
#*****************************************************************
sub sortbuchung {
my $self = shift;
my $text = shift;
#if ($main::XX) { print $text . "--\n"; }
my $erg; my $kto1; my $kto2; my $datum; my $betrag;
if (ref($text)) {
$datum = $text->[0];
$betrag = $text->[1];
$kto1 = $text->[2];
$kto2 = $text->[3];
$erg = $text->[4];
}
elsif ($text =~ /^(\d\d\d\d\d\d\d\d)[; ]+-?(\d+\.\d\d)[; ]+([^ ;]+)[; ]+([^ ;]+)+[; ]+-?\d+\.\d\d[ ;]+(.*)$/) {
$erg = $5;
$betrag = $2;
$kto1 = $3;
$kto2 = $4;
$datum = $1;
} else {
return("9 " . $text);
}
$betrag =~ sprintf("%3.2f",$betrag);
$betrag =~ s/[-\.]//g;
$betrag =~ (" "x(20-length($betrag))) . $betrag;
$erg =~ s/[äöüÄÖÜß]/X/g;
$erg =~ s/^(qw|qq)//;
# print "EE: $erg\n"; sleep 1;
if ($erg =~ s/^ *\d(.*?)\((.*)\)/$2/s) { # Umsatzsteuerbehandlung
$erg = substr($erg,0,92) . ("Z"x92);
} else {
$erg = substr($erg,0,92) . ("A"x92);
}
$erg = substr($erg,0,92+1);
if ($kto1 =~ /\-RULE/) { $erg = "05" . $erg; }
elsif ($kto2 =~ /\-RULE/) { $erg = "05" . $erg; }
elsif ($kto2 =~ /13-9999$/) { $erg = "90" . $erg; } # fuer spaetere Behandlung als Doublette
elsif ($erg =~ /^Brutto-Lohn/) { $erg = "11" . $erg; }
elsif ($erg =~ /^(LST|Lohnsteuer)/) { $erg = "12" . $erg; }
elsif ($erg =~ /^(KST|Kirchensteuer)/) { $erg = "13" . $erg; }
elsif ($erg =~ /^(PKVK)/) { $erg = "22" . $erg; }
elsif ($erg =~ /^(A.-Anteil SZ|Soli)/) { $erg = "16" . $erg; }
elsif ($erg =~ /^(ZAHL)/i) { $erg = "17" . $erg; }
elsif ($erg =~ /^A.-Anteil RV/) { $erg = "19" . $erg; }
elsif ($erg =~ /^A.-Anteil AV/) { $erg = "20" . $erg; }
elsif ($erg =~ /^(A.-Anteil KV|Kasse)/) { $erg = "21" . $erg; }
elsif ($erg =~ /^A.-Anteil ZU/) { $erg = "22" . $erg; }
elsif ($erg =~ /^A.-Zuschl.* KV/) { $erg = "22" . $erg; }
elsif ($erg =~ /^(PKVK)/) { $erg = "22" . $erg; }
elsif ($erg =~ /^A.-Anteil PV/) { $erg = "23" . $erg; }
elsif ($erg =~ /^(PKVP)/) { $erg = "23" . $erg; }
elsif ($erg =~ /^A.-Anteil KI/) { $erg = "24" . $erg; }
elsif ($erg =~ /^KI-Zuschl.* PV/) { $erg = "24" . $erg; }
elsif ($erg =~ /^A.-Anteil ST/) { $erg = "26" . $erg; }
elsif ($erg =~ /^(A.-Anteil U|U)mlage 1/) { $erg = "27" . $erg; }
elsif ($erg =~ /^(A.-Anteil U|U)mlage 2/) { $erg = "28" . $erg; }
elsif ($erg =~ /^(A.-Anteil I|I)nso/) { $erg = "29" . $erg; }
elsif ($erg =~ /^ +\d/) { $erg = "50" . $erg; }
else { $erg = "79" . $erg; }
my $o1 = $kto1;
my $o2 = $kto2;
if (($o1 cmp $o2) > 0) {
$o1 = $kto2;
$o2 = $kto1;
}
$erg = $datum . $erg. $o1 . $o2 . $betrag;
# print $erg . "\n"; sleep 1;
#if ($main::XX) { print "$erg $kto2\n"; }
return($erg);
}
#*****************************************************************
sub sortktobez {
my $self = shift;
my $text = shift;
$text =~ s/^(.*?)\-X(.*)$/$1\-$2\-/;
$text =~ s/(^|\-)(LOHN)/$1a03$2/;
$text =~ s/(^|\-)(SOND)/$1a04$2/;
$text =~ s/(^|\-)(PKVZ)/$1a05$2/;
$text =~ s/(^|\-)(LST)/$1a06$2/;
$text =~ s/(^|\-)(SZ)/$1a07$2/;
$text =~ s/(^|\-)(KS|KR|KE|KA|KB)/$1a08$2/;
$text =~ s/(^|\-)(ZAHL)/$1a10$2/;
$text =~ s/(^|\-)(RV)/$1a15$2/;
$text =~ s/(^|\-)(AV)/$1a16$2/;
$text =~ s/(^|\-)(KV)/$1a17$2/;
$text =~ s/(^|\-)(PKVZ)/$1a17$2/;
$text =~ s/(^|\-)(KI)/$1a18$2/;
$text =~ s/(^|\-)(PV)/$1a19$2/;
$text =~ s/(^|\-)(PKVP)/$1a19$2/;
$text =~ s/(^|\-)(ZU)/$1a20$2/;
$text =~ s/(^|\-)(ST)/$1a21$2/;
$text =~ s/(^|\-)(U1)/$1a31$2/;
$text =~ s/(^|\-)(U2)/$1a32$2/;
$text =~ s/(^|\-)(U3)/$1a33$2/;
$text =~ s/(^|\-)(meldung)/$1zzz50$2/;
# print "WW: $text\n"; sleep 1;
return($text);
}
#*****************************************************************
sub mm {
my $self = shift;
my $mark = shift;
if (!$main::XCONSOLE) {
return(1);
}
eval("use Time::HiRes");
my $newdate = sprintf("%16.5f",Time::HiRes::time());
my $diff = $newdate - $main::lasttime;
if ($diff > 10000000) {
$main::mmgesamt = 0;
$diff = 0;
}
$diff = sprintf("%10.2f",$diff*1000);
$main::mmgesamt = $main::mmgesamt + $diff;
$main::lasttime = $newdate;
my $erg = $diff . " ms fuer: " . $mark . "\n";
if ($main::XCONSOLE > 1) {
if (!($main::cgp_opened)) {
open(GFILE,">".$mark);
$main::cgp_opened = 1;
$mark = $mark . " opened";
}
print GFILE $erg;
}
if ($main::XCONSOLE != 2) {
print $erg;
}
}
#***********************************************************************
sub editor {
my $self = shift;
my $file = shift;
my $text1; my $o1; my $o2; my $zaehler; my $bed;
if ($file !~ /REARRANGE/) {
while (0 == 0) {
if ($^O =~ /^l/i) {
system("joe $file");
} else {
system("notepad $file");
}
$bed = 0;
open(FFILE,"<".$file);
my $text = join("",<FFILE>);
close(FFILE);
while ($text =~ s/\n(\d\d\d\d)MM(\d\d[ ;][^\n]+)/---MULTIMONTH---/s) {
$bed = 1;
$o1 = $1;
$o2 = $2;
foreach $zaehler (qw(01 02 03 04 05 06 07 08 09 10 11 12)) {
$text1 = $text1 . "\n" . $o1 . $zaehler . $o2;
}
$text =~ s/---MULTIMONTH---/$text1/s;
}
last if (!$bed);
open(FFILE,">".$file);
print FFILE $text;
close(FFILE);
}
}
}
#***********************************************************************
#***********************************************************************
sub xxident_key {
my $self = shift;
return("");
my $text = shift;
my $file = shift;
my $mapping = { '0' => 'g',
'1' => 'h',
'2' => 'i',
'3' => 'k',
'4' => 'l',
'5' => 'm',
'6' => 'n',
'7' => 'p',
'8' => 'q',
'9' => 'r',
'a' => 's',
'b' => 't',
'c' => 'u',
'd' => 'x',
'e' => 'y',
'f' => 'z' };
# $text = $self->ident_text($text);
# print GFILE $text . "\n$file\n\n\n\n\n" if ($main::XXC);
my $erg = Digest::SHA1::sha1_hex($text.$file);
my $o = "";
while (length($o) < 4) {
if ($o and substr($erg,0,1) =~ /[12345678]/) {
$o = $o . substr($erg,1,1);
} else {
$o = $o . $mapping->{substr($erg,1,1)};
}
$erg = substr($erg,2);
}
return("_".$o);
}
#***********************************************************************
sub xxident_text {
my $self = shift;
my $text = shift;
$text =~ s/[^\n]*\n[^\n]*\n[^\n]*\n//s;
$text =~ s/\-\d+\.\d\d/0/g;
$text =~ s/\d+\.\d\d/0/g;
$text =~ s/ +/ /gs;
$text =~ s/\n[a-z0-9][a-z0-9][a-z0-9][a-z0-9]\s$//s;
return($text);
}
#***********************************************************************
sub xxrule {
my $self = shift;
my $cmd = shift;
my $file = shift;
my $act_edit = 0;
my $datum; my $mode; my $pars; my $func; my $zeile; my $o; my $text1; my $rr;
# print "XX: $cmd\n"; exit;
while (0 == 0) {
open(FFILE,"<".$file);
my $text = join("",<FFILE>);
close(FFILE);
if ($cmd eq "rule" and $text =~ /\n(\d\d\d\d\d\d\d\d)/) {
$cmd = $1;
}
if ($cmd =~ /^\d\d\d\d\d\d\d\d$/ and $text =~ s/(\n\d\d\d\d\d\d\d\d)/\n$cmd 0.00 -RULE -MERGE 0.00 konto $1/s) {
open(FFILE,">".$file);
print FFILE $text;
close(FFILE);
$cmd = 0;
}
elsif ($text =~ s/\nRULE *\n(\d\d\d\d\d\d\d\d)/\n$1 0.00 -RULE -MERGE 0.00 konto\n$1/) {
open(FFILE,">".$file);
$text =~ s/
//g;
print FFILE $text;
close(FFILE);
}
if ($text =~ s/(\d\d\d\d\d\d\d\d[; ]+-?\d+\.\d\d[; ]+[^ ;]*?\-RULE[; ]+[^ ;]*?\-)(MERGE|RELOAD)( +[; ]+-?\d+\.\d\d[ ;]+.*)/---XRULE---/) {
$zeile = $1.$2.$3;
$zeile =~ s/^(.*?)( +PARSEERROR\:)(.*)$/$1/;
if ($self->parserule($zeile."\n","MERGE|RELOAD",\$pars,\$datum,\$mode,"")) {
$pars = [split(/,/,$pars)];
$func = shift(@$pars);
$o = "Application::IfTRules";
if ($func =~ s/^(.*?)\_\_(.*)$/$2/) {
$o = $o . "_" . $1;
}
eval("use $o");
if (!$@) {
print("\$text1 = $o->new(\$self)->$func(\$datum,\$mode,\$text,\@\$pars)\n");
eval("\$text1 = $o->new(\$self)->$func(\$datum,\$mode,\$text,\@\$pars)");
}
$o = $@;
if (!$o and !$text1) {
$o = "Empty string from $func\n";
}
if ($o) {
$text1 = $text;
$text1 =~ s/---XRULE---\n/$zeile PARSEERROR: $o/s;
$act_edit = 1;
} else {
$text1 =~ s/---XRULE---\n//s;
}
$text1 =~ s/\.\.\.T\.\.\./ /g;
#print $text1; exit;
open(FFILE,">".$file);
$text1 =~ s/
//g;
print FFILE $text1;
close(FFILE);
}
last if (!$act_edit);
} else {
last if ($act_edit);
}
if ($^O =~ /^l/i) {
system("joe $file") if ($file !~ /REARRANGE/);
} else {
system("notepad $file");
}
$act_edit = 1;
}
}
#*************************************************************************************
sub xxkto_to_sql {
my $self = shift;
my $file = shift;
return(0) if ($file !~ /^(.*)\.kto$/);
my $file1 = $1 . ".sql";
my $dbh;
if (!(-f $file1)) {
$dbh = DBI->connect("dbi:SQLite:$file1");
$dbh->do("create table buchung " .
"(datum,betrag,kto1,kto2,remark)");
$dbh->do("create table konto (kto,bezeichnung)");
$dbh->do("create index buchung_datum on buchung (datum)");
$dbh->do("create index buchung_kto1 on buchung (kto1)");
$dbh->do("create index buchung_kto2 on buchung (kto2)");
$dbh->do("create index konto_bezeichnung on konto (bezeichnung)");
} else {
$dbh = DBI->connect("dbi:SQLite:$file1");
$dbh->do("delete from buchung");
$dbh->do("delete from konto");
}
}
#*************************************************************************************
sub xxparserule {
my $self = shift;
my $text = shift;
my $mode = shift;
my $pars = shift;
# my $kk = shift;
my $dd = shift;
my $mm = shift;
my $bb = shift;
my $erg = []; my $zeile;
# if (ref($kk) and $text =~ /^(.*?) /s) { $$kk = $1; }
$text = [grep(/RULE/,split(/\n/,$text))];
my $first = [];
foreach $zeile (@$text) {
next if ($zeile !~ /^(\d\d\d\d\d\d\d\d)[; ]+-?(\d+\.\d\d)[; ]+([^ ;]*?)\-RULE[; ]+([^ ;]*?)($mode[^ ;]*?)+[; ]+-?\d+\.\d\d[ ;]+(.*)$/);
push(@$erg,[$6,$1,$5,$2]);
}
return(0) if (!@$erg);
$$pars = $erg->[0]->[0] if (ref($pars));
$$dd = $erg->[0]->[1] if (ref($dd));
$$mm = $erg->[0]->[2] if (ref($mm));
$$bb = $erg->[0]->[3] if (ref($bb));
return([sort { $a->[1] <=> $b->[1] } @$erg]);
}
#*************************************************************************************
sub xxmake_new_kto_database {
my $self = shift;
my $file = shift;
return(0) if ($file !~ /^(.*)\.kto$/);
my $file1 = $1 . ".sql";
my $dbh;
if (!(-f $file1)) {
$dbh = DBI->connect("dbi:SQLite:$file1");
$dbh->do("create table buchung " .
"(datum,betrag,kto1,kto2,remark)");
$dbh->do("create table konto (kto,bezeichnung)");
$dbh->do("create index buchung_datum on buchung (datum)");
$dbh->do("create index buchung_kto1 on buchung (kto1)");
$dbh->do("create index buchung_kto2 on buchung (kto2)");
$dbh->do("create index konto_bezeichnung on konto (bezeichnung)");
} else {
$dbh = DBI->connect("dbi:SQLite:$file1");
$dbh->do("delete from buchung");
$dbh->do("delete from konto");
}
}
#*****************************************************************
sub ukto {
my $self = shift;
my $buchh = shift;
my $kto0 = shift;
return(0) if ($buchh !~ /^(.*)\.(.*)$/);
my $dir = $1;
my $format = $2;
mkdir($dir);
my $kto1 = "";
if ($kto0 =~ s/\-(SUM|)([123456789ABCIJKLMNP])$//) {
$kto1 = $self->partialkto($1.$2);
};
open(FFILE,"<$buchh");
my $text = join("","\n",grep(/(^$kto0|[ ;]-$kto0)/,<FFILE>));
close(FFILE);
my $zaehler = "00000000";
my $formeln = {};
# while ($text =~ s/\{(.*?)\}/...FORMEL...$zaehler.../s) {
#print $1 . "\n";
# $formeln->{$zaehler} = $1;
# $zaehler = sprintf("%08u",$zaehler+1);
# }
#exit;
# $text = join("\n",grep(/(^$kto0|[ ;]-$kto0)/,split(/\n/,$text)));
my $formel;
foreach $zaehler (keys %$formeln) {
$formel = " " . $formeln->{$zaehler} . " ";
while ($formel =~ s/^ *\( *(.*?) *\) *$/$1/) { 1; }
$formel = "\{ " . $formel . " \}";
$formel =~ s/([ ;\(\)\[\]\{\}\+\*])/ $1 /g;
$formel =~ s/ \-/ \- /g;
$formel =~ s/ \+ *\- / \- /g;
$formel =~ s/ ([a-zA-Z0-9\:][a-zA-Z0-9\-\_]*) / :$1 /g;
$formel =~ s/ \:$kto0\-([a-zA-Z0-9\_\-]+) / $1 /g;
$text =~ s/...FORMEL...$zaehler.../$formel/;
}
if ($kto1) {
$text = "\n" . $text;
$kto1 =~ s/\,/\|/g;
$text =~ s/\n\d\d\d\d0101[ ;][^\n]+//gs;
$text =~ s/\n(\d\d\d\d)($kto1)/\n------$1$2/gs;
$text =~ s/\n\d\d\d\d\d\d\d\d[ ;][^\n]+//gs;
$text =~ s/\n------(\d\d\d\d)/\n$1/gs;
}
$text =~ s/\n(\d\d\d\d\d\d\d\d[ ;]+-?\d+\.\d\d[ ;]+\-)$kto0/\n$1/gs;
$text =~ s/\n(\d\d\d\d\d\d\d\d[ ;]+-?\d+\.\d\d[ ;]+[^ ;]+[ ;]+\-)$kto0/\n$1/gs;
$text =~ s/\n$kto0/\n/gs;
$text =~ s/^[\n ;]//gs;
return($text);
}
#***************************************************************
sub partialkto {
my $self = shift;
my $kto1 = shift;
$kto1 = $kto1 . ",";
$kto1 =~ s/(\d)/0$1/;
$kto1 =~ s/A,/10,/;
$kto1 =~ s/B,/11,/;
$kto1 =~ s/C,/12,/;
$kto1 =~ s/I,/01,02,03,/;
$kto1 =~ s/J,/04,05,06,/;
$kto1 =~ s/K,/07,08,09,/;
$kto1 =~ s/L,/10,11,12,/;
$kto1 =~ s/M,/01,02,03,04,05,06,/;
$kto1 =~ s/N,/07,08,09,10,11,12,/;
$kto1 =~ s/O,/01,02,03,04,05,06,07,08,09,10,11,12,/;
while ($kto1 =~ s/^SUM(\d\d)/,$1/) {
$kto1 = "SUM" . sprintf("%02u",$1-1) . $kto1;
$kto1 =~ s/^SUM00//;
}
$kto1 =~ s/^(,*)(.*?)(,*)$/$2/;
return($kto1);
}
#*************************************************************************************
1;