| Current Path : /home/ift/52_procpy/finance/misc/ |
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 : //home/ift/52_procpy/finance/misc/IfTRules.pm |
package DivBasicF::IfTRules;
use strict;
use File::Copy;
use Data::Dumper;
sub DELIVER { 2 }
#***********************************************************************************
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
my $file = shift;
my $files = [];
if (!($file)) {
opendir(DDIR,".");
while (0 == 0) {
$file = readdir(DDIR);
last if (!$file);
next if ($file !~ /\.(csv|kto|sql)$/ or $file =~ /^sync/);
push(@$files,$file);
}
closedir(DDIR);
} else {
$files = [$file];
}
if ($#$files > 0) {
print "Ambiguous, found files: " . Dumper($files); exit;
}
if (!@$files) {
print "No file found.\n"; exit;
}
if (!(-f($files->[0]))) {
print "File $file does not exist.\n"; exit;
}
open(FFILE,"<".$files->[0]);
$self->{'TEXT'} = join("",<FFILE>);
close(FFILE);
$self->{'TEXT'} =~ s/\n (\d\d.\d\d.\d\d) /\n$1 /gs;
if ($self->{'TEXT'} =~ s/\n(\d\d)\.(\d\d)\.(9\d) /\n19$3$2$1 /gs) { $self->{'GER'} = 1 }
if ($self->{'TEXT'} =~ s/\n(\d\d)\.(\d\d)\.(\d\d) /\n20$3$2$1 /gs) { $self->{'GER'} = 1 }
$self->{'FILE'} = $files->[0];
return($self);
}
#***********************************************************************************
sub store {
my $self = shift;
my $text = shift;
$text =~ s/\n(\d\d)(\d\d)(\d\d)(\d\d) /\n$4\.$3\.$2 /gs if ($self->{'GER'});
my $o = "xxxxxx";
$text =~ s/^([^\n]+\()(......)(......\))/$1$o$2/s;
open(FFILE,">".$self->{'FILE'});
print FFILE $text;
close(FFILE);
return($text);
}
#***********************************************************************************
#***********************************************************************************
sub umsatzsteuer {
my $self = shift;
my $text = shift || $self->{'TEXT'};
my $plansoll = shift;
my $zeile; my $datum; my $kto1; my $space1; my $space2; my $steuer; my $remark;
my $betrag; my $stkto;
$text =~ /^(\S+)/;
my $konto = $1;
return(0) if ($konto !~ /^(.*?\-?)(12|13|10-0201)\-?(.*?)$/);
# print "ZZ: $ktotyp\n"; sleep 3;
my $kto0 = $1;
my $ktotyp = $2;
while ($text =~ s/\n\d\d\d\d\d\d\d\d[ ;]+([^\n]+) +(7|19) +v\.H\. ([^\n]+)\n/\n/gs) { 1; }
# while ($text =~ s/\n([^\n]*?v\.H\. +[U|V][^\n]*?)\n/\n/gs) { 1; }
my $text1 = "";
foreach $zeile (split(/\n/,$text)) {
$text1 = $text1 . $zeile . "\n";
if ($zeile =~ /^(\d\d\d\d\d\d\d\d[ ;]+)(\-?\d+\.\d\d)([ ;]+[^ ;]+[ ;]+)[^ ;]+([ ;]+)\-?\d+\.\d\d([ ;]+)(qq|qw)(.*?)\s*$/) {
$datum = $1;
$betrag = $2;
$kto1 = $3;
$space1 = $4;
$space2 = $5;
$steuer = $6;
$remark = $7;
$stkto = "11-1502-I";
if ($ktotyp eq "12") { $stkto = "11-1502-U"; }
if ($steuer eq "qq") { $stkto = $stkto . "6" } else { $stkto = $stkto . "7" }
# $stkto = "11-157";
# if ($ktotyp eq "12") { $stkto = "11-177"; }
# if ($steuer eq "qq") { $stkto = $stkto . "5-" } else { $stkto = $stkto . "1-" }
# $stkto = $stkto . substr($datum,2,2);
# if (substr($datum,4,2) =~ /^(01|02|03)$/) { $stkto = $stkto . "1"; }
# elsif (substr($datum,4,2) =~ /^(04|05|06)$/) { $stkto = $stkto . "2"; }
# elsif (substr($datum,4,2) =~ /^(07|08|09)$/) { $stkto = $stkto . "3"; }
# elsif (substr($datum,4,2) =~ /^(10|11|12)$/) { $stkto = $stkto . "4"; }
# else { $stkto = $stkto . "5"; }
if ($steuer eq "qq") { $steuer = 19 } else { $steuer = 7 }
$space2 = $space2 . " " if ($space1 =~ /\;/);
$remark = " von $betrag (" . $remark . ")";
if ($ktotyp eq "12") { $remark = " v.H. USt." . $remark } else { $remark = " v.H. Vorst. " . $remark }
$text1 = $text1 . $datum . sprintf("%3.2f",$betrag*$steuer*(-0.01)/(1+0.01*$steuer)) .
$kto1 . $stkto . $space1 . "0.00" . $space2 . $steuer . $remark . "\n";
}
}
# Anfuegen von Planzahlen
# print "______________________\n";
# sleep 5;
# while ($text1 =~ s/\n\d\d\d\d\d\d\d\d [^\n]*\D\-\d\d\d\d\D[^\n]*Plan +(Soll|Ist)[^\n]*\n/\n/s) { 1; } # alle Planungen loeschen
foreach $zeile (split(/\n/,$plansoll)) {
next if ($zeile !~ /^(1[23]\-)(\d\d\d\d) +(.*) +(\-?\d+\.\d\d)/);
$ktotyp = $1;
$kto1 = $2;
$remark = $3;
$betrag = $4;
$remark =~ s/^(\S+)(.*)$/$1/;
while ($text1 =~ s/\n\d\d\d\d\d\d\d\d [^\n]*\D\-$kto1\D[^\n]*Plan +(Soll|Ist)[^\n]*\n/\n/s) { 1; }
$text1 = $text1 . substr($datum,0,4) . "0102 " . $betrag . " -" . $kto1 . "-soll 11-4999 0.00 Plan Soll $remark\n"
. substr($datum,0,4) . "0102 " . "0.00" . " -" . $kto1 . "-ist 10-4998 0.00 Plan Ist"
. " {-$kto1+$kto1-soll+$kto1-ist}\n";
}
# print substr($text1,0,5000); exit;
return($self->store($text1));
}
#*******************************************************************************************
sub sozialbeitraege {
my $self = shift;
my $text1 = shift || $self->{'TEXT'};
my $sozdata = shift;
$main::PERSON = {};
my $zeile; my $jahr;
my $jahr1; my $monat1; my $tag1; my $datum1; my $betrag; my $person; my $kasse;
my $anteile; my $art; my $o; my $o1; my $o2; my $o3; my $betrag9; my $jahr2;
my $sozkeys1; my $sozdata1; my $z; my $kname; my $lst; my $sonder; my $text7; my $lzz;
my $kin; my $kvsatz; my $kstsatz; my $sozver;my $text9; my $lohnberechnung; my $summen;
my $religion; my $php_lohn; my $rvbefreit; my $dez11;
my $betrag_grenze_rv; my $betrag_grenze_kv; my $b_art;
my $rueckbuchungen = 1;
my $faktor = { 2007 => 0.7673, 2008 => 0.7732,
2009 => 0.7472, 2010 => 0.7585,
2011 => 0.7435, 2012 => 0.7491,
2013 => 0.7605, 2014 => 0.7605,
2015 => 0.7585, 2016 => 0.7547 }; # Gleitzonenfaktor
my $beitragsobergrenze = { 2013 => [5800,3937.50], 2014 => [5950,4050] ,
2015 => [6050,4125] , 2016 => [6200,4237.50] };
my $gleitzonenuntergrenze; my $gleitzonenobergrenze;
return() if ($sozdata !~ /PERSON +(.*?)\n/s);
my $sozkeys = ["",split(/ +/,$1)];
my $text = [];
foreach $zeile (split(/\n/,$text1)) {
next if ($zeile =~ /^\d\d\d\d\d\d\d\d/ and
$zeile !~ /(Saldovortrag|Korrektur|Rundung|Txxxabelle|Zuschuss|ausweis|usatzzahl|\{.*\}|gezahlt.*\{)/ and
$zeile !~ /\-(LOHN|LOHNG|LOHNH|SOND|KURZ|ZAHL|LxxxST|LxxxSTU|XAR|XPL|RULE)/ and
$zeile !~ /-gezahlt/);
# next if ($zeile =~ /-berechn /);
# next if ($zeile =~ /(gezahlt|berechn).*\{.*\}/);
$zeile = sprintf("%8u",substr($zeile,0,8)-1).substr($zeile,8) if ($zeile =~ /-SOND +\S/); # damit SOND-Zeilen stets
push(@$text,$zeile); # vor LOHN-Zeilen stehen
}
$text1 = "";
foreach $zeile (shift(@$text),shift(@$text),sort @$text) {
$zeile = sprintf("%8u",substr($zeile,0,8)+1).substr($zeile,8) if ($zeile =~ /^\d\d\d\d\d\d\d\d.*-SOND/);
$text1 = $text1 . $zeile . "\n";
next if ($zeile !~ /^(\d\d)(\d\d)(\d\d)(\d\d)[ ;]+(\S+)[ ;]+(\-AN\-)([a-z]+)\-(LOHN|LOHNG|LOHNH|LxxxST|SOND)[ ;]/);
$jahr1 = $1 . $2;
$jahr2 = $2;
$monat1 = $3;
$tag1 = $4;
$datum1 = $1 . $2 . $3 . $4;
$betrag = $5;
$person = $7;
$art = $8;
$dez11 = $1 . $2 . $3;
if (!$php_lohn) {
open(FFILE,"<rule.pl");
$o1 = join("",<FFILE>);
close(FFILE);
$rueckbuchungen = 0 if ($o1 =~ /\"11-1503-P\"/); # wenn Jahresmeldung, kann alles rueckgebucht werden
open(FFILE,"<lohn$jahr2.php");
$php_lohn = join("",<FFILE>);
close(FFILE);
$php_lohn =~ s/\n( +\$wert1 += +number_format[^\n]*?)\n([^\n]*?)\n([^\n]*?)\n( +return +\$wert)/\n\/\/$1\n\/\/$2\n\/\/$3\n$4/s;
}
if ($art eq "SOND") { $sonder->{$person} = $sonder->{$person} + $betrag; next; }
if ($art =~ /^LOHN/) { $betrag = $betrag + $sonder->{$person}; $sonder->{$person} = 0; }
$betrag = (-0.01) * $betrag;
next if ($sozdata !~ /\n($person.*?)\n\D/s);
$rvbefreit = 0;
if ($dez11 == 201112) { $dez11 = 1 } else { $dez11 = 0 }
$main::PERSON->{$person} = $person;
$sozdata1 = [split(/\n/,$1)];
while ($#$sozdata1 > 0) {
last if (substr($sozdata1->[1],0,8) > $datum1);
shift(@$sozdata1);
}
$sozdata1 = [split(/ +/,$sozdata1->[0])];
# print Dumper($sozdata1);
# RV AV KV PV , SZ KS ZU KI
# 19.9 4.2 1.7 14.5, 8 5.5 0.9 0.25,
# 19.9 4.2 1.7 14.5, 25 1.2 0.3 0.1
# RV AV KV PV , PL U1 U2 U3
$sozkeys1 = [@$sozkeys];
$kvsatz = 0;
$betrag_grenze_rv = 99999999;
$betrag_grenze_kv = 99999999;
if ($beitragsobergrenze->{$jahr1}) {
$betrag_grenze_rv = 0.01 * $beitragsobergrenze->{$jahr1}->[0];
$betrag_grenze_kv = 0.01 * $beitragsobergrenze->{$jahr1}->[1];
}
$betrag_grenze_kv = $betrag if (substr($tag1,0,1) == "0" or $betrag_grenze_kv > $betrag);
$betrag_grenze_rv = $betrag if ($betrag_grenze_rv > $betrag); # keine Beitragsobergrenze, wenn Lohndatum mit 0 beginnt
while (@$sozkeys1) {
$b_art = "";
$z = shift(@$sozkeys1);
$o = shift(@$sozdata1);
$o2 = "";
if ($z eq "LST") { $lst = $o; } # Ermitteln der Lohnsteuergruppe
elsif ($z eq "KK") { $kname = $o; } # Ermitteln der Kasse
elsif ($z eq "KNR") { $kasse = $o; } # Ermitteln der Kasse
elsif ($z eq "RVN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-RV 11-$kasse-RV-AN-$person"; $b_art = "RV";
$rvbefreit = $rvbefreit + 1 if ($o == 0) }
elsif ($z eq "KVN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-KV-S 11-$kasse-KV-AN-$person"; $b_art = "KV";
$kvsatz = $kvsatz + $o; }
elsif ($z eq "AVN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-AV 11-$kasse-AV-AN-$person"; $b_art = "RV"; }
elsif ($z eq "PVN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-PV-S 11-$kasse-PV-AN-$person"; $b_art = "KV"; }
elsif ($z eq "SZ" ) { $sozver = $o }
elsif ($z eq "KS" ) { $kstsatz = substr($o,0,1); $religion = "K".uc(substr($o,1,1)); }
# elsif ($z eq "SZ" and $art eq "LST") { $o2 = "-AN-$person-SZ 11-1503-SZ-$person"; }
# elsif ($z eq "KS" and $art eq "LST") { $o2 = "-AN-$person-KS 11-1503-KS-$person"; }
elsif ($z eq "ZUN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-KV-Z 11-$kasse-KV-ZU-$person"; $b_art = "KV";
$kvsatz = $kvsatz + $o; }
elsif ($z eq "KIN" and $art =~ /^LOHN/) { $o2 = "-AN-$person-PV-Y 11-$kasse-PV-KI-$person"; $b_art = "KV";
$kin = 0; $kin = 1 if ($o > 0); }
elsif ($z eq "RVR" and $art =~ /^LOHN/) { $o2 = "-AR-$person-RV 11-$kasse-RV-AR-$person"; $b_art = "RV";
$rvbefreit = $rvbefreit + 1 if ($o == 0) }
elsif ($z eq "KVR" and $art =~ /^LOHN/) { $o2 = "-AR-$person-KV 11-$kasse-KV-AR-$person"; $b_art = "KV";
$kvsatz = $kvsatz + $o; }
elsif ($z eq "AVR" and $art =~ /^LOHN/) { $o2 = "-AR-$person-AV 11-$kasse-AV-AR-$person"; $b_art = "RV"; }
elsif ($z eq "PVR" and $art =~ /^LOHN/) { $o2 = "-AR-$person-PV 11-$kasse-PV-AR-$person"; $b_art = "KV"; }
elsif ($z eq "PL" and $art =~ /^LOHN/) { $o2 = "-PL-$person-PL 11-1503-PL-$person" if ($o > 0); }
elsif ($z eq "ST" and $art =~ /^LOHN/) { $o2 = "-AR-$person-ST 11-$kasse-ST-AR-$person"; }
elsif ($z eq "U1" and $art =~ /^LOHN/) { $o2 = "-AR-$person-U1 11-$kasse-U1-AR-$person"; }
elsif ($z eq "U2" and $art =~ /^LOHN/) { $o2 = "-AR-$person-U2 11-$kasse-U2-AR-$person"; }
elsif ($z eq "U3" and $art =~ /^LOHN/) { $o2 = "-AR-$person-U3 11-$kasse-U3-AR-$person"; }
next if (!$o2);
next if ($o <= 0);
$o3 = $o * $betrag + 0.00001;
$o3 = $o * $betrag_grenze_rv + 0.00001 if ($b_art eq "RV");
$o3 = $o * $betrag_grenze_kv + 0.00001 if ($b_art eq "KV");
$o3 = (-1) * $o3 if ($art eq "LST");
# print "WW: $o2 $o3 $o $betrag $b_art $betrag_grenze_rv $betrag_grenze_kv\n";
if ($art =~ /^LOHN(G|H)$/) { # Gleitzonenkorrektur
$gleitzonenuntergrenze = 400 / 100;
$gleitzonenobergrenze = 800 / 100;
$gleitzonenuntergrenze = 450 / 100 if ($art eq "LOHNH");
$gleitzonenobergrenze = 850 / 100 if ($art eq "LOHNH");
#print "hier0 $person $o3 $betrag $o2\n";
if ($betrag > 0 and $betrag < $gleitzonenobergrenze and (
$o2 =~ /^\-AN\-$person\-(RV|PV|AV|KV)/ or $o2 =~ /^\-AR\-$person\-U\d/) ) {
if ($art eq "LOHNG") { # Formel bis 2012 und im Bestandsfall bis 2014:
$betrag9 = ($faktor->{$jahr1} * 400) + (2 - $faktor->{$jahr1}) * (100*$betrag - 400);
} else {
$betrag9 = ($faktor->{$jahr1} * 450) +
( (850/(850-450)) - (450/(850-450)) * $faktor->{$jahr1} ) * (100*$betrag - 450);
}
if ($betrag < $gleitzonenuntergrenze) {
$betrag9 = ($faktor->{$jahr1}) * 100 * $betrag;
}
# print "II: $betrag9 $betrag\n"; sleep 1;
if ($o2 =~ /^\-AN\-$person\-(PV-Y|KV-Z)/ or $o2 =~ /^\-AR\-$person\-U\d/) {
$o3 = $o3 - $o3 * 1 * (1 - $betrag9/(100*$betrag));
} else {
$o3 = $o3 - $o3 * 2 * (1 - $betrag9/(100*$betrag));
}
#print "hier1 $person $o3 $betrag\n";
}
}
$o3 = sprintf("%8.2f",$o3);
$o2 =~ s/^(\-)(AN|AR|PL)(\-$person\-)(..)(.*)$/$datum1 $o3 $1$2$3$4$5 0.00 $2\-Anteil $4/;
$o2 =~ s/\-PL / /g;
$o2 =~ s/AN-Anteil SZ /Soli /;
$o2 =~ s/(A[RN]-Anteil )(KV|RV|PV|AV)(.*)$/$1$2$3, $kname/;
$o2 =~ s/AN-Anteil SZ/SoliZuschl/;
$o2 =~ s/AN-Anteil KS/Kirchensteuer/;
$o2 =~ s/AR-Anteil U1/Umlage 1/;
$o2 =~ s/AR-Anteil U2/Umlage 2/;
$o2 =~ s/AR-Anteil U3/Insolvenzumlage/;
$o2 =~ s/AR-Anteil ST/Pauschalsteuer/;
$o2 =~ s/PL-Anteil PL/Pauschale Lohnsteuer/;
$o2 =~ s/(KV-Z.*)AN-Anteil KV/$1AN-Zuschl KV/;
$o2 =~ s/(PV-Y.*)AN-Anteil PV/$1KI-Zuschl PV/;
$text1 = $text1 . $o2 . "\n";
# Umbuchung auf PKV-Anteil:
if ($o2 =~ s/^(.*[ ;])([^ ;]+)([ ;]+0.00[ ;]+.*PKV-Zuschuss.*)/$1 11-$kasse-AR-$person $3/) {
$text1 = $text1 . $o2 . "\n";
}
}
# --- Steuerberechnung per php-Skript
if ($lst !~ /\./) { $lst = $lst . ".00"; }
$rvbefreit = 0 if ($rvbefreit != 2);
foreach $lzz (2,1) {
next if ($lzz == 1 and substr($tag1,1,1) != 7); # Jahreskorrektur anbringen, wenn Lohndatum am [012]7. des jeweiligen Monats endet
$o3 = sprintf("%3.2f",$betrag * 100);
if ($lzz == 2) {
$summen->{'Brutto-'.$person} = $summen->{'Brutto-'.$person} + $o3;
} else {
$o3 = sprintf("%3.2f",$summen->{'Brutto-'.$person});
}
if ($lst =~ /^(\d)\.(\d)(\d)$/) {
$o2 = <<"TEXT_ENDE"
\$_POST['stkl'] = $1;
\$_POST['zkf'] = $2.$3;
\$_POST['r'] = $kstsatz;
\$_POST['kinderlos'] = $kin;
\$_POST['lzz'] = $lzz;
\$_POST['re4'] = $o3;
\$_POST['kvsatz'] = $kvsatz;
\$_POST['anpdez'] = $dez11;
\$_POST['e_krv'] = $rvbefreit;
TEXT_ENDE
}
$text9 = $php_lohn;
$text9 =~ s/\n/\n$o2/s;
if (!(exists($lohnberechnung->{$person.$text9})) and $lst > 0) { # Caching der Steuerberechnung
# print("_lohn_$person$lzz.php created...\n");
mkdir("_php_EXCLUDE_");
open(FFILE,">_php_EXCLUDE_/_lohn_EXCLUDE_$person$lzz.php");
print FFILE $text9;
close(FFILE);
$lohnberechnung->{$person.$text9} = `php _php_EXCLUDE_/_lohn_EXCLUDE_$person$lzz.php 2> /dev/null`;
}
if (-f "_php_EXCLUDE_/_lohn_EXCLUDE_$person"."2.php") {
system("cp _php_EXCLUDE_/_lohn_EXCLUDE_$person"."2.php _php_EXCLUDE_/_lohn_EXCLUDE_$person\_$monat1.php");
}
$text9 = $lohnberechnung->{$person.$text9};
$text9 =~ s/Solidarit.*?ts/Solidaritaets/gs;
$text9 =~ s/ 0\.\</ 0.00\</gs;
while ($text9 =~ s/(Lohnsteuer|Kirchensteuer|Solidaritaetszuschlag)\:.*?(\d?\.?\d+)\.(\d\d)//s) {
$z = "$2,$3";
$o2 = $1;
$o3 = "";
$z =~ s/\.//gs;
$z =~ s/\,/./gs;
next if ($o2 eq "Kirchensteuer" and $kstsatz == 0 and $religion eq "K");
last if ($lzz == 2 and $z == 0 and $o2 eq "Lohnsteuer");
if ($lzz == 1) {
$z = sprintf("%8.2f",$z - $summen->{$o2."-".$person});
$o3 = "Jahreskorrektur ";
next if ($z < 1 and $z > -1);
}
$text1 = $text1 . "$datum1 $z -AN-$person-$o2 11-1503-$o2-$person 0.00 $o3$o2\n";
if ($rueckbuchungen and $lzz == 1 and $z + $summen->{'LAST-'.$o2."-".$person} < 0) {
$z = sprintf("%3.2f",-$summen->{'LAST-'.$o2."-".$person} - $z);
print "Rueckbuchung $o2 $person: $z\n";
$text1 = $text1 . "$datum1 $z -AN-$person-$o2 11-1503-$o2-$person 0.00 Rueckbuchung $o2\n";
}
$summen->{$o2."-".$person} = $summen->{$o2."-".$person} + $z;
$summen->{'LAST-'.$o2."-".$person} = $z;
}
}
$text1 =~ s/-Kirchensteuer-/-$religion-/g;
}
$text1 =~ s/-Lohnsteuer-/-LS-/g;
$text1 =~ s/-Solidaritaetszuschlag-/-SZ-/g;
$text1 =~ s/-Lohnsteuer /-LSTU /g;
$text1 =~ s/-Kirchensteuer +11-1503-K([A-Z])-/-K$1 11-1503-K$1-/g;
$text1 =~ s/-Solidaritaetszuschlag /-SZ /g;
$text1 =~ s/ Solidaritaetszuschlag/ SolidZuschl/g;
# print $text1; exit;
# Ergaenzung der berechneten und gezahlten Steueranteile <- war vormals in den Lohnkonten drin, ist jetzt in 10-7001
$text9 = $text1;
# print $text9; exit;
while ($text9 =~ / -AN-([a-z]+)-(LOHN |LOHNG|LOHNH|SOND|LSTU|K[A-Z]|SZ|RV|AV|PV-[SXY]|KV-[SXY]) +([\d\-]+)/) {
# while ($text9 =~ / -AN-([a-z]+)-(LOHN|SOND|LSTU|K[A-Z]|SZ|RV|AV|PV|KV) +([\d\-]+)/) {
# print "hier\n"; #sleep 1;
# print "$1 $2 $3\n"; sleep 1;
$person = $1;
$o1 = $2;
$o1 =~ s/(-[SXY]| )//;
$o3 = $3;
$o2 = $o1;
$o2 = "LS" if ($o2 eq "LSTU");
$text9 = $text9 . "\n -AN-$person-LSTU 0.00\n -AN-$person-SZ 0.00\n" if ($o1 =~ /^LOHN/);
$text9 =~ s/ -AN-$person-$o1[\-SXY]* +$o3//g;
#next;
$text1 = $text1 . $jahr1 . "1230 1.00 -AN-$person-$o1-berechn 10-7001-$person-$jahr2-$o1 0.00 " .
"Berechnung \{-AN-$person-$o1+AN-$person-$o1-gezahlt+AN-$person-$o1-berechn\}\n"
if ($text1 !~ / -AN-$person-$o1-berechn /);
$text1 = $text1 . $jahr1 . "1230 1.00 -AN-$person-$o1-gezahlt 10-7001-$person-$jahr2-$o1 0.00 " .
"Steuerausweis \{-AN-$person-$o1-berechn\}\n" if ($text1 !~ / -AN-$person-$o1-gezahlt /);
}
# $text1 =~ s/(LOHNG|LOHNH|SOND|LOHN|BRUTTO)-gezahlt(.*?)(LOHNG|LOHNH|SOND|LOHN|BRUTTO)( .*Steuerausweis)/LOHN-gezahlt$2LOHN $4/g;
# $text1 =~ s/(KE|KR|KA|KB|KS)-gezahlt(.*?)(KE|KR|KA|KB|KS)( .*Steuerausweis)/KE-gezahlt$2KE $4/g;
# $text =~ s/\n---INSERT---\n/$text1/s;
# $text =~ s/---INSERT---\n//gs;
return($self->store($text1));
}
#*******************************************************************************************
sub abschreibung {
my $self = shift;
my $text = shift || $self->{'TEXT'};
my $gueter = {};
my $anschaffungsmonat = {};
my $zeile; my $zeile1; my $o; my $jahr; my $jh; my $gut; my $monat;
foreach $zeile (split(/\n/,$text)) {
if ($zeile =~ /^(\d\d)(\d\d)(\d\d)(\d\d)[ ;]+(\-?\d+\.\d\d)[ ;]+\-(\d\d)([0123456789ABC])(\_\d+\_[a-z0-9]+)\-([A-Z][A-Z])/) {
$jh = $1;
$jahr = $2;
$o = $6;
$monat = $7;
$gut = $o.$monat.$8;
$gueter->{$gut}->{$9} = $gueter->{$gut}->{$9} + $5;
if ($o !~ $jahr) { $monat = "01"; } # wenn nicht im Anschaffungsjahr, dann mit der Abschreibung schon im Januar beginnen
elsif ($monat eq"A") { $monat = "10"; }
elsif ($monat eq"B") { $monat = "11"; }
elsif ($monat eq"C") { $monat = "12"; }
$anschaffungsmonat->{$gut} = $monat;
}
}
while ($text =~ s/\n(\d\d\d\d\d\d\d\d)[^\n]+(Abschreibung|Korrektur Restabschreibung)[^\n]+\n/\n/gs) { 1; }
foreach $o (keys %$gueter) {
if (!(exists($gueter->{$o}->{'AN'}))) { # Entfernen der Abschreibungen OHNE Anschaffungswert
while ($text =~ s/^\n$jahr.[^\n]+$o-AS[^\n]+\n/\n/gs) { 1; }
}
if ($o =~ /^(.*?)\_(.*?)\_(.*)$/) {
$text = $text . $jh . $jahr . "1231 0.00 -$o-AS 13-6540 0.00 Abschreibung {-($o-AN*(1\/$2)";
if ($2 > 1 and $anschaffungsmonat->{$o} ne "01") { # falls Abschreibung ueber einem Jahr, die
# Abschreibung in dem jeweiligen Monat beginnen lassen
$text = $text . "*(" . sprintf("%1u",13-$anschaffungsmonat->{$o}) . "\/12)";
}
$text = $text . ")\}\n";
}
$zeile1 = $gueter->{$o}->{'AN'} + $gueter->{$o}->{'AS'}; # wenn die gesamte Abschreibung
if ($zeile1 < -0.001) { # groesser ist als der Anschaffungswert, dann entsprechend korrigieren
#print "QQQ: $o $zeile1\n";
$text = $text . $jh . $jahr . "1231 0.00 -$o-AX 13-6540 0.00 Korrektur Restabschreibung {-($o-AS)-($o-AN)}\n";
}
}
# print Dumper($gueter); exit;
return($self->store($text));
}
#*******************************************************************************************
sub saldovortrag {
my $self = shift;
my $text = shift || $self->{'TEXT'};
my $buchh = shift;
my $o1; my $o2;
$text =~ s/(\d\d\d\d)(0101[ ;]+-?\d+\.\d\d[ ;]+\-[^ ;]*[ ;]+)([^ ;]+)([ ;]+)(\-?\d+\.\d\d[ ;]+)(.*)/$1$2$3$4$5Saldovortrag \{-(::___$1___-$3)\}/g;
while ($text =~ /___(\d\d\d\d)___/) {
$o1 = $1;
$o2 = sprintf("%04u",$o1-1);
$text =~ s/___$o1\___/$o2/g;
}
$text =~ s/(\{\-\(\:\:2001\-.*?\))\}/$1\/1.95583\}/g;
# $text =~ s/\{\-\(\:\:2005/\{\-\(\:\:\:\:ARCHIVE-$buchh-2005/g;
# $text =~ s/Sxaxldo/Saldo/gs;
# $text =~ s/(Saldovortrag \{)-/$1/g;
# $text =~ s/(Saldovortrag \{-\()-/$1/g;
# print $text; exit;
return($self->store($text));
}
#*******************************************************************************************
# Allgemeine Hilfsfunktion zum Lesen von Formularen
sub formular {
my $self = shift;
my $text = shift || $self->{'TEXT'};
my $file; my $file1; my $o; my $o1; my $o2; my $o3; my $o4; my $text2;
my @ee = ();
my $formular_parser = [];
# while ($text =~ s/\n\d\d\d\d\d\d\d\d (.*?)\n/\n/gs) { 1; } # alle Buchungen loeschen
my $text1 = {};
my $nr1 = {};
my $allfiles = "\n";
my $change_date = {};
opendir(DDIR,".");
while (0 == 0) {
$file = readdir(DDIR);
print $file . "\n" if ($file =~/UST/);
last if (!(defined($file)));
if ($file =~ /\~$/) {
unlink($file);
}
elsif ($file =~ /\.txt$/) { # alte txt-Files loeschen
# unlink($file);
$allfiles = $allfiles . $file . "\n";
}
elsif ($file =~ /^render\./) { # alle Parser zusammenfassen
push(@$formular_parser,$file);
}
elsif ($file =~ /\.(pdf|manuell|lexware|elfo)$/) { # alle Formulare zusammenfassen
$o1 = $file;
$o1 =~ s/ /\_/g;
$o1 =~ s/\_\-/\_/g;
$o1 =~ s/\-\_/\_/g; # Normierung der Dateinamen
$o1 =~ s/Ä/Ae/g; # fuer Linux
$o1 =~ s/Ö/Oe/g;
$o1 =~ s/Ü/Ue/g;
$o1 =~ s/ä/ae/g;
$o1 =~ s/ö/oe/g;
$o1 =~ s/ü/ue/g;
$o1 =~ s/ß/ss/g;
$o1 =~ s/,/\_/g;
move($file,$o1);
push(@ee,$o1);
}
}
closedir(DDIR);
foreach $o (sort @ee) {
next if ($o !~ /^(.*)\.(pdf|manuell|lexware)$/);
next if ($o =~ /obsolete\./);
print "Found pdf-File $o ...\n";
$file = $1;
$o1 = $2;
copy("$file.manuell","$file.EXCLUDE.txt") if ($o1 eq "manuell"); # Text-File erstellen
copy("$file.lexware","$file.EXCLUDE.txt") if ($o1 eq "lexware"); # Text-File erstellen
if ($o1 eq "pdf") {
if ((stat("$file.pdf"))[7] < 250) { # Text-File erstellen
copy("$file.pdf","$file.EXCLUDE.txt");
} else {
if (!(-f "$file.EXCLUDE.txt")) {
# if ($allfiles =~ s/\n([^\n]*?$file\.[^\n]*?)\n/\n/s) { # Text-File erstellen
# move($1,"$file.txt"); # in $allfiles werden die schon bestehenden Textfiles festgehalten
# } else {
print "$file\n";
open(FFILE,"<$file.pdf");
$o1 = <FFILE>;
close(FFILE);
if ($o1 =~ /1\.4/) {
system("pdftotext -layout $file.pdf; mv $file.txt $file.EXCLUDE.txt");
} else {
system("pdftops $file.pdf; ps2ascii $file.ps > $file.EXCLUDE.txt; rm $file.ps");
}
}
}
}
print "$file\n";
open(FFILE,"<$file.EXCLUDE.txt");
$o1 = join("",<FFILE>);
close(FFILE);
$o1 =~ s/Ä/Ae/g; # Sonderzeichen eliminieren
$o1 =~ s/Ö/Oe/g;
$o1 =~ s/Ü/Ue/g;
$o1 =~ s/ä/ae/g;
$o1 =~ s/ö/oe/g;
$o1 =~ s/ü/ue/g;
$o1 =~ s/ß/ss/g;
$o1 =~ s/\"A/Ae/g;
$o1 =~ s/\"O/Oe/g;
$o1 =~ s/\"U/Ue/g;
$o1 =~ s/\"a/ae/g;
$o1 =~ s/\"o/oe/g;
$o1 =~ s/\"u/ue/g;
$o1 =~ s/\"s/ss/g;
$o1 =~ s/A\"/Ae/g;
$o1 =~ s/O\"/Oe/g;
$o1 =~ s/U\"/Ue/g;
$o1 =~ s/a\"/ae/g;
$o1 =~ s/o\"/oe/g;
$o1 =~ s/u\"/ue/g;
$o1 =~ s/s\"/ss/g;
open(FFILE,">$file.EXCLUDE.txt");
print FFILE $o1;
close(FFILE);
$o3 = $file;
my $o31;
foreach $o1 (@$formular_parser) { # Suchen des passenden Parsers
$o2 = `perl $o1 $file.EXCLUDE.txt`;
print "perl $o1 $file.EXCLUDE.txt\n";
if ($o2 =~ s/^([0-9\_]*)(.*?)\n//s) {
$o3 = $1.$2;
$o31 = $2;
$o4 = "";
if ($o2 =~ s/(\d\d)___ADD___/---XXX---/gs) {
$o4 = sprintf("%02u",$1 + $change_date->{$o31});
$change_date->{$o31} = $change_date->{$o31} + 1;
$o2 =~ s/---XXX---/$o4/g;
}
$text1->{$o3.$o4} = $o2;
if (!$o3 or $o3 =~ /[^A-Za-z0-9\-\_\.]/) { next; }
print " ... $o3$o4 parsed with $o1 --------------------------> \n";
print " move to: $o3\n";
move("$file.EXCLUDE.txt","$o3.EXCLUDE.txt") if (-f "$file.EXCLUDE.txt");
move("$file.manuell","$o3.manuell") if (-f "$file.manuell");
move("$file.lexware","$o3.lexware") if (-f "$file.lexware");
move("$file.pdf","$o3.pdf") if (-f "$file.pdf");
move("$file.elfo","$o3.elfo") if (-f "$file.elfo");
$o2 = "OK";
last;
}
}
}
return($self->store(join("",$text."\n",values %$text1)));
}
#*******************************************************************************************
#*******************************************************************************************
sub xxrender_abschreibungen {
my $self = shift;
my $text = shift;
my $o; my $o1; my $position; my $restwert;
my $jh; my $year; my $year1; my $anschaffung; my $halbjahr;
my $afazeitraum; my $schon_abgeschrieben; my $kaufwert;
my $abschreibung; my $anteil; my $restanteil; my $year0;
my $text1 = "";
if ($text =~ /^(.*?)(\d\d)(\d\d)/) {
$jh = $2; # Jahrhundert
$year = $3; # Jahr
$year1 = $year + 1;
$year0 = sprintf("%4u",$jh * 100 + $year - 1);
} else {
return($text);
}
while ($text =~ s/\n$year0([^\n]*?)\n/\n/s) { 1; }
# while ($text =~ s/\n$jh$year([^\n]*?)Abschreibung \(([^\n]*?)\n/\n/s) { 1; }
# print "TT: $year0 $text\n"; sleep 30;
while ($text =~ s/\n10\-0201\-(\S+) +(\-?\d+\.\d+)//s) {
$position = $1;
$restwert = $2;
$o1 = "";
$o1 = $jh . $year . "0101 0.00 -"."$position 11-1805 0.00 Saldovortrag\n"
if ($position =~ /^(\d\d)(\d)\_1\_(.*)$/ and $text =~ /$position/);
while ($text =~ s/\n10\-0201\-$position +(\-?\d+\.\d+)//s) {
$o = $1;
$o1 = $jh . $year . "0101 0.00 -"."$position 11-1805 0.00 Saldovortrag\n" if ($o > 0);
if ($o < $restwert) {
$restwert = $o;
}
}
if ($restwert <= 0) {
while ($text =~ s/\n$jh$year([^\n]*?) \-$position ([^\n]*?)Saldovortrag([^\n]*?)\n/\n/s) { 1; }
}
if ($text !~ /$jh$year([^\n]*?) \-$position ([^\n]*) Saldovortrag/) {
$text1 = $text1 . $o1;
}
# if ($position =~ /8.*sammel/) { print "RRR: $restwert \n"; sleep 30 }
if ($text =~ s/\n(\d\d)(\d\d)12\d\d +(\-?\d+\.\d+) +\-$position +\S+ +\d+\.\d+ +Abschreibung(.*?)\n/\n/s) {
$restwert = $3 - $restwert;
$restwert = (-1) * $restwert;
$year1 = $year + 1;
}
if ($position =~ /^(\d\d)(.)\_(\d+)\_(.*)$/) {
$anschaffung = $1;
$halbjahr = $2;
$afazeitraum = $3;
# if ($halbjahr < 3) { $halbjahr = 0 } else { $halbjahr = 0.5 }
if ($halbjahr eq "A") { $halbjahr = 10; }
if ($halbjahr eq "B") { $halbjahr = 11; }
if ($halbjahr eq "C") { $halbjahr = 12; }
$halbjahr = ($halbjahr - 1) / 12;
$anschaffung = $anschaffung + $halbjahr; # Monat der Anschaffung
if ($anschaffung > $year1) { $year1 = $year1 + 100 }
$schon_abgeschrieben = ($year1 - $anschaffung - 1);
if ($schon_abgeschrieben < 0) { $schon_abgeschrieben = 0 }
$restanteil = sprintf("%3.2f",$afazeitraum - $schon_abgeschrieben);
$restanteil =~ s/^(.*?)(0*)$/$1/;
$restanteil =~ s/^(.*?)\.$/$1/;
if ($restanteil > 0 and $restwert > 0) {
$kaufwert = $restwert * $afazeitraum / $restanteil;
$kaufwert = sprintf("%3.2f",$kaufwert);
$anteil = "1"; # abzuschreibender Anteil
if ($year1 - $anschaffung < 1 and $afazeitraum > 1) { $anteil = (1 - $halbjahr) }
$abschreibung = sprintf("%3.2f", -$anteil * $kaufwert / $afazeitraum);
if ($restwert + $abschreibung < 1) { $abschreibung = - $restwert }
$anteil = sprintf("%3.2f",$anteil);
$anteil =~ s/^(.*?)(0*)$/$1/;
$anteil =~ s/^(.*?)\.$/$1/;
$text1 = $text1 . $jh . $year . "1231 "."$abschreibung -"."$position 13-6540 0.00 Abschreibung ($anteil".
"/" . "$afazeitraum von $restanteil"."/"."$afazeitraum, $kaufwert EUR)\n";
}
# print "$position $anschaffung $halbjahr $restwert $year1 $schon_abgeschrieben $kaufwert $abschreibung\n"; sleep 3;
}
}
# print $text . $text1; sleep 30;
$text = $text . $text1;
return($text);
}
#***********************************************************************************
#***********************************************************************************
sub xxkonto {
my $self = shift;
my $dd1 = shift;
my $mm1 = shift;
my $text = shift;
my $text1 = $text;
my $renderer; my $kto; my $o; my $o1; my $o2; my $pattern; my $chkto; my $ust;
my $p4; my $p5;
my $p6; my $p7;
my $p8; my $p9;
my $erg = $self->{'FIBU'}->parserule($text,"RENDERER",\$renderer,\$kto);
my @pars = split(/,/,$renderer);
$renderer = shift(@pars);
my $dir = Cwd::cwd();
$dir =~ s/^\\/\//g;
$dir =~ s/^[A-Z]\://;
$dir =~ s/\/+$//g;
$dir = "/" . $dir;
$dir =~ s/\/\//\//gs;
my $basis = $pars[0];
my $text2 = "";
while (0 == 0) { # Einlesen von Dateien
foreach $o ("","a","b","c","d","e","f","g","h","i","j","k",
"_01","_02","_03","_04","_05","_06","_07","_08","_09","_10","_11","_12") {
next if (!(-f("$dir/$basis$o.csv")));
print "Read in File: $dir/$basis$o.csv\n";
system("xcv1 utf $dir/$basis$o.csv");
open(FFILE,"<$dir/$basis$o.csv");
$text2 = $text2 . "\n" . join("",<FFILE>);
close(FFILE);
}
last if ($text2);
$dir =~ s/^(.*)\/(.*)$/$1/;
last if (!$dir);
}
if ($text2) { $text1 =~ s/^(.*?)\n($dd1 .*)$/$1\n$text2/s; }
$basis = $self;
if ($renderer =~ s/^(.*?)\_\_(.*)$/$2/) {
$basis = "Application::IfTRules_$1";
eval("use $basis");
$basis = $basis->new($self->{'FIBU'});
}
eval("\$text1 = \$basis->$renderer(\$text1,\$dd1,\@pars)") if ($erg and $#$erg == 0);
$text1 =~ s/ +\n/\n/gs;
if ($renderer =~ /reload/) { $mm1 = "RELOAD"; }
if ($@) { print $@; sleep 5; }
$erg = $self->{'FIBU'}->parserule($text,"\\S+"); # Parsen der Rules
if (ref($erg)) {
#open(FFILE,">rules.txt");
foreach $o (@$erg) {
$pattern = $o->[0];
$chkto = $o->[2];
$chkto =~ s/\-VAR(\d+)/-WWWVAR$1/g;
$pattern =~ s/^,(.*),$/$1/;
$ust = "";
if ($pattern =~ s/^([q\+][qw\+\-])// ) {
$ust = $1;
}
$pattern = [split(/[\(\)]+/,$pattern)];
$pattern = "(" . join(")(",@$pattern) . ")";
$pattern =~ s/\(\)//g;
# if ($pattern !~ /[\(\)]/) { obsoleter Code, ersetzt durch die drei Zeilen dadrueber
# $pattern = "(" . $pattern . ")";
# }
# $pattern =~ s/^(.*?)\(/\($1\)\(/;
# $pattern =~ s/^(.*)\)(.*)$/$1\)\($2\)/;
# print FFILE $pattern . "\n";
#print "124: $pattern\n"; sleep 1;
while ($text1 =~ s/( \S*\-9999 )(.*?)$pattern/ $chkto $2$ust$3$4$5$6$7$8$9/) {
$p4 = $4;
$p5 = $5;
$p6 = $6;
$p7 = $7;
$p8 = $8;
$p9 = $9;
$text1 =~ s/WWWVAR1/$p4/g;
$text1 =~ s/WWWVAR2/$p5/g;
$text1 =~ s/WWWVAR3/$p6/g;
$text1 =~ s/WWWVAR4/$p7/g;
$text1 =~ s/WWWVAR5/$p8/g;
$text1 =~ s/WWWVAR6/$p9/g;
# print "$pattern $p4 $p5\n"; sleep 1;
}
}
# close(FFILE);
}
# TODO: hier werden die qq/qw - Angaben an den Anfang der Zeile gestellt
# $text1 =~ s/(\d\d\d\d\d\d\d\d[; ]+-?\d+\.\d\d[; ]+[^ ;]+[; ]+[^ ;]+[; ]+-?\d+\.\d\d[ ;]+)([^ ;].*?)([q\+][qw\+\-])(.*)/$1$3$2$4/g;
# $text1 =~ s/(\d\d\d\d\d\d\d\d[; ]+-?\d+\.\d\d[; ]+[^ ;]+[; ]+[^ ;]+[; ]+-?\d+\.\d\d[ ;]+)([\+q][qw\+\-]),/$1,$2/g;
$text1 =~ /(.*?) /;
my $kto = $1;
my $b1 = {};
my $b2 = {};
$text = $self->_konto_key($text, $b1, $kto);
$text1 = $self->_konto_key($text1,$b2,$kto);
my $buchungen1 = [];
my $buchungen2 = [];
foreach $o (sort (keys %$b1, keys %$b2)) {
if ($mm1 eq "RELOAD") {
if (substr($o,0,8) < $dd1) {
delete($b2->{$o});
} else {
delete($b1->{$o});
}
}
if ((!(exists($b2->{$o})) or substr($o,0,8) < $dd1) and exists($b1->{$o})) {
push(@$buchungen1,$b1->{$o}) if (substr($o,9,1) eq "1");
push(@$buchungen2,$b1->{$o}) if (substr($o,9,1) eq "2");
}
elsif ((!(exists($b1->{$o})) or substr($o,0,8) >= $dd1) and exists($b2->{$o})) {
push(@$buchungen1,$b2->{$o}) if (substr($o,9,1) eq "1");
push(@$buchungen2,$b2->{$o}) if (substr($o,9,1) eq "2");
}
delete($b1->{$o});
delete($b2->{$o});
}
$main::XX = 1;
$buchungen1 = join("\n",sort { $self->{'FIBU'}->sortbuchung($a) cmp $self->{'FIBU'}->sortbuchung($b) } @$buchungen1);
$main::XX = 0;
$buchungen2 = join("\n",sort { $self->{'FIBU'}->sortbuchung($a) cmp $self->{'FIBU'}->sortbuchung($b) } @$buchungen2);
$text =~ s/---INSERT1---\n/$buchungen1\n/s;
$text =~ s/---INSERT2---\n/$buchungen2\n/s;
while ($text =~ s/---INSERT\d---\n//gs) { 1; }
#print Dumper($buchungen1); exit;
return($text);
}
#***********************************************************************************
sub xx_konto_key {
my $self = shift;
my $text = shift;
my $b = shift;
my $kto = shift;
my $o; my $bdatum; my $betrag; my $kto1; my $kto2; my $rem; my $o1;
my $text1 = "";
foreach $o (split(/\n/,$text)) {
$rem = "";
if ($o =~ /^(\d\d\d\d\d\d\d\d)[ ;]+(\-?\d+\.\d\d)[ ;]+(.*?)[ ;]+(.*?)[ ;]+(\-?\d+\.\d\d)[ ;]+(.*?)\s*$/) {
$bdatum = $1;
$betrag = $2;
$kto1 = $3;
$kto2 = $4;
$rem = $6;
$rem =~ s/^\s*(.*?)\s*$/$1/;
$rem =~ s/^(qq|qw|\+\+|\+\-) *//;
$o1 = "1";
if ($kto1 =~ s/^\-/$kto\-/ and ($kto1 =~ /\-XRXUXLXEX/ or $kto2 =~ /^\-/)) {
$o1 = "2";
}
$b->{"$bdatum $o1 $kto1 $betrag $rem"} = $o; # Schluessel zum Identifizieren der Buchungen
$text1 = $text1 . "---INSERT$o1---\n";
} else {
$text1 = $text1 . $o . "\n";
}
}
#print $text1; exit;
return($text1);
}
#********************************************************************************************
1;