| 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/IFiBu.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 $slash = "/";
#*****************************************************************
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = {};
$self->{'KONTEN'} = shift;
bless($self,$class);
return($self);
}
#*****************************************************************
sub ukto {
my $self = shift;
my $buch = shift;
my $kto = shift;
my $file = "./" . $buch; # Name des Exportfiles
$file =~ s/^(.*)[\\\/](.*\_)([a-z0-9][a-z0-9][a-z0-9][a-z0-9])\.(.*)$/$1\/$kto\/$2\_9999\.$format/;
mkdir("$1/$2");
sub shell {
my $self = shift;
my $cmd = shift;
my $dir = shift;
my $active = shift; # Versions-File
my $merge = shift; # Merge-File
my $pars = [@_];
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 "e") { $cmd = "edit"; }
elsif ($cmd eq "p") { $cmd = "prune"; }
elsif ($cmd eq "r") { $cmd = "rule"; }
if ($cmd =~ /^(csv|kto)$/) { # Exportieren des entsprechenden Kontos
$main::XCONSOLE = 1;
if ($dir =~ s/^(.*[\\\/])(.*)$/$1/) {
$kto = $2;
}
elsif ($dir) {
$kto = $dir;
$dir = "";
}
else {
return("ERROR: Parameters are necessary for command $cmd.");
}
$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);
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
$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,"",$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 =~ /\.(csv|kto|sql)(~?)$/) {
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.");
}
# Rules
elsif ($cmd eq "q") {
$self->make_diff($dir);
}
elsif ($cmd eq "k") {
$o = $self->shell("kto",$dir,$active);
return($o) if ($o !~ /^OK\: +(\S+)/);
$self->rule("",$1);
$self->shell("import",$dir);
}
elsif (-f $dir) {
$self->rule($cmd,$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)$/);
$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 ];
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 $lazy = shift; # Wenn eingestellt, Suche nach passenden Versionen auch per Text-Identitaet
# $lazy = 1;
my $diff; my $merged; my $anzahl_zeilen; my $zeile; my $zeile1;
my $o; my $o1; my $zaehler; my $kto0; my $kto1; my $kto2;
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);
close(FFILE);
$active =~ /^(.*)[a-z0-9][a-z0-9][a-z0-9][a-z0-9]\.[^\.]*$/;
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) {
if ($lazy == 0) {
return("ERROR: Merge file $active not matching");
}
$lazy = 2;
}
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/\-.$//; # Monats- und Quartalsunterkonten ausschliessen
$text = join("","\n",grep(/$o/,@$text));
$text = $kto."\n".$self->to_txt($kto,$text,$format); # Urspruenglicher Export
mkdir($dir.$kto);
# 1. --- Change mode -----------------------------------------------
if ($merge) {
if ($kto =~ /\-.$/) {
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",$lazy);
$self->mm("... berechne Diff dazu");
return($diff) if (!(ref($diff)));
$merged = 0;
$anzahl_zeilen = scalar ( split(/\n/,$text0) );
foreach $zeile (split(/\n/,$diff->[0])) { # delete list
$zeile1 = "";
$zeile =~ s/[\/\\\[\]\+\(\)\?\.\*]/\./g;
$zeile =~ s/\{(.*)\}/\{.\*\?\}/g;
if ($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)";
# $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
$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[ ;]*//s);
return("ERROR: Double line: $zeile with $zeile1\n") if ($text0 =~ /\n$zeile1[ ;]*/s);
} # mit diesen beiden Zeilen genauere Angabe bei Double line als mit der einen darueber, aber aufwendiger
}
return("ERROR: Double line $text0") if ($anzahl_zeilen - $merged != scalar (split(/\n/,$text0)));
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));
$zeile =~ s/\{(.*?)\}/\{ $1 \}/;
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 = [];
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\}/;
}
elsif ($zeile =~ /^\S/) {
$zeile = $kto . "-" . $zeile;
}
else {
$zeile = $kto . $zeile;
}
$text0 = $zeile . "\n" . $text0;
}
$merged = 1 if ($kto eq "REARRANGE");
if ($merged and $active =~ /^(.*)\.(.*)$/) {
$o = $2;
$self->mm("Diff anwenden");
$text = $kto0."\n".$self->to_txt("",$text0,$o);
} 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 ----------------------------------------
# print "XX: $file $merged\n";
open(FFILE,">$file");
print FFILE $text;
close(FFILE);
return("OK: $kto merged into its ancestor") if ($merged);
return("OK: $file created.");
}
#******************************************************************************
sub to_txt {
my $self = shift;
my $kto = shift;
my $text = shift;
my $format = shift;
my $ukto = "";
if ($kto =~ s/\-([123456789ABCIJKL])$//) {
$ukto = $1;
}
my $zeile; my $datum; my $betrag; my $kto1; my $kto2; my $remark;
my $o; 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 $bezeichner = {};
my $gesamt = {};
#---------------------------------
# 1. Auswerten aller Zeilen
my $text1 = [];
my $rules = [];
foreach $zeile (split(/\n/,$text)) {
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 eq "kto") { $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;
}
}
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
$monat = substr($datum,4,2);
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"; }
next if ($ukto and ($ukto ne $monat) and ($ukto ne $quartal));
# 1.3. Formeln formatieren und evaluieren
$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";
if ($formel =~ /\:/) {
$formel = "";
} else {
$formel = eval ( "sub " . $formel );
}
# $betrag = 0; # neue Werteberechnung-
}
#---------------------------------------------------------------
$zeile = [$datum,$betrag,$kto1,$kto2,$remark,$monat,$quartal,$formel,$tab];
push(@$text1,$zeile);
push(@$rules,$zeile) if (ref($formel));
#---------------------------------------------------------------
# 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})));
}
}
# 0221 / 13930036 -- 0800 3301000
#------------------------------------------------------------------------
$self->mm("Auswerten");
# 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 $zeile (@$rules) {
$o = $zeile->[7];
$o = sprintf("%3.2f",&$o());
$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] . "\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);
}
#-------------------------------------------------------------
$self->mm("Fixpunkt");
# 3. Formatieren des Kontoblatts
my $text2 = "";
my $sum = 0;
my $text_internal = ""; # Interne Buchungen werden abgezweigt und ans Ende von $text2 gestellt
foreach $zeile ( sort { $self->sortbuchung($a) cmp $self->sortbuchung($b) } @$text1 ) {
$datum = $zeile->[0];
$betrag = $zeile->[1];
$kto1 = ($zeile->[2]) || "-";
$kto2 = ($zeile->[3]) || "-";
$remark = $zeile->[4];
if ($kto2 !~ /^\-/ ) {
$sum = $sum + $betrag;
}
if ($format eq "kto") {
if (length($kto1) < 13) { $kto1 = substr($kto1." "x13,0,13); }
if (length($kto2) < 13) { $kto2 = substr($kto2." "x13,0,13); }
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;
} else {
$zeile = $datum . ";" . sprintf("%3.2f",$betrag) . ";" .
$kto1 . ";" .
$kto2 . ";" .
sprintf("%3.2f",$sum) . ";" . $remark;
}
if ($kto2 =~ /^\-/ or $kto1 =~ /\-XRXUXLXEX( |;|$)/) {
$text_internal = $text_internal . $zeile . "\n";
} else {
$text2 = $text2 . $zeile . "\n";
}
}
#---------------------------------------------------------------------
$self->mm("Buchungen eintragen");
# 4. Anfuegen der Kontobezeichnungen
$text2 = $text2 . "\n";
foreach $kto1 (keys %$gesamt) { # Monats- und Quartalskonten rausnehmen
delete ($gesamt->{$kto1}) if ($kto1 =~ /\-[0123456789ABCIJKL]\d?$/);
}
foreach $kto1 (sort keys %$gesamt) {
next if ($kto1 =~ /(RENDERER|RULE|MERGE|RELOAD)\-?([ABCIJKL0123456789]?\d?)$/);
$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) < 13) { $betrag = substr($betrag." "x13,0,13); }
if (length($kto2) < 13) { $kto2 = substr( $kto2." "x13,0,13); }
$ytab =~ s/\-/\\/g;
if ($kto2 !~ /\S/) {
if (length($o) < 11) { $o = substr( $o." "x11,0,11); }
$zeile = " " . $o . $betrag;
} else {
if (length($o) < 13) { $o = substr( $o." "x13,0,13); }
$zeile = $kto2 . "___TAB3___" . (sprintf("%09b",1023-length($kto2))) . "___ " . $o;
$zeile = $zeile . "___TAB4___" . (sprintf("%09b",1023-length($o)))
. "___ " . $ytab . $ytab . $ytab . $betrag; # if ($betrag);
}
} else {
$ytab =~ s/\-/\;/g;
$zeile = $kto2 . ";" .
$bezeichner->{$kto1} . ";" .
$ytab . $betrag;
}
if ($kto2 =~ /\S/) {
if ($kto2 !~ /\-/ and (substr($kto2,0,3) =~ / /)) { $zeile = "\n" . $zeile; }
$text2 = $text2 . $zeile . "\n";
} else {
$text2 = $zeile . "\n\n" . $text2;
}
}
$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");
return($text2 . "\n" . $self->ident_key(\$text2) . "\n");
}
#******************************************************************
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 $lazy = shift;
my $o; my $o0; my $o1; my $erg; my $erg0;
if (-f $list0) {
open(FFILE,"<".$list0);
$list0 = join("",<FFILE>);
close(FFILE);
}
if (-f $list) {
open(FFILE,"<".$list);
# $o = Application::IfTRules->new();
# $o1 = $list;
$list = join("",<FFILE>);
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;
$list =~ s/(\d\d\d\d\d\d\d\d[ ;]+-?\d+\.\d\d.[ ;]+[^ ;]+[ ;]+[^ ;]+[ ;]+)-?\d+\.\d\d/$1 0.00/g; #
$list0 =~ s/(\d\d\d\d\d\d\d\d[ ;]+-?\d+\.\d\d.[ ;]+[^ ;]+[ ;]+[^ ;]+[ ;]+)-?\d+\.\d\d/$1 0.00/g; #
$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 Formeln
$list0 =~ s/(\d\d\d\d\d\d\d\d[ ;]+)-?\d+\.\d\d(.*?0.00.*?\{)/$1 0.00$2/g;
# while ($list =~ s/\n\S+\n/\n/gs) { 1; }
# while ($list0 =~ s/\n\S+\n/\n/gs) { 1; }
# return([]) if ($list0 !~ /^(.*?)( *, *|\;\;)(.*?)( *\(|\;\;)(.*?)(\)|\;)/);
# my $buchh = $1;
# my $kto = $3;
# my $md5 = $5;
# return($md5) if ($list !~ /^$buchh( *, *|\;\;)+$kto( *\(|\;\;)$md5(\)|\;)/);
# Rueckgabe des md5-Keys, der nicht passt
if ($lazy == 2) {
if ($list eq $list0) {
return("OK. Rebased target file not changed.");
}
if ($list =~ /\n([a-z0-9][a-z0-9][a-z0-9][a-z0-9])\S*$/) {
$o = $1;
if ($list0 !~ /\n$o\S*$/) {
return("ERROR. Rebased target file not found.");
}
}
}
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 = "";
# while (0 == 0) {
# if (!$o0) {
# $o0 = shift(@$list0);
# $erg0 = $self->sortbuchung($o0);
# }
# if (!$o) {
# $o = shift(@$list);
# $erg = $self->sortbuchung($o);
# }
#print "WW: $erg0 $erg\n";
# last if (!$o0 and !$o);
# if ($erg0 eq $erg) {
# $o0 = "";
# $o = "";
# }
# elsif (!$o or $erg0 lt $erg) {
#print "hier\n";
# $dellist = $dellist . $o0 . "\n";
# $o0 = "";
# }
# else {
# $addlist = $addlist . $o . "\n";
# $o = "";
# }
# }
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;
my $erg; my $kto1; my $kto2; my $datum;
if (ref($text)) {
$datum = $text->[0];
$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;
$kto1 = $3;
$kto2 = $4;
$datum = $1;
} else {
return("9 " . $text);
}
$erg =~ s/[äöüÄÖÜß]/X/g;
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 ($erg =~ /^Brutto-Lohn/) { $erg = "11" . $erg; }
elsif ($erg =~ /^(LST|Lohnsteuer)/) { $erg = "12" . $erg; }
elsif ($erg =~ /^(KST|Kirchensteuer)/) { $erg = "13" . $erg; }
elsif ($erg =~ /^Soli/) { $erg = "14" . $erg; }
elsif ($erg =~ /^KV-Beitrag/) { $erg = "15" . $erg; }
elsif ($erg =~ /^PV-Beitrag/) { $erg = "16" . $erg; }
elsif ($erg =~ /^RV-Beitrag/) { $erg = "17" . $erg; }
elsif ($erg =~ /^AV-Beitrag/) { $erg = "18" . $erg; }
elsif ($erg =~ /^A.-Anteil KV/) { $erg = "20" . $erg; }
elsif ($erg =~ /^A.-Anteil ZU/) { $erg = "21" . $erg; }
elsif ($erg =~ /^A.-Anteil RV/) { $erg = "22" . $erg; }
elsif ($erg =~ /^A.-Anteil PV/) { $erg = "23" . $erg; }
elsif ($erg =~ /^A.-Anteil KI/) { $erg = "24" . $erg; }
elsif ($erg =~ /^A.-Anteil AV/) { $erg = "25" . $erg; }
elsif ($erg =~ /^A.-Anteil ST/) { $erg = "26" . $erg; }
elsif ($erg =~ /^A.-Anteil Umlage 1/) { $erg = "27" . $erg; }
elsif ($erg =~ /^A.-Anteil Umlage 2/) { $erg = "28" . $erg; }
elsif ($erg =~ /^A.-Anteil Inso/) { $erg = "29" . $erg; }
else { $erg = "10" . $erg; }
my $o1 = $kto1;
my $o2 = $kto2;
if (($o1 cmp $o2) > 0) {
$o1 = $kto2;
$o2 = $kto1;
}
$erg = $datum . $erg . $o1;
# print $erg . "\n"; sleep 1;
return($erg);
}
#*****************************************************************
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 ident_key {
my $self = shift;
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' };
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 rule {
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;
while (0 == 0) {
open(FFILE,"<".$file);
my $text = join("",<FFILE>);
close(FFILE);
if ($cmd =~ /^(\d\d\d\d\d\d\d\d),(.*)$/) {
$text = "$1 0.00 -RULE -MERGE 0.00 konto . \n" . $text;
open(FFILE,">".$file);
print FFILE $text;
close(FFILE);
}
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);
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 (!$@) {
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;
open(FFILE,">".$file);
print FFILE $text1;
close(FFILE);
}
last if (!$act_edit);
} else {
last if ($act_edit);
}
if ($^O =~ /^l/i) {
system("joe $file");
} else {
system("notepad $file");
}
$act_edit = 1;
}
}
#*************************************************************************************
sub kto_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 parserule {
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($erg);
}
#*************************************************************************************
sub make_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");
}
}
#*************************************************************************************
1;