Revision 7b31116b
Von Moritz Bunkus vor etwa 16 Jahren hinzugefügt
| SL/DATEV.pm | ||
|---|---|---|
| 30 | 30 |
|
| 31 | 31 |
use Data::Dumper; |
| 32 | 32 |
|
| 33 |
sub _fill {
|
|
| 34 |
$main::lxdebug->enter_sub(); |
|
| 35 |
|
|
| 36 |
my $text = shift; |
|
| 37 |
my $field_len = shift; |
|
| 38 |
my $fill_char = shift; |
|
| 39 |
my $alignment = shift || 'right'; |
|
| 40 |
|
|
| 41 |
my $text_len = length $text; |
|
| 42 |
|
|
| 43 |
if ($field_len < $text_len) {
|
|
| 44 |
$text = substr $text, 0, $field_len; |
|
| 45 |
|
|
| 46 |
} elsif ($field_len > $text_len) {
|
|
| 47 |
my $filler = ($fill_char) x ($field_len - $text_len); |
|
| 48 |
$text = $alignment eq 'right' ? $filler . $text : $text . $filler; |
|
| 49 |
} |
|
| 50 |
|
|
| 51 |
$main::lxdebug->leave_sub(); |
|
| 52 |
|
|
| 53 |
return $text; |
|
| 54 |
} |
|
| 55 |
|
|
| 33 | 56 |
sub get_datev_stamm {
|
| 34 | 57 |
$main::lxdebug->enter_sub(); |
| 35 | 58 |
|
| ... | ... | |
| 371 | 394 |
|
| 372 | 395 |
my ($myconfig, $form, $fromto, $start_jahr) = @_; |
| 373 | 396 |
|
| 374 |
# connect to database |
|
| 375 |
my $dbh = $form->dbconnect($myconfig); |
|
| 376 |
|
|
| 377 | 397 |
my $jahr = $start_jahr; |
| 378 | 398 |
if (!$jahr) {
|
| 379 | 399 |
my @a = localtime; |
| ... | ... | |
| 381 | 401 |
} |
| 382 | 402 |
|
| 383 | 403 |
#Header |
| 384 |
$anwendungsnr = ($fromto) ? "\x31\x31" : "\x31\x33"; |
|
| 385 |
while (length($form->{datentraegernr}) < 3) {
|
|
| 386 |
$form->{datentraegernr} = "\x30" . $form->{datentraegernr};
|
|
| 387 |
} |
|
| 388 |
|
|
| 389 |
$header = "\x1D\x18\x31" . $form->{datentraegernr} . $anwendungsnr;
|
|
| 390 |
|
|
| 391 |
$dfvkz = $form->{dfvkz};
|
|
| 392 |
while (length($dfvkz) < 2) {
|
|
| 393 |
$dfvkz = "\x30" . $dfvkz; |
|
| 394 |
} |
|
| 395 |
$header .= $dfvkz; |
|
| 396 |
|
|
| 397 |
$beraternr = $form->{beraternr};
|
|
| 398 |
while (length($beraternr) < 7) {
|
|
| 399 |
$beraternr = "\x30" . $beraternr; |
|
| 400 |
} |
|
| 401 |
$header .= $beraternr; |
|
| 402 |
|
|
| 403 |
$mandantennr = $form->{mandantennr};
|
|
| 404 |
while (length($mandantennr) < 5) {
|
|
| 405 |
$mandantennr = "\x30" . $mandantennr; |
|
| 406 |
} |
|
| 407 |
$header .= $mandantennr; |
|
| 408 |
|
|
| 409 |
$abrechnungsnr = $form->{abrechnungsnr} . $jahr;
|
|
| 410 |
while (length($abrechnungsnr) < 6) {
|
|
| 411 |
$abrechnungsnr = "\x30" . $abrechnungsnr; |
|
| 412 |
} |
|
| 413 |
$header .= $abrechnungsnr; |
|
| 414 |
|
|
| 415 |
$fromto =~ s/transdate|>=|and|\'|<=//g; |
|
| 416 |
my ($from, $to) = split / /, $fromto; |
|
| 417 |
$from =~ s/ //g; |
|
| 418 |
$to =~ s/ //g; |
|
| 404 |
my $header = "\x1D\x181"; |
|
| 405 |
$header .= _fill($form->{datentraegernr}, 3, '0');
|
|
| 406 |
$header .= ($fromto) ? "11" : "13"; # Anwendungsnummer |
|
| 407 |
$header .= _fill($form->{dfvkz}, 2, '0');
|
|
| 408 |
$header .= _fill($form->{beraternr}, 7, '0');
|
|
| 409 |
$header .= _fill($form->{mandantennr}, 5, '0');
|
|
| 410 |
$header .= _fill($form->{abrechnungsnr} . $jahr, 6, '0');
|
|
| 411 |
|
|
| 412 |
$fromto =~ s/transdate|>=|and|\'|<=//g; |
|
| 413 |
my ($from, $to) = split / /, $fromto; |
|
| 414 |
$from =~ s/ //g; |
|
| 415 |
$to =~ s/ //g; |
|
| 419 | 416 |
|
| 420 | 417 |
if ($from ne "") {
|
| 421 | 418 |
my ($fday, $fmonth, $fyear) = split(/\./, $from); |
| ... | ... | |
| 445 | 442 |
$to = ""; |
| 446 | 443 |
} |
| 447 | 444 |
$header .= $to; |
| 445 |
|
|
| 448 | 446 |
if ($fromto ne "") {
|
| 449 |
$primanota = "\x30\x30\x31";
|
|
| 447 |
$primanota = "001";
|
|
| 450 | 448 |
$header .= $primanota; |
| 451 | 449 |
} |
| 452 | 450 |
|
| 453 |
$passwort = $form->{passwort};
|
|
| 454 |
while (length($passwort) < 4) {
|
|
| 455 |
$passwort = "\x30" . $passwort; |
|
| 456 |
} |
|
| 457 |
$header .= $passwort; |
|
| 458 |
|
|
| 459 |
$anwendungsinfo = "\x20" x 16; |
|
| 460 |
$header .= $anwendungsinfo; |
|
| 461 |
$inputinfo = "\x20" x 16; |
|
| 462 |
$header .= $inputinfo; |
|
| 463 |
|
|
| 451 |
$header .= _fill($form->{passwort}, 4, '0');
|
|
| 452 |
$header .= " " x 16; # Anwendungsinfo |
|
| 453 |
$header .= " " x 16; # Inputinfo |
|
| 464 | 454 |
$header .= "\x79"; |
| 465 | 455 |
|
| 466 | 456 |
#Versionssatz |
| 467 |
if ($form->{exporttype} == 0) {
|
|
| 468 |
$versionssatz = "\xB5" . "1,"; |
|
| 469 |
} else {
|
|
| 470 |
$versionssatz = "\xB6" . "1,"; |
|
| 471 |
} |
|
| 457 |
my $versionssatz = $form->{exporttype} == 0 ? "\xB5" . "1," : "\xB6" . "1,";
|
|
| 472 | 458 |
|
| 473 |
$query = qq| select accno from chart limit 1|; |
|
| 474 |
$sth = $dbh->prepare($query); |
|
| 475 |
$sth->execute || $form->dberror($query); |
|
| 476 |
my $ref = $sth->fetchrow_hashref(NAME_lc); |
|
| 459 |
my $dbh = $form->get_standard_dbh($myconfig); |
|
| 460 |
my $query = qq|SELECT accno FROM chart LIMIT 1|; |
|
| 461 |
my $ref = selectfirst_hashref_query($form, $dbh, $query); |
|
| 477 | 462 |
|
| 478 |
$accnolength = $ref->{accno};
|
|
| 479 |
$sth->finish; |
|
| 480 |
|
|
| 481 |
$versionssatz .= length($accnolength); |
|
| 482 |
$versionssatz .= ","; |
|
| 483 |
$versionssatz .= length($accnolength); |
|
| 484 |
$versionssatz .= ",SELF" . "\x1C\x79"; |
|
| 463 |
$versionssatz .= length $ref->{accno};
|
|
| 464 |
$versionssatz .= ","; |
|
| 465 |
$versionssatz .= length $ref->{accno};
|
|
| 466 |
$versionssatz .= ",SELF" . "\x1C\x79"; |
|
| 485 | 467 |
|
| 486 |
$dbh->disconnect; |
|
| 487 |
|
|
| 488 |
$header .= $versionssatz; |
|
| 468 |
$header .= $versionssatz; |
|
| 489 | 469 |
|
| 490 | 470 |
$main::lxdebug->leave_sub(); |
| 491 | 471 |
|
| ... | ... | |
| 548 | 528 |
|
| 549 | 529 |
my ($header, $filename, $blockcount, $fromto) = @_; |
| 550 | 530 |
|
| 551 |
$versionset = "V" . substr($filename, 2, 5); |
|
| 552 |
$versionset .= substr($header, 6, 22); |
|
| 531 |
my $versionset = "V" . substr($filename, 2, 5); |
|
| 532 |
$versionset .= substr($header, 6, 22); |
|
| 533 |
|
|
| 553 | 534 |
if ($fromto ne "") {
|
| 554 | 535 |
$versionset .= "0000" . substr($header, 28, 19); |
| 555 | 536 |
} else {
|
| 556 |
$datum = "\x20" x 16;
|
|
| 537 |
$datum = " " x 16;
|
|
| 557 | 538 |
$versionset .= $datum . "001" . substr($header, 28, 4); |
| 558 | 539 |
} |
| 559 |
while (length($blockcount) < 5) {
|
|
| 560 |
$blockcount = "0" . $blockcount; |
|
| 561 |
} |
|
| 562 |
$versionset .= $blockcount; |
|
| 540 |
|
|
| 541 |
$versionset .= _fill($blockcount, 5, '0'); |
|
| 563 | 542 |
$versionset .= "001"; |
| 564 |
$versionset .= "\x20\x31";
|
|
| 543 |
$versionset .= " 1";
|
|
| 565 | 544 |
$versionset .= substr($header, -12, 10) . " "; |
| 566 |
$versionset .= "\x20" x 53;
|
|
| 545 |
$versionset .= " " x 53;
|
|
| 567 | 546 |
|
| 568 | 547 |
$main::lxdebug->leave_sub(); |
| 569 | 548 |
|
| ... | ... | |
| 574 | 553 |
$main::lxdebug->enter_sub(); |
| 575 | 554 |
|
| 576 | 555 |
my ($form, $fileno) = @_; |
| 577 |
$datentraegernr = $form->{datentraegernr};
|
|
| 578 |
$beraternummer = $form->{beraternr};
|
|
| 579 |
$beratername = $form->{beratername};
|
|
| 580 |
$anzahl_dateien = $fileno; |
|
| 581 |
|
|
| 582 |
while (length($datentraegernr) < 3) {
|
|
| 583 |
$datentraegernr .= " "; |
|
| 584 |
} |
|
| 585 |
|
|
| 586 |
while (length($beraternummer) < 7) {
|
|
| 587 |
$beraternummer .= " "; |
|
| 588 |
} |
|
| 589 |
|
|
| 590 |
while (length($beratername) < 9) {
|
|
| 591 |
$beratername .= " "; |
|
| 592 |
} |
|
| 593 |
|
|
| 594 |
while (length($anzahl_dateien) < 5) {
|
|
| 595 |
$anzahl_dateien = "0" . $anzahl_dateien; |
|
| 596 |
} |
|
| 597 | 556 |
|
| 598 |
$ev_header = |
|
| 599 |
$datentraegernr . "\x20\x20\x20" . $beraternummer . $beratername . "\x20"; |
|
| 600 |
$ev_header .= $anzahl_dateien . $anzahl_dateien; |
|
| 601 |
$ev_header .= "\x20" x 95; |
|
| 557 |
my $ev_header = _fill($form->{datentraegernr}, 3, ' ', 'left');
|
|
| 558 |
$ev_header .= " "; |
|
| 559 |
$ev_header .= _fill($form->{beraternr}, 7, ' ', 'left');
|
|
| 560 |
$ev_header .= _fill($form->{beratername}, 9, ' ', 'left');
|
|
| 561 |
$ev_header .= " "; |
|
| 562 |
$ev_header .= (_fill($fileno, 5, '0')) x 2; |
|
| 563 |
$ev_header .= " " x 95; |
|
| 602 | 564 |
|
| 603 | 565 |
$main::lxdebug->leave_sub(); |
| 604 | 566 |
|
Auch abrufbar als: Unified diff
Feld auffüllen in eigene Funktion verlagert.