| Current Path : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/DivBasicF/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/50_dev2017/1300__perllib/DivBasicF/IfTFiBu1.pm |
#hasprint Dumper (Application::IfTFiBu->new()->shell(@ARGV));
# Installation:
#
#
# Windows:
#
# 1. Install ActivePerl 5.16 (froim www.ift-intern.de/ift-intern-tools/06_perl
# with standard options
# 2. Create Directory C:\Perl(64)\appserv\DivBasicF
# 3. Copy the files IfT....pm into that directory.
# 4. Copy the files _cx, _ce, cx.bat, ce.bat into C:\Perl(64)\bin
# 5. Set the system environment variable PERL5LIB to C:\Perl(64)\appserv
# (Control Panel -> System -> Advanced settings -> Environment variables)
#
#
# Linux:
#
# 1. Get the IfT....pm files into the PERL5LIB-Path.
# 2. Copy the files _ce and _cx into /usr/local/bin
# 3. Make aliases into the ~/.bashrc:
# alias cx='source _cx'
# alias ce='source _ce'
#
#
# Start new accounting with a file <name>.kto with:
# <name> 0.00
# 20150102 0.00 -10 -13 0.00 init
package DivBasicF::IfTFiBu1;
use strict;
use Data::Dumper;
use Cwd;
use Digest::SHA1;
use File::Copy;
use Algorithm::Diff;
# use DivBasicF::IfTRules;
sub DELIVER { 2 }
#*****************************************************************
sub new {
my $class = shift;
my $self = {};
$main::XCONSOLE = 1;
$main::DATUM = "xger";
bless($self,$class);
$Data::Dumper::Sortkeys = 1;
return($self);
}
#*******************************************************************
sub comp_diff {
my $text = shift;
if ($text !~ s/^( *[^ ;]+ +\-?\d+\.\d\d +[^ ;]+ +[^ ;]+ +)( \-?\d+\.\d\d )/$1/) {
$text =~ s/^( *\S+ +[a-zA-Z0-9\-\_]* +)(\-?\d+\.\d\d *)/$1/; # Saldeneintrag
}
elsif ($text =~ /\{/) {
$text =~ s/^( *[^ ;]+ +)(\-?\d+\.\d\d )/$1/;
}
$text =~ s/ +/ /gs;
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: " . ($self->{'MARK'}||"START") . "\n";
$self->{'MARK'} = $mark;
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 shell79 { # Hilfsfunktion zum Wechseln in das entsprechende Unterkto-Verzeichnis
my $self = shift;
my $dir = shift;
$dir =~ s/[\\\/]+$//;
$dir =~ s/^(.*)\_\_(.*)/$1/;
my $win_cmd = "";
if ($dir =~ s/^\-//) {
$win_cmd = "cd ";
}
my $erg; my $o;
opendir(DDIR,".");
while (0 == 0) {
$o = readdir(DDIR);
if (!$o) {
$erg = ".";
}
elsif ($o eq $dir) {
$erg = $dir;
}
elsif ($o =~ /^$dir\_\_/) {
$erg = $o;
}
last if ($erg);
}
closedir(DDIR);
# system("set erg=".$erg);
# system("cd ".$erg);
$ENV{'ERG'} = $win_cmd . $erg;
return($ENV{'ERG'});
}
#*******************************************************************
sub clearkto {
my $self = shift;
my $dir = shift || ".";
my $kto = shift; # auch Konto-File loeschen, sonst nur die Unterkonten
$dir =~ s/[\\\/]$//;
my $o; my $o1; my @ee = ();
if (!(-d($dir))) {
# print "123\n";
$o = "./" . $dir;
$o =~ s/^(.*)\/(.*)$/$1/;
$dir = $2;
opendir(DDIR,$o);
while (0 == 0) {
$o1 = readdir(DDIR);
last if (!$o1);
next if ($o1 =~ /^\./);
next if ($o1 ne $dir and $o1 !~ /^$dir\_\_/);
$dir = $o1;
last;
}
closedir(DDIR);
$dir = $o . "/" . $dir;
$dir =~ s/^\.[\\\/]//;
$dir =~ s/[\\\/]$//;
}
if ($kto == 2) {
return(0) if ($dir !~ /\-/ or (-f "$dir/rule.pl"));
$kto = 1;
}
opendir(DDIR,$dir);
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
push(@ee,$o);
}
closedir(DDIR);
foreach $o (@ee) {
# print $o . "\n";
if (-f "$dir/$o" and $kto and $o =~ /\.kto$/) {
# if (!(-f("$dir/rule.pl"))) {
unlink("$dir/$o");
print "$dir/$o deleted ...\n";
# }
}
elsif (-d "$dir/$o") {
$self->clearkto("$dir/$o",1);
rmdir("$dir/$o");
}
elsif (-f "$dir/$o" and $o =~ /\~$/) {
unlink("$dir/$o");
}
}
rmdir($dir);
}
#*******************************************************************
sub shell77 {
my $self = shift;
my $ukto = shift;
my @pars = @_;
$ukto =~ s/^ *(.*?) *$/$1/;
if ($ukto =~ / /) {
@pars = (split(/ +/,$ukto),@pars);
$ukto = shift(@pars);
}
while (@pars) { last if ($pars[$#pars]); pop(@pars); } # leere Eintraege am Ende abschneiden
$ukto =~ s/[\\\/]+$//;
my $dir = "./";
if ($ukto =~ s/^(.*[\\\/])(.*)$/$2/) {
$dir = $1;
}
my $o; my $o1; my $o2; my $utext_new; my $ukeyparent; my $ukeykto_new; my $ukeykto;
my $utext; my $ukeyparent_new;
my $bezeichnung = "";
if ($ukto =~ /^(.*?)\_\_(.*)$/) {
$bezeichnung = $2;
$ukto = $1;
}
# ab hier: $dir: Directory des Kontos, $ukto: Kto-Nr des Unterkontos, $bezeichnung: gewuenschte Bezeichnung
my $uktolist_dir = {}; # Liste aller Unterkonten-Directories des Kontos
my $uktolist_kto = {}; # Liste von Unterkonten aus dem Konto-Text
my $ktofile = ""; # Aktuelles Kontofile
$self->mm("Analyse the kto directory.");
opendir(DDIR,$dir);
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
if ($o =~ /\~$/) {
unlink("$dir/$o");
}
elsif (-d "$dir/$o") {
if ($o =~ /^(.*?)\_\_(.*)$/) {
$uktolist_dir->{$1} = $o;
} else {
$uktolist_dir->{$o} = $o;
}
}
elsif (-f "$dir/$o") {
if ($o =~ /^(.*)\.kto$/) {
return("ERROR 101. More than one kto-file found in $dir.") if ($ktofile);
$ktofile = $o;
}
}
}
closedir(DDIR);
if (!($uktolist_dir->{$ukto})) {
$uktolist_dir->{$ukto} = $ukto;
$uktolist_dir->{$ukto} = $ukto . "__" . $bezeichnung if ($bezeichnung);
mkdir($dir.$uktolist_dir->{$ukto});
system("touch $dir".$uktolist_dir->{$ukto}."/.gitignore")
}
return("ERROR 102. No ktofile found in $dir .") if (!$ktofile);
open(FFILE,"<$dir$ktofile");
my $header = <FFILE>;
my $text = [<FFILE>];
close(FFILE);
if ($header =~ /INIT/) {
$text = ["\n","20140102 0.00 -10 -13 0.00 initial\n"];
}
my $text1 = join("",@$text);
return("ERROR 131. Conflict in kto $ktofile, please resolve before.") if ($text1 =~ /\nCONFLICT/s);
my $ukto0 = $ukto;
$ukto0 =~ s/SUM//;
$ukto0 =~ s/(^|\-)(.)$//;
$text1 = [grep(/$ukto0/,@$text)];
my $ukeyparent_new = join("",@$text1);
$text1 =~ s/\n([^\n]+)( \-?\d+\.\d\d )/\n$1 x /gs; # Identity-Chck
$text1 =~ s/\n([^\n]+)( \-?\d+\.\d\d )([^\n]+\{)/\n$1 x $3/gs; # entschaerfen
# $ukeyparent_new = join("\n",sort values %$uktolist_dir) . "--\n" . $ukeyparent_new;
$ukeyparent_new = substr(Digest::SHA1::sha1_hex($ukeyparent_new),0,6);
# print $ukeyparent_new . "-----\n";
# Analyse des Ukto-Verzeichnisses
if (!(exists($uktolist_dir->{$ukto}))) {
$uktolist_dir->{$ukto} = $ukto;
mkdir("$dir$ukto");
}
my $udir = $dir.$uktolist_dir->{$ukto};
my $ufile = "";
my $rulefile = "";
my $ukeyrule = "";
opendir(DDIR,$udir);
my $ee = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
if ($o =~ /\~$/) {
unlink("$udir/$o");
}
push(@$ee,$o);
}
foreach $o (sort @$ee) {
if (-f "$udir/$o") {
if ($o =~ /^(.*)\.kto$/) {
return("ERROR 103. More than one kto-file found in $udir.") if ($ufile);
$ufile = $o;
next;
}
elsif ($o =~ /^(rule.*)\.(pl|py)$/) {
return("ERROR 104. More than one rule-file found.") if ($rulefile);
$rulefile = $o;
}
if ($o !~ /~$/ and $o !~ /^stundenzettel_/) {
if ($o =~ /EXCLUDE/ and $ukeyrule !~ /^EXCLUDE__/) {
$ukeyrule = "EXCLUDE__" . $ukeyrule;
} else {
open(FFILE,"<$udir/$o");
$ukeyrule = $ukeyrule . $o . "\n" . join("",<FFILE>);
close(FFILE);
}
}
}
}
#print "WW: $#pars\n"; sleep 5;
$ukeyrule = sprintf("%10u",int(rand(9999999990))) if ($#pars > -1);
$ukeyrule = "" if (!$rulefile);
#print $ukeyrule . "\n"; sleep 5;
if (!$ufile) {
$ufile = $ktofile;
$ufile =~ s/\.kto$/\_$ukto.kto/;
}
$uktolist_kto->{$ukto} = $uktolist_kto->{$ukto} || $ukto; # Ukto-Verzeichnis
my $adjust_ukto = 0;
while ($ukto ne "kxkxkx") {
# sleep 1;
$ukeyparent_new = join("",@$text1);
# $ukeyparent_new = join("\n",sort values %$uktolist_dir) . "\n" . $ukeyparent_new;
$ukeyparent_new = substr(Digest::SHA1::sha1_hex($ukeyparent_new),0,6);
open(FFILE,"<$udir/$ufile");
$ukeykto = <FFILE>;
$utext = [<FFILE>];
close(FFILE);
$ukeykto_new = join("",@$utext);
#------------- Preparse the kto-text
if (0 == 0) {
my $zeile; my $zeile1; my $o11; my $o14;
$o1 = $ukeykto . $ukeykto_new;
# print "O1" . $o1; exit;
my $steps = {};
if ($o1 =~ /STEP\d+ +\{/) {
while ($o1 =~ s/^(.*)\n(\d\d\d\d)(\d\d)(\d\d)([^\n]+?)STEP(\d+)([^\n]+)\n/$1\n/s) { # io
$o11 = $3;
$o14 = $6;
$zeile = "$2MM$4$5"."STEPNN"."$7";
$zeile =~ s/\-$o11(\-[IO]| |\}|\)|\*)/\-MM$1/g;
$o11 = sprintf("%02u",$o11-1);
$zeile =~ s/\-$o11(\-| |\}|\)|\*)/\-MN$1/g;
$zeile =~ s/ \-?\d+\.\d\d / 0.00 /g;
$zeile =~ s/ +/ /g;
$steps->{$zeile} = $o11 . "-" . $o14;
}
}
#print Dumper($steps);
foreach $zeile (keys %$steps) {
$o2 = 1;
next if ($steps->{$zeile} !~ /^(\d+)\-(\d+)/);
$o11 = $1; # Startmonat
$o14 = $2;
$zeile =~ s/STEPNN/STEP$o14/;
$o14 = $o11 + $o14; # Endmonat
$zeile =~ s/STEPNN/STEP$o14/;
while (0 == 0) {
# print "WW: $o11 $o14 $zeile\n";
last if ($o11 == $o14);
$zeile1 = $zeile;
$zeile1 =~ s/([0123456789\-])MN([0123456789\-\} \)\*])/$1$o11$2/g;
$o11 = sprintf("%02u",$o11+1);
$zeile1 =~ s/([0123456789\-])MM([0123456789\-\} \)\*])/$1$o11$2/g;
# print "ZZ: $zeile1\n";
$o1 = $o1 . $zeile1 . "\n";
}
}
# print $o1;
while ($o1 =~ s/\n(\d\d\d\d)MM(\d\d +\S+ +\S+ +\S+ +-?\d+\.\d\d +.*?)\n/---BUCHUNG---/s) { # Monats-
$o2 = join("\n", map { $1 . $_ . $2 } qw(01 02 03 04 05 06 07 08 09 10 11 12) ); # substitution
$o1 =~ s/---BUCHUNG---/\n$o2\n/s;
}
if ($o1 =~ s/^\-\-//) {
$o2 = 1;
if ($o1 !~ /Plan +(Soll|Ist)/) {
if ($o1 =~ /^(.*?) (\-?\d+[\.\,]\d\d)\D/s) {
$o2 = $2;
if ($o1 =~ s/^([a-zA-Z0-9\_\-]+)(.*?)\n\r?(\d\d\d\d)(\d\d\d\d )/$1$2\n---PLAN---$3$4/s) {
$o2 = $3 . "0102 $o2 -soll 11-4999 0.00 Plan Soll\n" .
$3 . "0103 0.00 -ist 10-4998 0.00 Plan Ist {-:$1+soll+ist}\n";
$o1 =~ s/---PLAN---/$o2/s;
}
}
}
}
my $o10 = "";
my $sollbetrag = {};
foreach $zeile (split(/\n/,$o1)) { # Aenderung der Sollangaben
if ($zeile =~ /^(\d\d\d\d)(\d\d\d\d) +(\-?\d+\.\d\d)( +\-)(\S+)\-soll /) {
$sollbetrag->{$5} = $3;
my $o81 = $5;
if ($o1 !~ /\n\r?(\d\d\d\d)(\d\d\d\d) +(\-?\d+\.\d\d)( +\-)$o81\-ist/) {
$o10 = $o10 . $1 . $2 . " " . $3 . $4 . "$o81-ist 10-4998 0.00 Plan Ist {-$o81+$o81-soll+$o81-ist}\n";
$o2 = 1;
}
}
elsif ($zeile =~ /^(.*?)( |\-soll)( +\S* +)(\-?\d+\.\d\d)/) {
if (exists ($sollbetrag->{$1}) and ($4 != $sollbetrag->{$1})) {
$o11 = $1;
$o14 = $4;
$o1 =~ s/(\n\r?\d\d\d\d\d\d\d\d +)(\-?\d+\.\d\d)( +\-)($o11)(\-soll +)/$1$o14$3$4$5/s;
$o1 =~ s/\n$o11( |\-soll)/\n X X X X X/gs;
$o2 = 1;
delete($sollbetrag->{$o11});
}
}
}
$o1 = $o1 . $o10;
# while ($ukeykto_new =~ /(\-?\d+\.\d\d)( +\-)(\S+)\-soll( +)(.*?)\n\3( +\S* +)(\-?\d+\.\d\d)\n\3\-soll( +\S* +)(\-?\d+\.\d\d)/) { 1; }
# $o1 =~ s/sxxx/soll/g;
if ($o2) {
#print $ukeykto_new;
open(FFILE,">$udir/$ufile");
print FFILE $o1;
close(FFILE);
$o2 = "";
next;
}
}
#-------------------------------------
while ($ukeykto_new =~ s/(CX*OX*NX*FX*LX*IX*CX*T)//) {
$ukeykto = $1;
if ($ukeykto =~ /X/) {
$ukeykto = "";
$ukeykto_new = "";
$utext = [];
last;
}
}
$o1 = $udir;
$o1 =~ s/^(.*)[\\\/](.*)/$2/;
return("ERROR 133. Conflict in kto $o1, please resolve before.") if ($ukeykto =~ /CONFLICT/);
$ukeykto = "" if ($ukeykto !~ s/^(.*?)\((.*?)\)(.*)$/$2/s);
$ukeyparent = substr($ukeykto,6,6) || $ukeyparent_new;
$ukeykto = substr($ukeykto,0,6);
$ukeykto_new = substr(Digest::SHA1::sha1_hex($ukeykto_new.$ukeyrule),0,6);
# print
<<"TEXT_ENDE";
header: $header
ufile: $ufile
rulefile: $rulefile
ukeykto: $ukeykto
ukeykto_new: $ukeykto_new
ukeyparent: $ukeyparent
ukeyparent_new: $ukeyparent_new
TEXT_ENDE
if ($ukto =~ /(^|-)[123456789ABCIJKLMNOP]$/i) { # Unterkonto ist ein Zeitraum-Konto,
$ukeykto_new = $ukeykto; # darf nicht importiert werden, kann aber
} # jederzeit ueberschrieben werden
last if (@$utext and $ukeykto eq $ukeykto_new and $ukeyparent_new eq $ukeyparent and $rulefile !~ /^RULEFILE\:/);
$adjust_ukto = 1 if ($ukto !~ /\-(SUM|)[123456789ABCIJKLMNOP]$/); # Unterkonten des Unterkontos berechnen
# falls kein Zeitraumkonto vorliegt
if (@$utext and $ukeykto ne $ukeykto_new) { $rulefile =~ s/^([^R])/RULEFILE\:$1/; }
if ($rulefile =~ s/^RULEFILE\://) { # Rulefile anwenden
# if (@$utext and $ukeyparent eq $ukeyparent_new and $rulefile =~ s/^RULEFILE\://) { # Rulefile anwenden
print "RULEFILE\n";
$o1 = Cwd::cwd();
chdir($udir);
$self->mm("Apply rule $rulefile ...");
system("perl $rulefile " . join(" ",@pars));
chdir($o1);
$rulefile = "";
# $reimport = "X"; # nach der Anwendung der Rule in jedem Fall auch re-importieren ins Parent-Konto
next; # nochmal die Dateien neu bewerten
}
if ($ukto eq "rearrange" or @$utext and $ukeyparent_new eq $ukeyparent) { # Unterkonto kann reimportiert werden
print "RE-IMPORT\n";
$text = $self->split2($text,$ukto,$utext);
$text =~ s/\n/\n----CR----/gs;
$text = [split(/----CR----/s,$text)];
$text1 = [grep(/$ukto0/,@$text)];
print("Re-write $ktofile\n");
open(FFILE,">$dir/$ktofile");
print FFILE $header . join("",@$text);
close(FFILE);
unlink("$udir/$ufile");
last if ($ukto eq "rearrange");
# $reimport = 1;
next;
}
print "EXPORT\n";
$utext_new = $self->split2([@$text1],$ukto); # Unterkonto neu berechnen, Annahme: Unterkontotext kann komplett ersetzt w.
$utext_new =~ s/\n/\n----CR----/gs;
$utext_new = [split(/----CR----/s,$utext_new)];
if (@$utext and $ukeykto ne $ukeykto_new and join("",@$utext) ne join("",@$utext_new)) { # Konfliktfall
print "CONFLICT\n";
$ee = Algorithm::Diff::sdiff($utext,$utext_new,\&comp_diff);
$utext_new = [];
$o1 = "u";
foreach $o (@$ee) {
if ($o->[0] eq "u") {
push(@$utext_new,"\n") if ($o1 ne "u");
push(@$utext_new," ".$o->[1]) if ($o->[1]);
} else {
push(@$utext_new,"","\nCONFLICT:\n") if ($o1 eq "u");
push(@$utext_new,"-".$o->[1]) if ($o->[1]);
push(@$utext_new,"+".$o->[2]) if ($o->[2]);
}
$o1 = $o->[0];
}
}
# print Dumper($utext_new,$udir);
if ($#$utext_new < 1 and (!(-f("$udir/rule.pl"))) and $udir !~ /xxx$/) { # wenn das Unterkonto ganz geloescht werden kann
unlink("$udir/$ufile");
rmdir($udir);
$self->mm("END");
return("OK 150. Ukto $ukto deleted.");
}
$utext_new = join("",@$utext_new);
$ukeykto_new = substr(Digest::SHA1::sha1_hex($utext_new.$ukeyrule),0,6);
$o1 = $ukto;
if (length($o1) < 60) { $o1 = substr($o1." "x60,0,60); }
$o1 = "$o1 (" . $ukeykto_new . $ukeyparent_new . ")";
print("Write to: $udir/$ufile\n");
open(FFILE,">$udir/$ufile");
print FFILE $o1 . "\n" . $utext_new;
close(FFILE);
$rulefile =~ s/^([^R])/RULEFILE\:$1/ if (!@$utext or $ukeyparent ne $ukeyparent_new);
}
# Neuberechnung der Unterkonto-Verzeichnisse
$o1 = join("",@$text);
while ($o1 =~ s/\n([a-zA-Z\_0-9]+) +([a-zA-Z0-9\-\_]*) +(\-?\d+\.\d\d) *\n/\n/) {
$uktolist_kto->{$1} = $1."__".$2;
$uktolist_kto->{$1} =~ s/\_\_$//;
}
foreach $o (keys %$uktolist_dir) {
next if ($o !~ /\-/); # die direkten Unterkonten sind schon alle beruecksichtigt
next if ($o1 !~ s/\n($o) +([a-zA-Z0-9\-\_]*) +(\-?\d+\.\d\d) *\n/\n/);
$uktolist_kto->{$1} = $1."__".$2;
$uktolist_kto->{$1} =~ s/\_\_$//;
}
foreach $o (keys %$uktolist_kto) { # Anlegen fehlender Konten-Unterverzeichnisse
# print "WWW: $o\n";
if (exists($uktolist_dir->{$o})) {
next if ($uktolist_dir->{$o} eq $uktolist_kto->{$o}); # Bezeichnungen stimmen ueberein
move($dir.$uktolist_dir->{$o},$dir.$uktolist_kto->{$o});
} else {
mkdir($dir.$uktolist_kto->{$o});
}
$uktolist_dir->{$o} = $uktolist_kto->{$o};
if ($uktolist_dir->{$o} =~ /__/) {
system("touch $dir".$uktolist_dir->{$o}."/.gitignore");
}
if (-d $dir."kxkxkx") {
system("rm $dir"."kxkxkx/.gitignore &> /dev/null; rmdir $dir"."kxkxkx");
}
}
if ($ukto eq "kxkxkx") {
# unlink("$udir/$ufile");
unlink($dir.$udir."/.gitignore");
rmdir($dir.$udir);
}
elsif ($adjust_ukto and chdir($udir)) {
print "Adjust ukto $ukto\n";
$self->shell77("kxkxkx");
chdir("..");
}
# print "UTEXT: $utext_new\n";
$self->mm("END");
return("OK 120. Ukto $ukto synchronized.");
}
#*******************************************************************
sub split2 {
my $self = shift;
my $text = shift;
my $ukto0 = shift; # Unterkonto
my $itext0 = shift; # Re-Import-Text
my $addfile = shift || {};
my $nr = 999; # Maximale Anzahl der Wiederholungen
my $zeile; my $kto; my $k; my $o; my $o1; my $o2; my $jahr; my $monat; my $tag;
my $remark; my $formel; my $bez; my $betrag; my $betrag1; my $intern1; my $int;
my $turnkto; my $text1; my $itext; my $ukto; my $o3;
# my $text1 = [];
my $salden = { "" => 0.00 };
my $ktobez = {};
my $sortkto = {};
my $intern0 = 0;
$intern0 = 1 if ($itext0);
my $monat = 0;
my $zaehler = ($ukto0 =~ s/^(.*\-|)SUM([0123456789ABCIJKLMNOP])$/$1$2/);
if ($ukto0 =~ s/^(.*\-|)([0123456789ABCIJKLMNOP])$/$1/) { # Berechnung des Monatsfilters $int
$kto = $2;
$intern0 = 2 if ($ukto0 !~ s/\-$//);
$int = "";
while (0 == 0) {
$o = 0;
$monat = sprintf("%02u",$monat+1);
$o = 1 if ($kto =~ /\d/ and $monat eq "0$kto");
$o = 1 if ($kto eq "A" and $monat eq "10");
$o = 1 if ($kto eq "B" and $monat eq "11");
$o = 1 if ($kto eq "C" and $monat eq "12");
$o = 1 if ($kto =~ /[IMP]/ and $monat =~ /0[123]/);
$o = 1 if ($kto =~ /[JMP]/ and $monat =~ /0[456]/);
$o = 1 if ($kto =~ /[KNP]/ and $monat =~ /0[789]/);
$o = 1 if ($kto =~ /[LNP]/ and $monat =~ /1[012]/);
last if (!$zaehler and !$o and $int);
next if (!$o and !$zaehler);
$int = $int . " " . $monat;
$zaehler = 0 if ($o);
}
}
# Alle Kontenbuchungen werden durchgegangen, danach die Re-Import-Buchungen
$self->mm("A. Auswertung der Kontodatei");
my $ukto1 = join("|",keys %$addfile,$ukto0);
$itext = $itext0;
$ukto = $ukto0;
my $alle_vorkommenden_konten = { "" => 1 };
# $self->{'SHAKEY'} = "";
# $self->{'SHAKEY'} = [] if (!$intern0);
# my $shakey = $self->{'SHAKEY'};
##-----------
# foreach $ukto (keys %$addfile,$ukto0) {
# $itext = $addfile->{$ukto} || $itext0;
##-----------
push(@$text,"___",@$itext) if ($itext);
foreach $zeile (@$text) {
if (ref($zeile)) {
next if ($zeile->[5] =~ /^$ukto(\_|$)/);
next if ($zeile->[6] =~ /^$ukto(\_|$)/);
push(@$text1,$zeile);
next;
}
$zeile =~ s/\n//sg;
$zeile =~ s/^ //;
$zeile = $zeile . " 0.00" if ($zeile =~ /^(\S*) +[^ \-0123456789](\S+) *$/);
if ($zeile =~ /^(\S*) +([a-zA-Z0-9\-\_]+) +(\-?\d+\.\d\d) *$/) { # Saldeneintrag
$k = $1;
$o = $2;
$betrag = $3;
if ($intern0 == 0) { # zu exportierende Kontobezeichnungen
if ($k =~ s/^$ukto\-?//) {
$salden->{$k} = 0;
$ktobez->{$k} = $o;
}
}
elsif ($intern0 < 3) { # Original-Kontobezeichnungen
$salden->{$k} = 0;
$ktobez->{$k} = $o;
}
else { # zu importierende Kontobezeichnungen
$k = "-" . $k if ($k);
$k = $ukto . $k;
$salden->{$k} = 0;
$ktobez->{$k} = $o || $ktobez->{$k};
}
next;
}
$zeile =~ s/^(\d\d)\.(\d\d)\.(9\d) /19$3$2$1 /;
$zeile =~ s/^(\d\d)\.(\d\d)\.(\d\d) /20$3$2$1 /;
if ($zeile =~ /^(\d\d\d\d)(\d\d)(\d\d) +(\S+) +(\S+) +(\S+) +-?\d+\.\d\d +(.*)$/) { # Buchung
$jahr = $1;
$monat = $2;
$tag = $3;
$betrag = sprintf("%3.2f",eval($4));
$kto = [$5,$6];
$remark = $7;
$remark =~ s/^(.*?) *$/$1/;
$betrag1 = $betrag;
$betrag1 =~ /[ \-\.]/gs;
$intern1 = 0;
next if ($int and ($int !~ /$monat/ or $monat.$tag eq "0101")); # Anwenden des Monatsfilters
$kto->[0] = ":" . $kto->[0] if ($kto->[0] !~ s/^\-//); # Normieren der Kontobezeichnungen auf das
$kto->[1] = ":" . $kto->[1] if ($kto->[1] !~ s/^\-//); # gleiche Format wie bei den Formeln
$formel = "-"; # zeigt an, dass es sich um eine 'formellose' Buchung handel, die im
# Formel-Iterator genau einmal durchlaufen wird
$intern1 = 0;
$turnkto = 0;
foreach $k (@$kto) {
if ($intern0 == 0) { $k = ":" . $k if ($k !~ s/^$ukto(\-?)//) } # zu exportierende Buchungen
elsif ($intern0 < 2) { $intern1 = -1 if ($k =~ /^($ukto1)/); } # Original-Buchungen
elsif ($intern0 == 3 and $k) { $k = $ukto . "-" . $k if ($k !~ s/^\://); } # zu importierende Buchungen
elsif ($intern0 == 3) { $k = $ukto; } # zu importierende Buchungen
}
if ($intern1 < 0 or $intern0 == 3) { # Kontoreihenfolge erhalten, soweit moeglich
if ($intern1 < 0) { # jeweils fuer ein Datum
$sortkto->{"$jahr$monat$tag"}->{$kto->[0]}->{$kto->[1]} = 1;
$sortkto->{"betrag1"}->{$kto->[0]}->{$kto->[1]} = 1;
# if (!(exists($sortkto->{"$jahr$monat$tag"}->{$kto->[1]})) and
# $sortkto->{"$jahr$monat$tag"}->{$kto->[1]} ne $kto->[0]) {
# $sortkto->{"$jahr$monat$tag"}->{$kto->[0]} = $kto->[1];
# }
# if (!(exists($sortkto->{$betrag1}->{$kto->[1]})) and
# $sortkto->{$betrag1}->{$kto->[1]} ne $kto->[0]) {
# $sortkto->{$betrag1}->{$kto->[0]} = $kto->[1];
# }
next;
}
if ($sortkto->{"$jahr$monat$tag"}->{$kto->[1]}->{$kto->[0]}) { $turnkto = 1; }
# if ($sortkto->{"$jahr$monat$tag"}->{$kto->[1]} eq $kto->[0]) { $turnkto = 1; print Dumper($betrag1,$jahr,$monat,$tag,$kto) }
# elsif (!(exists($sortkto->{"$jahr$monat$tag"}->{$kto->[0]}))) {
# $turnkto = 1 if ($sortkto->{$betrag1}->{$kto->[1]} eq $kto->[0]);
# print Dumper($betrag1,$kto) if ($sortkto->{$betrag1}->{$kto->[1]} eq $kto->[0]);
# }
# print Dumper($sortkto);
}
$intern1 = 2 if ($kto->[0] !~ /^\:/); # Berechnung, ob Buchung intern sein wird
$intern1 = $intern1 + 2 if ($kto->[1] !~ /^\:/);
# print "YY: $intern1 -- $kto->[0] -- $kto->[1] -- $remark\n";
next if (!$intern1);
if ($intern1 and (!($int)) and $remark =~ s/ \{(.*)\}/---FORMEL---/) { # Formeln nur auswerten, wenn es
$o = $1; # sich nicht um monatsgefiulterte
$formel = " " . $o . " "; # Konten handelt. Das waere verfaelschend
while ($formel =~ s/^ *\( *(.*?) *\) *$/$1/) {
$k = $1;
while ($k =~ s/\([^\(\)]*\)/X/) { 1; }
next if ($k !~ /[\(\)]/);
$formel = "( " . $formel . " )";
last;
}
$formel =~ s/([ ;\(\)\[\]\{\}\+\*])/ $1 /g;
$formel =~ s/ \-/ \- /g;
$formel =~ s/ \+ *\- / \- /g;
# print "XX: ----> $remark $formel\n";
while ($formel =~ s/ (\:*[a-zA-Z0-9][a-zA-Z0-9\-\_]*) / ---KTO--- /) {
$k = $1;
# print "XX: $k\n"; sleep 1;
if ($intern0 == 3) {
$k = $ukto . "-" . $k if ($k !~ s/^\:// and $ukto);
# $k = $ukto if ($k =~ /SELF$/);
} # zu importierende Buchungen
elsif ($intern0 == 0) { $k = ":" . $k if ($k eq $ukto or $k !~ s/^$ukto(\-?)//) } # zu exportierende Buchungen
# $k = "SELF" if (!$k);
push(@$kto,$k);
}
}
if ($turnkto or $kto->[0] =~ /^\:/ and $kto->[1] !~ /^\:/) { # Konten umdrehen
$o = $kto->[0];
$kto->[0] = $kto->[1];
$kto->[1] = $o;
$betrag = (-1) * $betrag;
if ($formel ne "-") {
$formel = "-(" . $formel . ")";
$formel =~ s/^ *\- *\( *\- *\( *(.*?) *\) *\) *$/$1/;
}
}
if ($formel ne "-") { # aus den Saldeneintraegen eine Perl-Formel zusammenbauen
$formel =~ s/ //g;
$remark =~ s/---FORMEL---/ \{$formel\}/;
foreach $k (@$kto[2..$#$kto]) {
$formel = "-" if ($k =~ /^\:/);
$remark =~ s/---KTO---/$k/;
next if (!$formel);
$o = '($salden->{\'' . $k . '\'})';
if ($k =~ s/-SALDO$//) {
$o = '( exists ( $salden->{\''.$k.'\'} ? $salden->{\'' . $k . '\'} : ' . $betrag . ')';
}
$formel =~ s/---KTO---/$o/;
}
}
if ($formel ne "-") {
$formel = eval("sub \{ $formel \}");
$betrag = 0;
}
$zaehler = $remark;
$zaehler =~ s/^(.*?) *\{/$1/;
$zaehler =~ s/[äöüÄÖÜß]/X/g;
$o = "A";
if ($zaehler =~ s/^q([bcdefghijklmnopqrstuvwxy])//) {
$o = uc($1); # Umsatzsteuermarkierung
}
if ($zaehler =~ s/^ *\d(.*?)\((.*)\)/$2/s) { # Umsatzsteuerbehandlung
$zaehler = substr($zaehler,0,92) . ("Z"x92);
} else {
$zaehler = substr($zaehler,0,92) . ("$o"x92);
}
$zaehler = substr($zaehler,0,92+1);
if ($zaehler =~ /^Brutto-Lohn/) { $zaehler = "11" . $zaehler; }
elsif ($zaehler =~ /^Weihnachtsgeld|Urlaubsgeld|ulage/) { $zaehler = "12" . $zaehler; }
elsif ($zaehler =~ /^(LST|Lohnsteuer)/) { $zaehler = "13" . $zaehler; }
elsif ($zaehler =~ /^(KST|Kirchensteuer)/) { $zaehler = "15" . $zaehler; }
elsif ($zaehler =~ /^(A.-Anteil SZ|Soli)/) { $zaehler = "17" . $zaehler; }
elsif ($zaehler =~ /^(Jahreskorrektur |Rueckbuchung )(LST|Lohnsteuer)/) { $zaehler = "14" . $zaehler; }
elsif ($zaehler =~ /^(Jahreskorrektur |Rueckbuchung )(KST|Kirchensteuer)/) { $zaehler = "16" . $zaehler; }
elsif ($zaehler =~ /^(Jahreskorrektur |Rueckbuchung )(A.-Anteil SZ|Soli)/) { $zaehler = "18" . $zaehler; }
elsif ($zaehler =~ /^(ZAHL)/i) { $zaehler = "20" . $zaehler; }
elsif ($zaehler =~ /^(PKVK)/) { $zaehler = "22" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil RV/) { $zaehler = "19" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil AV/) { $zaehler = "20" . $zaehler; }
elsif ($zaehler =~ /^(A.-Anteil KV|Kasse)/) { $zaehler = "21" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil ZU/) { $zaehler = "22" . $zaehler; }
elsif ($zaehler =~ /^A.-Zuschl.* KV/) { $zaehler = "22" . $zaehler; }
elsif ($zaehler =~ /^(PKVK)/) { $zaehler = "22" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil PV/) { $zaehler = "23" . $zaehler; }
elsif ($zaehler =~ /^(PKVP)/) { $zaehler = "23" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil KI/) { $zaehler = "24" . $zaehler; }
elsif ($zaehler =~ /^KI-Zuschl.* PV/) { $zaehler = "24" . $zaehler; }
elsif ($zaehler =~ /^A.-Anteil ST/) { $zaehler = "26" . $zaehler; }
elsif ($zaehler =~ /^(A.-Anteil U|U)mlage 1/) { $zaehler = "27" . $zaehler; }
elsif ($zaehler =~ /^(A.-Anteil U|U)mlage 2/) { $zaehler = "28" . $zaehler; }
elsif ($zaehler =~ /^(A.-Anteil I|I)nso/) { $zaehler = "29" . $zaehler; }
elsif ($zaehler =~ /^ +\d/) { $zaehler = "50" . $zaehler; }
else { $zaehler = "79" . $zaehler; }
$o1 = "0";
$o1 = "1" if $betrag < 0;
$o = [$intern1.$jahr.$monat.$tag.$zaehler.$o1.$kto->[1].$kto->[0].$betrag1,
$jahr,$monat,$tag,$betrag,$kto->[0],$kto->[1],$remark,$formel,$intern0];
$o1 = $remark;
$o1 =~ s/ //g;
$o1 =~ s/ä/ae/gs;
$o1 =~ s/ö/oe/gs;
$o1 =~ s/ü/ue/gs;
$o1 =~ s/Ä/Ae/gs;
$o1 =~ s/Ö/Oe/gs;
$o1 =~ s/Ü/Ue/gs;
$o1 =~ s/ß/ss/gs;
$o1 = "$jahr$monat$tag$betrag1".$kto->[0].$o1; # Ausschalten von Doubletten
$text1->{$o1} = $o if (!(exists($text1->{$o1})) or ($text1->{$o1}->[6] =~ /13-9999$/));
foreach $o1 (0,1) {
$o = $kto->[$o1];
while (0 == 0) {
$alle_vorkommenden_konten->{$o} = 1;
last if ($o !~ s/^(.*)\-(.*)$/$1/s);
}
}
# push(@$text1,$o);
}
elsif ($zeile eq "___") { # Umschalten zu den zu reimportierenden Buchungen
$self->mm("B. Re-Import");
$intern0 = 3;
}
}
##---------
# $text = $text1;
# $intern0 = 1;
# }
##---------
$text1 = [values %$text1] if (ref($text1) eq "HASH");
$zaehler = 1;
while (0 == 0) {
$self->mm("C. Auswertung der Formeln - $zaehler. Iteration");
foreach $zeile (@$text1) {
$formel = $zeile->[8];
next if (!$formel);
if (ref($formel)) {
$betrag = sprintf("%3.2f",&$formel()+0.00001);
$o = $betrag - $zeile->[4];
$zeile->[4] = $betrag;
} else {
$o = $zeile->[4];
$zeile->[8] = "";
}
foreach $k ($zeile->[5],$zeile->[6]) {
$o = (-1) * $o;
next if ($k =~ /^\:/);
$kto = $k;
while (0 == 0) {
$salden->{$kto} = $salden->{$kto} - $o;
last if (!$kto);
$kto = "" if ($kto !~ s/^(.*)\-(.*)$/$1/);
}
}
next if ($o == 0); # Kontobetrag stimmt ueberein
$zaehler = (-1) * $zaehler if ($zaehler > 0);
}
last if ($zaehler > 0);
$zaehler = 1 - $zaehler;
last if ($zaehler > $nr);
}
$self->mm("D. Saldeneintraege hinzufuegen");
foreach $k (keys %$salden) {
$betrag = $salden->{$k};
$o = 3;
$o = 1 if (!$k);
$remark = $k;
$remark =~ s/^(.*?)\-X(.*)$/$1\-$2\-/;
$remark =~ s/(^|\-)(LOHN)/$1a03$2/;
$remark =~ s/(^|\-)(SOND)/$1a04$2/;
$remark =~ s/(^|\-)(PKVZ)/$1a05$2/;
$remark =~ s/(^|\-)(LST)/$1a06$2/;
$remark =~ s/(^|\-)(SZ)/$1a07$2/;
$remark =~ s/(^|\-)(KS|KR|KE|KA|KB)/$1a08$2/;
$remark =~ s/(^|\-)(ZAHL)/$1a10$2/;
$remark =~ s/(^|\-)(RV)/$1a15$2/;
$remark =~ s/(^|\-)(AV)/$1a16$2/;
$remark =~ s/(^|\-)(KV)/$1a17$2/;
$remark =~ s/(^|\-)(PKVZ)/$1a17$2/;
$remark =~ s/(^|\-)(KI)/$1a18$2/;
$remark =~ s/(^|\-)(PV)/$1a19$2/;
$remark =~ s/(^|\-)(PKVP)/$1a19$2/;
$remark =~ s/(^|\-)(ZU)/$1a20$2/;
$remark =~ s/(^|\-)(ST)/$1a21$2/;
$remark =~ s/(^|\-)(U1)/$1a31$2/;
$remark =~ s/(^|\-)(U2)/$1a32$2/;
$remark =~ s/(^|\-)(U3)/$1a33$2/;
$remark =~ s/(^|\-)(ZZ)/$1a34$2/;
$remark =~ s/(^|\-)(soll)/$1a40$2/;
$remark =~ s/(^|\-)(ist)/$1a41$2/;
$remark =~ s/(^|\-)(meldung)/$1zzz50$2/;
$remark =~ s/Plan +(Soll|Ist )/Plan/;
if (exists $alle_vorkommenden_konten->{$k} or $ktobez->{$k}) {
push(@$text1,[$o.$remark,$k,$ktobez->{$k},$salden->{$k},$betrag]);
}
}
$self->mm("E. Sortierung der Buchungen");
$text1 = [ sort { $a->[0].$a->[7] cmp $b->[0].$b->[7] } @$text1 ];
$self->mm("F. Formatierung");
$betrag = 0;
$intern0 = 0;
foreach $zeile (@$text1) {
$intern0 = $intern1;
$intern1 = substr($zeile->[0],0,1);
if ($intern1 == 1 or $intern1 == 3) { # Salden anzeigen
$kto = $zeile->[1];
$bez = $zeile->[2];
$betrag = sprintf("%13.2f",$zeile->[3]);
$betrag =~ s/^ \-0\.00$/ 0.00/;
if (length($kto) < 11) { $kto = substr( $kto ." "x11,0,11); }
if (length($bez) < 11) { $bez = substr( $bez ." "x11,0,11); }
if ($intern1 == 1) { $o1 = "___TAB5___"; $o2 = "___TAB6___"; }
else { $o1 = "___TAB7___"; $o2 = "___TAB8___"; }
$k = $kto;
$k =~ s/[^-]//g;
$k =~ s/-/ /g;
$betrag = $k . $betrag; # Einrueckung nach Unterkonto-Tiefe
$betrag =~ s/ /\\/g;
$zeile = $kto . " " . $o1 . (sprintf("%09b",1023-length($kto))) . "___ " .
$bez . " " . $o2 . (sprintf("%09b",1023-length($bez))) . "___ " . $betrag;
# Leerzeilen vor bestimmten Konten:
if ($kto !~ /\-/ and (substr($zeile,0,3) =~ / +/)) { $zeile = "\n" . $zeile; }
elsif ($kto !~ /\-/ and ($zeile =~ /^[a-z]+ */)) { $zeile = "\n" . $zeile; }
elsif ($kto !~ /\-/ and ($zeile =~ /^[A-Z]+ */)) { $zeile = "\n" . $zeile; }
elsif ($zeile =~ /^(meldung|zahlung)/) { $zeile = "\n" . $zeile; }
# elsif ($zeile =~ /^..\-.. +/) { $zeile = "\n" . $zeile; }
elsif ($zeile =~ /^[A-Z]+\-\S\S +/) { $zeile = "\n" . $zeile; }
elsif ($zeile =~ /^(SOND|LSTU|LOHNH|LOHNG) /) { $zeile = "\n" . $zeile; }
if ($zeile =~ /^57\-(\d+) *$/) { $zeile = "\n" . $zeile; }
# push(@$shakey," $kto $bez") if ($shakey);
} else { # Buchungen
$kto = [$zeile->[5],$zeile->[6]];
$o = 0;
foreach $k (@$kto) {
$k = "-" . $k if ($k !~ s/^\://);
if (length($k) < 11) { $k = substr($k." "x11,0,11); }
$o = $o + 1 if ($k =~ /^\-/);
$o = (-1) * $o;
}
$betrag = $betrag + $o * $zeile->[4] if ($o);
$o = "";
$o = "\\\\\\" if ($zeile->[7] =~ /(7|19) +v.H./);
if ($o == 2) { $o1 = "___TAB1___"; $o2 = "___TAB2___"; }
else { $o1 = "___TAB3___"; $o2 = "___TAB4___"; }
# if ($shakey) {
# push(@$shakey," " . $zeile->[1] . $zeile->[2] . $zeile->[3] .
# " " . $zeile->[5] . " " . $zeile->[6] . " " . $zeile->[7]);
# push(@$shakey," " . sprintf("%3.2f",$zeile->[4])) if ($zeile->[7] !~ /\{/);
# }
$o3 = $zeile->[1] . $zeile->[2] . $zeile->[3] . " "; # if ($main::DATUM ne "ger");
# $o3 = $zeile->[3] . "." . $zeile->[2] . "." . substr($zeile->[1],2,2) . " " if ($main::DATUM eq "ger");
$zeile = $o3 . sprintf("%11.2f",$zeile->[4]) . " " .
$kto->[0] . $o1 . (sprintf("%09b",1023-length($kto->[0]))) . "___ " .
$kto->[1] . $o2 . (sprintf("%09b",1023-length($kto->[1]))) . "___ " .
sprintf("%11.2f",$betrag) . " " . $o . $zeile->[7];
}
if ($intern1 != $intern0) {
$zeile = "\n" . $zeile if ($intern1);
$zeile = "\n" . $zeile if ($intern1 == 2 or $intern1 == 4);
}
}
my $text2 = join("\n",@$text1,"");
while ($text2 =~ s/^ *\n//) { 1; }
my $tab; my $space1; my $space;
$self->mm("G. Auswertung Tabulatoren");
foreach $tab (1,2,3,4,5,6,7,8) { # minimale Tabulatoren-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;
return($text2);
}
#*******************************************************************
sub shell0 {
my $self = shift;
my $cmd = shift || "edit";
my $dir = shift || ".";
my @pars = @_;
$dir =~ s/[\\\/]/\//g;
$dir =~ s/[\\\/]+$//;
my $o; my $text; my $text1;
my $errorlevel; my $errorcode; my $errormessage;
my $editfile; my $erg; my @ee; my $ukto_dirs;
if ($cmd eq "e") { $cmd = "edit"; }
elsif ($cmd eq "k") { $cmd = "rule"; }
elsif ($cmd eq "i") { $cmd = "pruneall"; }
elsif ($cmd eq "p") { $cmd = "prune"; }
elsif ($cmd eq "x") { $cmd = "expand"; }
if ($cmd =~ /^(prune|pruneall)$/) { # alle Unterkonten loeschen
$dir =~ s/[\\\/]+$//;
opendir(DDIR,$dir);
$text = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
if (-f "$dir/$o") {
if ($o =~ /\~$/ or $o eq "CHECK.txt" or ($o =~ /\.kto$/ and $cmd eq "pruneall")) {
unlink("$dir/$o") if ($o !~ /CONFLICT/);
print("File $dir/$o deleted ...\n");
}
}
next if ($o =~ /^\./);
push(@$text,$o) if (-d "$dir/$o");
}
closedir(DDIR);
foreach $o (@$text) {
$self->shell0("pruneall","$dir/$o");
print("Directory $dir/$o deleted ...\n") if rmdir("$dir/$o");
}
rmdir("$dir");
return("OK: Directory $dir cleared.");
}
if ($cmd =~/^(sync|expand)$/) {
if ($dir eq ".") {
$dir = Cwd::cwd();
$dir =~ s/^(.*)[\\\/](.*)$/$2/;
chdir("..");
}
$main::XCONSOLE = 0;
$self->{'NO_FILE'} = 1;
$erg = $self->shell($dir,@pars);
$ukto_dirs = [];
opendir(DDIR,$dir);
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
next if (!(-d("$dir/$o")));
push(@$ukto_dirs,$o);
}
closedir(DDIR);
# print " ------------------> ERG $erg\n";
foreach $o (sort @$ukto_dirs) {
$editfile = $self->shell0($cmd,"$dir/$o");
# unlink($editfile);
# print " ---------------------> delete $editfile\n";
# if ($editfile =~ /^(.*)[\\\/](.*)$/) { rmdir($1); }
}
$erg = $self->shell($dir);
return("") if ($erg !~ /^(OK|WARNING|ERROR) +(\d+)\. *(.*?) *$/);
$errorlevel = $1;
$errorcode = $2;
$errormessage = $3;
return($erg) if ($errorlevel eq "ERROR");
return($erg) if ($erg !~ / (\S+\.kto)( |$)/);
# print "XXX: $editfile\n";
$editfile = $1;
return($editfile);
}
if ($cmd =~ /^(edit|rule)$/) {
$erg = $self->shell($dir,@pars);
if ($erg !~ /^(OK|WARNING|ERROR) +(\d+)\. *(.*?) *$/) {
return("ERROR 115. No Error code given. $erg");
}
$errorlevel = $1;
$errorcode = $2;
$errormessage = $3;
return($erg) if ($errorlevel eq "ERROR");
return($erg) if ($erg !~ / (\S+\.kto)( |\.|$)/);
return($erg) if ($cmd eq "rule");
$editfile = $1;
}
if ($editfile =~ /^(.*)[\\\/](.*)\.kto$/) { # falls shell0 ohne Parameter aufgerufen wurde,
$dir = $1; # geht shell in das Parent-Directory,
} # daher muss hier neu das Verzeichnis ueberprueft werden
if ($cmd =~ /^(edit)$/) {
return("ERROR 116. No file found to edit.") if (!$editfile);
open(FFILE,"<$editfile");
$text = join("",<FFILE>);
close(FFILE);
system("joe $editfile");
open(FFILE,"<$editfile");
$text1 = join("",<FFILE>);
close(FFILE);
}
if ($cmd =~ /^(edit|rule)$/) {
return("OK 119. $editfile not changed.") if ($text eq $text1);
while (0 == 0) {
$self->{'DIR0'} = 1;
$cmd = $self->shell($dir);
return($cmd);
return("OK") if ($dir !~ s/^(.*)[\\\/](.*)$/$1/);
}
}
}
#*******************************************************************
sub shell {
my $self = shift;
my $dir = shift;
my $dir0 = shift;
my @pars = @_;
my $o; my $o1; my $o2; my $text; my $text1; my $text1_r; my $text2_r;
my $shakey; my $shakey_orig; my $shakey_new; my $parent_text;
my $ktofile = [];
$dir =~ s/[\\\/]+$//;
$dir =~ s/[\\\/]/\//g;
if ($dir =~ /^(.*)\.kto$/) { # falls ein Kto-file angegeben wurde...
$ktofile = $1;
$dir = "";
if ($ktofile =~ s/^(.*)\/(.*)$/$1/) {
$dir = $1;
}
}
$dir = $dir || ".";
# 1. -- Berechnen von Konto und Unterkonto
my $ukto = "";
if ($dir =~ /^(.*)[\\\/](.*)$/) {
$dir = $1;
$ukto = $2;
}
elsif ($dir eq "." or $dir =~ /^SxxxUM.$/ or $dir =~ /^xxxxx.$/) {
$ukto = Cwd::cwd();
$ukto =~ s/^(.*)[\\\/](.*)$/$2/;
$ukto = $ukto . "-" . $dir if ($dir ne ".");
$dir = ".";
chdir("..");
}
else {
$ukto = $dir;
$dir = ".";
}
# 2. --- Berechnen des Unterkonto-Files
my $rulefile = "";
my $parent_kto = "";
my $ukto_dir = $ukto;
my $bezeichnung = "";
if ($ukto =~ s/^(.*)\_\_(.*)$/$1/) {
$bezeichnung = $2;
}
opendir(DDIR,$dir);
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
if ($o =~ /\~$/) {
unlink("$dir/$o");
next;
}
next if ($o =~ /^(MERGE|ORIG)/);
if (-d "$dir/$o" and $o =~ /^$ukto[^\-]/) {
if ($bezeichnung and $o ne $ukto_dir) { # Konto nur aendern, wenn es mit Bezeichnung
move("$dir/$o","$dir/$ukto_dir"); # angegeben ist
} else {
$ukto_dir = $o;
}
}
if (ref($ktofile) and $o =~ /^(.*)\.kto$/) { # wenn das Kontofile noch nicht bekannt ist
return("ERROR 101. More than one kto-file found in $dir.") if (@$ktofile);
unshift(@$ktofile,$1."__");
$o1 = $ukto;
$o1 =~ s/^(.*)\_\_(.*)$/$1/;
$ktofile->[0] = $ktofile->[0] . $o1;
$parent_kto = $o;
}
}
if ($ukto_dir =~ /^(.*)\_\_(.*)$/) {
$ukto = $1;
$bezeichnung = $bezeichnung || $2;
}
$dir = $dir . "/";
$dir = "" if ($dir eq "./");
mkdir("$dir$ukto_dir");
# 3. Parsen aller Eintraege im Unterkonto-Verzeichnis
my $uktolist = {}; # als Unterverzeichnisse gefundene Unterkonten
my $file_content = ""; # alle sonstigen Files bis auf das kto-File
my $text1 = ""; # Inhalt des gespeicherten Kto-Files
my $text2 = []; # Inhalt des Directories
opendir(DDIR,"$dir$ukto_dir");
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
if ($o =~ /\~$/) {
unlink("$dir$ukto_dir/$o");
next;
}
push(@$text2,$o);
}
closedir(DDIR);
foreach $o (sort @$text2) {
next if (-d "$dir$ukto_dir/$o");
next if ($o =~ /^(MERGE|ORIG)/);
next if ($o !~ /\./);
if (ref($ktofile) and $o =~ /^(.*)\.kto$/) { # ktofile ist noch nicht bekannt
return("ERROR 102. More than one kto-file found in $dir$ukto_dir.") if ($#$ktofile > 1);
unshift(@$ktofile,$1);
}
if ($o =~ /^rule.*.pl$/) {
return("ERROR 103. More than one rule-file found in $dir$ukto_dir.") if ($rulefile);
$rulefile = $o;
}
if (open(FFILE,"<$dir$ukto_dir/$o")) {
if ($o =~ /\.kto$/) {
$shakey_orig = <FFILE>;
$text1 = join("",<FFILE>);
} else {
$file_content = $file_content . "\n" . join("",<FFILE>);
}
close(FFILE);
}
}
$ktofile = shift(@$ktofile) if (ref($ktofile));
return("ERROR 139. No kto file found.") if (!$ktofile);
my $ktofile_old = $ktofile;
if ($text1 =~ /\n[\+\-]/) {
return("WARNING 106. Kto $dir$ukto_dir/$ktofile.kto has merge conflicts, please resolve before.")
}
print "FILE $dir$ukto_dir/$ktofile.kto\n" if ((-f "$dir$ukto_dir/$ktofile.kto"));
$ktofile =~ s/\_(CONTINUE|CONFLICT)$//s;
if (!($self->{'DIR0'}) and $bezeichnung and $text1 =~ s/^( +)(\S+)( +)(\-?\d+\.\d\d)/$1$bezeichnung$3$4/s) {
if ($2 ne $bezeichnung) {
unlink("$dir$ukto_dir/$ktofile_old.kto") if ($ktofile ne $ktofile_old);
open(FFILE,">$dir$ukto_dir/$ktofile.kto");
print FFILE $shakey_orig . $text1;
close(FFILE);
}
}
delete ($self->{'DIR0'});
# 3. -- Interne Rules des ktofiles anwenden
my $text2 = $text1;
while ($text1 =~ s/\n(\d\d\d\d)MM(\d\d +\S+ +\S+ +\S+ +-?\d+\.\d\d +.*?)\n/---BUCHUNG---/s) { # Monats-
$o2 = join("\n", map { $1 . $_ . $2 } qw(01 02 03 04 05 06 07 08 09 10 11 12) ); # substitution
$text1 =~ s/---BUCHUNG---/\n$o2\n/s;
}
if ($text1 =~ s/^\-\-([a-zA-Z0-9\_\-]+)(.*?)\n(\d\d\d\d)(\d\d\d\d )/$1$2\n---PLAN---$3$4/s) {
$o2 = $3 . "0102 1.00 -soll 11-4999 0.00 Plan Soll\n" .
$3 . "0103 0.00 -ist 10-4998 0.00 Plan Ist {-:$1+soll+ist}\n";
$text1 =~ s/---PLAN---/$o2/s;
}
# while ($text1 =~ s/(\-?\d+\.\d\d)( +\-)(\S+\-)soll( +)(.*?)(\-?\d+\.\d\d) *\n\3soll( +\S* +)(\-?\d+\.\d\d)/$6$2$3sxxx$4$5$6\n$3sxxx$7$6/s) { 1; }
$text1 =~ s/sxxx/soll/g;
if ($text1 ne $text2) { # Aenderung wurde festgestellt
unlink("$dir$ukto_dir/$ktofile_old.kto") if ($ktofile ne $ktofile_old);
open(FFILE,">$dir$ukto_dir/$ktofile\_CONTINUE.kto");
print FFILE $text1;
close(FFILE);
return("WARNING 104. The kto-file $dir$ukto_dir/$ktofile\_CONTINUE.kto has to be continued.");
}
# 4. -- Synchronisation mit dem Parent-Kto
open(FFILE,"<$dir$parent_kto");
my $parent_text = [<FFILE>];
close(FFILE);
$self->mm("H. File $dir$ukto_dir/$ktofile.kto written.\nEXPORT Unterkto $dir$ukto ....");
if (join("\n","\n",@$parent_text) =~ /\n[\+\-]/) {
return("ERROR 105. Kto $dir$parent_kto has merge conflicts, please resolve before.")
}
$o1 = $ukto;
$o1 =~ s/SUM//;
$o1 =~ s/(^|\-)(.)$//;
# if (open(FFILE,"<$dir$ukto_dir/$ktofile_old.ktoxxx")) {
# <FFILE>;
# $text2 = join("",<FFILE>);
# close(FFILE);
# } else {
return("OK 137. No kto file generated.") if ($self->{'NO_FILE'});
$text2 = $self->split2([grep(/$o1/,@$parent_text)],$ukto);
if (!$text1) {
open(FFILE,">$dir$ukto_dir/$ktofile.kto");
print FFILE "$ukto (xxxxxx) \n" . $text2;
close(FFILE);
}
# }
# if ($bezeichnung) {
# $text2 =~ s/^(.*?)\n( +)(\S+)( +)(\-?\d+\.\d\d)/$1\n$2$bezeichnung$4$5/s;
# }
my $shakey = $self->compute_shakey($text2,$file_content);
my $shakey_new = $self->compute_shakey($text1,$file_content);
#print "XXX $shakey_orig $shakey_new $shakey\n";
#print $text2; exit;
# 5. -- Ueberpruefen, ob rule.pl Files angewendet werden muessen
if (1 and ($shakey_orig !~ /\($shakey\)/
or $shakey_orig !~ /\($shakey_new\)/
or !$text1) and $rulefile) { # wenn es Aenderungen gegeben hat,
#print "XXX: hier $ktofile $ktofile_old\n";
$o1 = Cwd::cwd(); # rule.pl anwenden
$o1 =~ s/[\\\/]+$//;
$o1 =~ s/[\\\/]/\//g;
chdir("$dir$ukto_dir");
# sleep 1;
#print "hier1 \n";
print("perl $rulefile " . join(" ",@pars) . "\n");
system("perl $rulefile " . join(" ",@pars)) if ($rulefile =~ /\.pl$/);
system("python3 $rulefile " . join(" ",@pars)) if ($rulefile =~ /\.py$/);
#print "hier2 $@\n";
$self->mm(" ---> Rule applied");
#print "hier3 \n";
chdir($o1);
unlink("$dir$ukto_dir/$ktofile_old.kto") if ($ktofile ne $ktofile_old);
# sleep 1;
#print "hier4\n";
open(FFILE,"<$dir$ukto_dir/$ktofile.kto");
$shakey_orig = <FFILE>;
#print "hier5 $shakey_orig\n";
$text1 = join("",<FFILE>); # aktueller Text des geaenderten Unterkonto-Files
close(FFILE);
if ($shakey_orig =~ /\((.*?)\)/) { # den neuen shakey kuenstlich anpassen,
$shakey = $1; # damit auch gemerged wird
}
# $text1->[1] =~ s/^( +)(\S+)( +)(\-?\d+\.\d\d)/$1$bezeichnung$3$4/s if ($bezeichnung);
}
# 6. Mergen
my $erg = "OK 112. Kto file $dir---UKTO---/$ktofile.kto did not need to change.";
if ($shakey_orig !~ /\(\S\S\S\S\S\S\)/) { # diese Pruefung ist nur dann noetig, wenn a) ein Key vorliegt
$erg = "OK 139. Kto file $dir---UKTO---/$ktofile.kto created.";
} else {
if ($shakey_orig !~ /\($shakey_new\)/) { # der dann noch vom neuen Key unterschiedlich ist,
# d.h. das Unterkonto wurde geaendert
if ($shakey_orig !~ /\($shakey\)/) {
$text1_r = $self->reduce_kto($text1); # diese beiden Kontotexte werden schon mal ausgerechnet fuer den
$text2_r = $self->reduce_kto($text2); # Fall, dass kein Merge moeglich ist
if ($self->compute_shakey($text1_r) ne $self->compute_shakey($text2_r)) {
open(FFILE,">$dir$ukto_dir/ORIG.$ktofile.kto");
print FFILE $shakey_orig . $text1_r;
close(FFILE);
open(FFILE,">$dir$ukto_dir/MERGE.$ktofile.kto");
print FFILE $shakey_orig . $text2_r;
close(FFILE);
$text2 = `diff -b -U 99999999 $dir$ukto_dir/MERGE.$ktofile.kto $dir$ukto_dir/ORIG.$ktofile.kto`;
unlink("$dir$ukto_dir/MERGE.$ktofile.kto");
unlink("$dir$ukto_dir/ORIG.$ktofile.kto");
$text2 =~ s/^(.*?\n \S+ +\([0123456789abcedf]+\) *\n)(.*)$/\nCONFLICTS__see_above\:\n\n$2/s;
$text2 =~ s/(\n [^\n]+)(\n[\+\-])/$1\n\nCONFLICT\:$2/gs;
$text2 =~ s/(\n[\+\-][^\n]+)(\n )/$1\n$2/gs;
$ktofile = $ktofile . "_CONFLICT";
$erg = "WARNING 109. Conflicts in generated file $dir---UKTO---/$ktofile.kto.";
}
} else {
$self->mm("H. File $dir$parent_kto written.\nRE-IMPORT Unterkto $dir$ukto ...."); # reimportieren und wieder exportieren
if ($text1 =~ /\n[\+\-]/) {
return("ERROR 106. Kto $dir$ukto_dir/$ktofile.kto has merge conflicts, please resolve before.")
}
$text2 = $self->split2([@$parent_text],$ukto,[split(/\n/,$text1)]); # re-importieren und wieder exportieren
open(FFILE,"<$dir$parent_kto");
$o1 = join("",<FFILE>);
close(FFILE);
return("ERROR 107. Parent kto on disk is newer, no merge.") if ($o1 ne join("",@$parent_text));
open(FFILE,">$dir$parent_kto");
print FFILE $parent_text->[0] . $text2;
close(FFILE);
$self->mm("H. File $dir$ukto_dir/$ktofile.kto written.\nRE-EXPORT Unterkto $dir$ukto ....");
$o1 = $ukto;
$o1 =~ s/SUM//;
$o1 =~ s/(^|\-)(.)$//;
$text2 = $self->split2([grep(/$o1/,split(/\n/,$text2))],$ukto);
$erg = "OK 110. Kto file $dir---UKTO---/$ktofile.kto synchronized.";
$shakey = $self->compute_shakey($text2,$file_content);
}
}
}
# my $uktolist1 = [grep(/^([a-zA-Z\_0-9]+) +([a-zA-Z0-9\-\_]+) +(\-?\d+\.\d\d) *$/,<FFILE>)];
$shakey_orig = $ukto;
if ($ukto !~ /\-[0123456789ABCIJKLMNOP]$/ and $ukto !~ /\-SUM[0123456789ABCIJKLMNOP]$/) {
if (length($shakey_orig) < 70) { $shakey_orig = substr($shakey_orig." "x70,0,70); }
$shakey_orig = "$shakey_orig ($shakey)" if ($shakey);
}
$o1 = $text2;
$o1 =~ s/^(.*?)\n(.*)$/$2/s;
$o1 =~ s/[\n ]/ /gs;
if (!$o1) {
# print(Cwd::cwd() . " $dir$ukto_dir/$ktofile_old.kto\n");
unlink("$dir$ukto_dir/$ktofile_old.kto");
rmdir("$dir$ukto_dir");
return("WARNING 108. Empty sub kto $dir$ukto_dir deleted.") if (!(-d("$dir$ukto_dir")));
return("WARNING 117. Sub kto file in $dir$ukto_dir deleted.");
}
unlink("$dir$ukto_dir/$ktofile_old.kto") if ($ktofile ne $ktofile_old);
open(FFILE,">$dir$ukto_dir/$ktofile.kto");
print FFILE $shakey_orig . "\n" . $text2;
close(FFILE);
# 6. -- Synchronisation der direkten Unterkonten
my $uktolist_dir = {}; # als Unterverzeichnisse gefundene Unterkonten
opendir(DDIR,"$dir$ukto_dir");
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
next if ($o =~ /^\./);
next if (!(-d "$dir$ukto_dir/$o"));
next if ($o =~ /\-/);
$o1 = $o;
$o1 =~ s/^(.*)\_\_(.*)$/$1/;
$uktolist_dir->{$o1} = $o;
}
my $uktolist_kto = {}; # im Konto gefundene Unterverzeichnisse
if ($text2 =~ /^ +(\S+) +\-?\d+\.\d\d/s) {
$bezeichnung = $1;
}
while ($text2 =~ s/\n([a-zA-Z\_0-9]+) +([a-zA-Z0-9\-\_]*) +(\-?\d+\.\d\d) *\n/\n/) {
$uktolist_kto->{$1} = $1."__".$2;
$uktolist_kto->{$1} =~ s/\_\_$//;
}
# print Dumper($uktolist_dir);
# print Dumper($uktolist_kto);
foreach $o (keys %$uktolist_kto) { # Anlegen fehlender Konten-Unterverzeichnisse
if (exists($uktolist_dir->{$o})) {
next if ($uktolist_dir->{$o} eq $uktolist_kto->{$o}); # Bezeichnungen stimmen ueberein
move("$dir$ukto_dir/".$uktolist_dir->{$o},"$dir$ukto_dir/".$uktolist_kto->{$o});
} else {
mkdir("$dir$ukto_dir/".$uktolist_kto->{$o});
# open(FFILE,">$dir$ukto_dir/".$uktolist_kto->{$o}."/$ktofile\_$o.kto");
# print FFILE "to_synchronize..\n";
# close(FFILE);
}
}
foreach $o (keys %$uktolist_dir) { # Loeschen offensichtlich ueberfluessiger
if (exists($uktolist_kto->{$o})) { # Konten-Unterverzeichnisse
next if ($uktolist_dir->{$o} eq $uktolist_kto->{$o});
move("$dir$ukto_dir/".$uktolist_dir->{$o},"$dir$ukto_dir/".$uktolist_kto->{$o});
} else {
# unlink("$dir$ukto_dir/".$uktolist_dir->{$o}."/CHECK.txt");
open(FFILE,"<$dir$ukto_dir/".$uktolist_dir->{$o}."/$ktofile\_$o.kto");
$o1 = "\n" . join("",<FFILE>);
close(FFILE);
if ($o1 !~ /\n ?(\S+) +\([0123456789abcedf]\)/s) {
unlink("$dir$ukto_dir/".$uktolist_dir->{$o}."/$ktofile\_$o.kto");
rmdir("$dir$ukto_dir/".$uktolist_dir->{$o});
}
# open(FFILE,">$dir$ukto_dir/".$uktolist_dir->{$o}."/CHECK.txt");
# print FFILE "please check that konto ...\n";
# close(FFILE);
}
}
if ($bezeichnung) {
$ukto = $ukto . "__" . $bezeichnung;
# print "$ukto $ukto_dir ---\n";
if ($ukto ne $ukto_dir) {
move("$dir$ukto_dir","$dir$ukto");
}
$ukto_dir = $ukto;
}
$erg =~ s/---UKTO---/$ukto_dir/g;
return($erg);
}
#*******************************************************************
sub compute_shakey {
my $self = shift;
my $ktotext = shift;
my $file_content = shift;
$ktotext =~ s/\n([^\n]+)( \-?\d+\.\d\d )/\n$1 x /gs;
$ktotext =~ s/\n([^\n]+)( \-?\d+\.\d\d )([^\n]+\{)/\n$1 x $3/gs;
$ktotext =~ s/\n/ /gs;
$ktotext =~ s/ +/ /gs;
$ktotext =~ s/^ *(.*?) *$/$1/g;
my $shakey_new = $ktotext . $file_content;
return(substr(Digest::SHA1::sha1_hex($shakey_new),0,6));
}
#*******************************************************************
sub reduce_kto { # Dient zur Normierung zu vergleichender Konten.
# Alle Summen - die ja redundant sind - werden auf 9.99 gesetzt.
# Dadurch koennen zu mergende Dateien leicht mit diff -b verglichen werden.
my $self = shift;
my $text = "\n" . shift;
$text =~ s/\n([^ ;]+ +\-?\d+\.\d\d +[^ ;]+ +[^ ;]+ +)( \-?\d+)(\.\d\d )/\n$1$2___NULL___ /gs;
$text =~ s/\n(\S* +[a-zA-Z0-9\-\_]* +)(\-?\d+)(\.\d\d) *\n/\n$1$2___NULL___ \n/gs; # Saldeneintrag
$text =~ s/\n(\S* +[a-zA-Z0-9\-\_]* +)(\-?\d+)(\.\d\d) *\n/\n$1$2___NULL___ \n/gs; # Saldeneintrag
$text =~ s/\n([^\n]+)( \d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( \d\d\d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/\n([^\n]+)( -\d\d\d\d\d\d\d\d\d\d\d___NULL___ )/\n$1 9.99 /gs;
$text =~ s/^\n//s;
return($text);
}
#*******************************************************************
sub kto_header {
my $self = shift;
my $ukto = shift;
my $text = shift;
return($ukto) if ($ukto !~ /\-[0123456789ABCIJKLMNOP]$/ and $ukto !~ /\-SUM[0123456789ABCIJKLMNOP]$/);
if (length($ukto) < 70) { $ukto = substr($ukto." "x70,0,70); }
return("$ukto ($text)");
}
#*****************************************************************************
sub shell1 {
my $self = shift;
my $cmd = shift;
my $dir = shift || ".";
my @pars = @_;
my $o; my $o1; my $o2; my $text; my $ifiles; my $jahr;
$dir =~ s/[\\\/]+$//;
if ($cmd eq "e") { $cmd = "edit"; }
elsif ($cmd eq "a") { $cmd = "rearrange"; }
elsif ($cmd eq "k") { $cmd = "export"; }
elsif ($cmd eq "r") { $cmd = "rule"; }
elsif ($cmd eq "i") { $cmd = "import"; }
elsif ($cmd eq "p") { $cmd = "prune"; }
elsif ($cmd eq "q") { $cmd = "pruneall"; }
if ($cmd =~ /prune/) { # alle Unterkonten loeschen
$dir =~ s/[\\\/]+$//;
opendir(DDIR,$dir);
$text = [];
while (0 == 0) {
$o = readdir(DDIR);
last if (!$o);
if (-f "$dir/$o") {
if ($o =~ /\~$/ or ($o =~ /\.kto$/ and $cmd eq "pruneall")) {
unlink("$dir/$o");
print("File $dir/$o deleted ...\n");
}
}
next if ($o =~ /^\./);
push(@$text,$o) if (-d "$dir/$o");
}
closedir(DDIR);
foreach $o (@$text) {
$self->shell("pruneall","$dir/$o");
print("Directory $dir/$o deleted ...\n") if rmdir("$dir/$o");
}
return("OK: Directory $dir cleared.");
}
if ($cmd eq "rearrange") { $dir = "___REARRANGE___"; }
if (-d $cmd) {
$dir = $cmd;
$cmd = "";
}
my $ukto = "";
if ($dir =~ /^(.*)[\\\/](.*)$/) {
$dir = $1;
$ukto = $2;
}
elsif ($dir eq "." or $dir =~ /^SxxxUM.$/ or $dir =~ /^xxxxx.$/) {
$ukto = Cwd::cwd();
$ukto =~ s/^(.*)[\\\/](.*)$/$2/;
$ukto = $ukto . "-" . $dir if ($dir ne ".");
$dir = ".";
chdir("..");
}
else {
$ukto = $dir;
$dir = ".";
}
my $files = $self->konto($dir);
return($files) if ($files =~ /^ERROR/);
if ($files->{'kto'}->[0] =~ /^(.*)\.kto$/) {
$o = "$1\_$ukto.kto";
}
my $ukto0 = $files->{'text'}->[0];
chdir($dir);
mkdir($ukto);
if ($cmd =~ /^(export|edit|rearrange|rule)$/) {
return("ERROR: File $ukto/$o exists, please merge or remove it\n") if (-f "$ukto/$o");
$text = $self->split2($files->{'text'},$ukto);
open(FFILE,">$ukto/$o");
$o1 = $ukto;
if ($ukto !~ /\-.$/ and $ukto !~ /\-SUM.$/) {
if (length($o1) < 70) { $o1 = substr($o1." "x70,0,70); }
$o1 = "$o1 (" . substr(Digest::SHA1::sha1_hex($text),0,6) . ")";
}
print FFILE $o1 . "\n" . $text;
close(FFILE);
$self->mm("File $ukto/$o written.");
}
chdir($ukto);
system("perl rule.pl " . join(" ",@pars)) if ($cmd eq "rule");
if ($cmd eq "edit") {
while (0 == 0) {
if (-f "/etc/hosts") {
system("joe $o");
} else {
system("notepad $o");
}
unlink($o."~");
open(FFILE,"<".$o);
$o1 = join("",<FFILE>);
close(FFILE);
$text = $o1;
while ($text =~ s/\n(\d\d\d\d)MM(\d\d +\S+ +\S+ +\S+ +-?\d+\.\d\d +.*?)\n/---BUCHUNG---/s) { # Monats-
$o2 = join("\n", map { $1 . $_ . $2 } qw(01 02 03 04 05 06 07 08 09 10 11 12) ); # substitution
$text =~ s/---BUCHUNG---/\n$o2\n/s;
}
if ($text =~ s/^\-\-([a-zA-Z0-9\_\-]+)(.*?)\n(\d\d\d\d)(\d\d\d\d )/$1$2\n---PLAN---$3$4/s) {
$o2 = $3 . "0102 1.00 -soll 11-4999 0.00 Plan Soll\n" .
$3 . "0103 0.00 -ist 10-4998 0.00 Plan Ist {-:$1+soll+ist}\n";
$text =~ s/---PLAN---/$o2/s;
}
while ($text =~ s/(\-?\d+\.\d\d)( +\-)(\S+\-)soll( +)(.*?)\n\3soll( +\S* +)(\-?\d+\.\d\d)/$7$2$3sxxx$4$5\n$3sxxx$6$7/s) { 1; }
$text =~ s/sxxx/soll/g;
last if ($o1 eq $text);
open(FFILE,">".$o);
print FFILE $text;
close(FFILE);
}
}
chdir("..");
$o1 = "OK";
if ($cmd =~ /^(import|edit|rearrange|rule)$/) {
if ($ukto !~ /^(.*\-|)(SUM|).$/) {
$ifiles = $self->konto($ukto);
return($ifiles) if ($ifiles =~ /^ERROR/);
if (join("",@{$ifiles->{'text'}}) !~ /\([0123456789abcdef]+\)/s) {
$o1 = "Merge not possible.";
}
if (join("",@{$ifiles->{'text'}}) =~ /^(.*?)\((.*?)\)(.*?)\n(.*)$/s) {
$o1 = "Merge not necessary." if (substr(Digest::SHA1::sha1_hex($4),0,6) eq $2);
}
$o1 = "OK" if ($cmd eq "rearrange");
if ($o1 eq "OK") {
$text = $self->split2($files->{'text'},$ukto,$ifiles->{'text'});
open(FFILE,">".$files->{'kto'}->[0]);
print FFILE $ukto0 . $text;
close(FFILE);
$self->mm("File " . $files->{'kto'}->[0] . " written.");
}
} else {
$o1 = "... is filter konto, cannot be re-imported.";
}
unlink("$ukto/$o");
rmdir($ukto);
}
$self->mm("ENDE");
return($o1);
}
#*******************************************************************
sub konto { # Liest alle Files im Verzeichnis aus und ordnet sie nach Arten,
# dann wird die Buchungsliste ausgegeben
my $self = shift;
my $dir = shift;
my $mode = shift;
my $o; my $endung;
my $files = {};
$files->{'kto'} = [];
opendir(DDIR,$dir);
while (0 == 0) {
$o = readdir(DDIR);
next if ($o =~ /^\./);
last if (!$o);
if ($o =~ /^(.*)\.(.*)$/) {
$endung = $2;
} else {
$endung = "NOENDING";
}
if (-d $o) {
$endung = "DIR";
}
push(@{$files->{$endung}},$o);
}
closedir(DDIR);
return("ERROR101: No unique kto-File found in $dir\n") if ($#{$files->{'kto'}} != 0);
$dir =~ s/([^\\\/])$/$1\//;
open(FFILE,"<$dir".$files->{'kto'}->[0]);
$files->{'text'} = [<FFILE>];
close(FFILE);
#---------- PRECOMPILE ---------------
# if ($text =~ /\-soll / and $text =~ /\n(\d\d\d\d)(\d\d\d\d) +(\-\d+\.\d\d) /) {
# my $year = $1;
# $text =~ s/\n(\d\d\d\d\d\d\d\d) +(\-\d+\.\d\d) +(\S+)(\-soll|\-ist) +([^\n]+)//gs) {
# while (0 == 0) {
# $text =~ s/\n(\S+)\-soll +(\S*) +(\-?\d+\.\d\d)//;
# $o1 = $1;
# $o2 = $2;
# $betrag = $3;
# $text = $text . "$o1 $o2 $betrag\n" if ($o2);
# $text = $text .
# if ($text =~ s/^\-\-([a-zA-Z0-9\_\-]+)(.*?)\n(\d\d\d\d)(\d\d\d\d )/$1$2\n---PLAN---$3$4/s) {
# $o2 = $3 . "0102 1.00 -soll 11-4999 0.00 Plan Soll\n" .
# $3 . "0103 0.00 -ist 10-4998 0.00 Plan Ist {-:$1+soll+ist}\n";
# $text =~ s/---PLAN---/$o2/s;
# }
return($files);
}
#*********************************************************************************************
1;