Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 081a4f97

Von Moritz Bunkus vor etwa 19 Jahren hinzugefügt

  • ID 081a4f9736f3bc345872be8f61632cbed4a8d9b3
  • Vorgänger c5b4fdf4
  • Nachfolger 72539cb3

Kosmetik: Perltidy-Lauf nach den Einstellungen in doc/programmierrichtlinien.txt ueber alle .pl und .pm.

Unterschiede anzeigen:

SL/AP.pm
push @a, "employee" if $self->{l_employee};
my $sortorder = join ', ', $form->sort_columns(@a);
$sortorder = $form->{sort} if $form->{sort};
$query .= "WHERE $where
ORDER by $sortorder";
SL/AR.pm
$form->{amount} = $form->{netamount};
$form->{tax} = 0;
$form->{tax} = 0;
$form->{netamount} = 0;
$form->{total_tax} = 0;
# taxincluded doesn't make sense if there is no amount
$form->{taxincluded} = 0 if ($form->{amount} == 0);
......
$form->{netamount} += $form->{"amount_$i"};
} else {
$form->{"tax_$i"} = $form->{"amount_$i"} * $form->{"taxrate_$i"};
$form->{"tax_$i"} = $form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2);
$form->{"tax_$i"} =
$form->round_amount($form->{"tax_$i"} * $form->{exchangerate}, 2);
$form->{netamount} += $form->{"amount_$i"};
}
}
SL/CA.pm
$where .= $fromto;
$AR_PAID = "";
$AP_PAID = "";
$glwhere = ""; # note! gl will be aliased as "a" later...
$glwhere = ""; # note! gl will be aliased as "a" later...
}
my $sortorder = join ', ',
$form->sort_columns(qw(transdate reference description));
......
foreach my $id (@id) {
# NOTE:
# Postgres is really picky about the order of implicit CROSS JOINs with ','
# if you alias the tables and want to use the alias later in another JOIN.
# the alias you want to use has to be the most recent in the list, otherwise
# Postgres will overwrite the alias internally and complain.
# For this reason, in the next 3 SELECTs, the 'a' alias is last in the list.
# Don't change this, and if you do, substitute the ',' with CROSS JOIN
# ... that also works.
# NOTE:
# Postgres is really picky about the order of implicit CROSS JOINs with ','
# if you alias the tables and want to use the alias later in another JOIN.
# the alias you want to use has to be the most recent in the list, otherwise
# Postgres will overwrite the alias internally and complain.
# For this reason, in the next 3 SELECTs, the 'a' alias is last in the list.
# Don't change this, and if you do, substitute the ',' with CROSS JOIN
# ... that also works.
# get all transactions
$query .= qq|$union
SL/CT.pm
$form->{"cp_${_}"} = $form->{"selected_cp_${_}"}
if ($form->{"selected_cp_${_}"});
} qw(title greeting));
#
#
# escape '
map { $form->{$_} =~ s/\'/\'\'/g }
qw(customernumber name street zipcode city country homepage contact notes cp_title cp_greeting language pricegroup);
......
ustid = '$form->{ustid}',
username = '$form->{username}',
salesman_id = '$form->{salesman_id}',
user_password = | . $dbh->quote($form->{user_password}) .qq|,
user_password = | . $dbh->quote($form->{user_password}) . qq|,
c_vendor_id = '$form->{c_vendor_id}',
klass = '$form->{klass}'
WHERE id = $form->{id}|;
SL/DATEV.pm
my $evfile = "EV01";
my @ed_versionsets;
my $fileno = 0;
$form->header;
print qq|
<html>
......
$remaining_bytes -= length($header);
while (scalar(@{ $form->{DATEV} }) > 0) {
$transaction = shift @{ $form->{DATEV} };
$trans_lines = scalar(@{$transaction});
$transaction = shift @{ $form->{DATEV} };
$trans_lines = scalar(@{$transaction});
$counter++;
if (($counter % 500) == 0) {
print("$counter ");
......
print(EV $ed_versionset[$file]);
}
close(EV);
print qq|<br>Done. <br></body>
print qq|<br>Done. <br></body>
</html>
|;
###
......
qq|SELECT c.accno, c.description FROM chart c WHERE c.accno >=|
. $dbh->quote($form->{accnofrom}) . qq|
AND c.accno <= |
. $dbh->quote($form->{accnoto})
. qq| ORDER BY c.accno|;
. $dbh->quote($form->{accnoto}) . qq| ORDER BY c.accno|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
SL/Form.pm
sub quote {
my ($self, $str) = @_;
if ($str && ! ref($str)) {
if ($str && !ref($str)) {
$str =~ s/"/&quot;/g;
}
......
}
sub unquote {
my ($self, $str) = @_;
if ($str && ! ref($str)) {
if ($str && !ref($str)) {
$str =~ s/&quot;/"/g;
}
......
}
sub hide_form {
my $self = shift;
if (@_) {
for (@_) { print qq|<input type=hidden name="$_" value="|.$self->quote($self->{$_}).qq|">\n| }
for (@_) {
print qq|<input type=hidden name="$_" value="|
. $self->quote($self->{$_})
. qq|">\n|;
}
} else {
delete $self->{header};
for (sort keys %$self) { print qq|<input type=hidden name="$_" value="|.$self->quote($self->{$_}).qq|">\n| }
for (sort keys %$self) {
print qq|<input type=hidden name="$_" value="|
. $self->quote($self->{$_})
. qq|">\n|;
}
}
}
sub error {
......
push @triggers, qq|
Calendar.setup(
{
inputField : "|.(shift).qq|",
inputField : "| . (shift) . qq|",
ifFormat :"$ifFormat",
align : "|.(shift).qq|",
button : "|.(shift).qq|"
align : "| . (shift) . qq|",
button : "| . (shift) . qq|"
}
);
|;
}
$jsscript = qq|
<script type="text/javascript">
<!--|.join("", @triggers).qq|//-->
<!--| . join("", @triggers) . qq|//-->
</script>
|;
......
$main::lxdebug->enter_sub();
my ($self, $myconfig, $amount, $places, $dash) = @_;
#Workaround for $format_amount calls without $places
if (!defined $places){
(my $dec) = ($amount =~ /\.(\d+)/);
$places = length $dec;
}
if (!defined $places) {
(my $dec) = ($amount =~ /\.(\d+)/);
$places = length $dec;
}
if ($places =~ /\d/) {
$amount = $self->round_amount($amount, $places);
......
# is the amount negative
my $negative = ($amount < 0);
my $fillup = "";
my $fillup = "";
if ($amount != 0) {
if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00'))
......
$amount =~ s/\d{3,}?/$&,/g;
$amount =~ s/,$//;
$amount = join '', reverse split //, $amount;
$amount .= "\.$dec".$fillup if ($places ne '' && $places*1 != 0);
$amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0);
}
if ($myconfig->{numberformat} eq '1.000,00') {
$amount =~ s/\d{3,}?/$&./g;
$amount =~ s/\.$//;
$amount = join '', reverse split //, $amount;
$amount .= ",$dec".$fillup if ($places ne '' && $places*1 != 0);
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
}
if ($myconfig->{numberformat} eq '1000,00') {
$amount = "$whole";
$amount .= ",$dec" .$fillup if ($places ne '' && $places*1 != 0);
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
}
if ($dash =~ /-/) {
......
$main::lxdebug->enter_sub();
my ($self, $myconfig, $amount) = @_;
$main::lxdebug->message(LXDebug::DEBUG2, "Start amount: $amount");
if ($myconfig->{in_numberformat} == 1){
$main::lxdebug->message(LXDebug::DEBUG2, "Start amount: $amount");
if ($myconfig->{in_numberformat} == 1) {
# Extra input number format 1000.00 or 1000,00
$main::lxdebug->message(LXDebug::DEBUG2, "in_numberformat: " . $main::locale->text('1000,00 or 1000.00'));
$main::lxdebug->message(LXDebug::DEBUG2,
"in_numberformat: " . $main::locale->text('1000,00 or 1000.00'));
$amount =~ s/,/\./g;
#$main::lxdebug->message(LXDebug::DEBUG2, "1.Parsed Number: $amount") if ($amount);
$amount = scalar reverse $amount;
#$main::lxdebug->message(LXDebug::DEBUG2, "2.Parsed Number: $amount") if ($amount);
$amount =~ s/\./DOT/;
#$main::lxdebug->message(LXDebug::DEBUG2, "3.Parsed Number: $amount") if ($amount);
$amount =~ s/\.//g;
#$main::lxdebug->message(LXDebug::DEBUG2, "4.Parsed Number: $amount") if ($amount);
$amount =~ s/DOT/\./;
#$main::lxdebug->message(LXDebug::DEBUG2, "5.Parsed Number:" . $amount) if ($amount);
$amount = scalar reverse $amount ;
$main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount . "\n");
$amount = scalar reverse $amount;
$main::lxdebug->message(LXDebug::DEBUG2,
"Parsed amount:" . $amount . "\n");
return ($amount * 1);
}
$main::lxdebug->message(LXDebug::DEBUG2, "in_numberformat: " . $main::locale->text('equal Outputformat'));
$main::lxdebug->message(LXDebug::DEBUG2, " = numberformat: $myconfig->{numberformat}");
$main::lxdebug->message(LXDebug::DEBUG2,
"in_numberformat: " . $main::locale->text('equal Outputformat'));
$main::lxdebug->message(LXDebug::DEBUG2,
" = numberformat: $myconfig->{numberformat}");
if ( ($myconfig->{numberformat} eq '1.000,00')
|| ($myconfig->{numberformat} eq '1000,00')) {
$amount =~ s/\.//g;
......
}
if ($myconfig->{numberformat} eq "1'000.00") {
$amount =~ s/'//g;
$amount =~ s/'//g;
}
$amount =~ s/,//g;
$main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount. "\n") if ($amount);
$main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount . "\n")
if ($amount);
$main::lxdebug->leave_sub();
return ($amount * 1);
}
......
# Rounding like "Kaufmannsrunden"
# Descr. http://de.wikipedia.org/wiki/Rundung
# Inspired by
# Inspired by
# http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html
# Solves Bug: 189
# Udo Spallek
$amount = $amount * (10 ** ($places));
$round_amount = int($amount + .5 * ($amount <=> 0))/(10**($places));
$amount = $amount * (10**($places));
$round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
$main::lxdebug->leave_sub();
return $round_amount;
}
}
sub parse_template {
$main::lxdebug->enter_sub();
......
}
# Yes we need a manual page break -- or the user has forced one
if ((($current_line + $lines) > $lpp) ||
($self->{"_forced_pagebreaks"} && grep(/^${current_row}$/, @{$self->{"_forced_pagebreaks"}}))) {
if (
(($current_line + $lines) > $lpp)
|| ($self->{"_forced_pagebreaks"}
&& grep(/^${current_row}$/, @{ $self->{"_forced_pagebreaks"} }))
) {
my $pb = $pagebreak;
# replace the special variables <%sumcarriedforward%>
......
my %unique_fields;
%unique_fields = map({ $_ => 1 } @fields);
@fields = keys(%unique_fields);
@fields = keys(%unique_fields);
foreach my $field (@fields) {
next unless ($self->{$field} =~ /\<pagebreak\>/);
......
$main::lxdebug->enter_sub();
my ($self, $dbh, $curr, $transdate, $fld) = @_;
unless ($transdate) {
$main::lxdebug->leave_sub();
return "";
......
my ($self, $dbh, $id) = @_;
##LINET
my $shipto;
foreach
my $item (qw(name department_1 department_2 street zipcode city country contact phone fax email)) {
foreach my $item (
qw(name department_1 department_2 street zipcode city country contact phone fax email)
) {
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
......
}
if ($shipto) {
my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet,
my $query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, shiptostreet,
shiptozipcode, shiptocity, shiptocountry, shiptocontact,
shiptophone, shiptofax, shiptoemail) VALUES ($id,
'$self->{shiptoname}', '$self->{shiptodepartment_1}', '$self->{shiptodepartment_2}', '$self->{shiptostreet}',
......
my %xkeyref = ();
# now get the account numbers
$query =
qq|SELECT c.accno, c.description, c.link, c.taxkey_id
$query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id
FROM chart c
WHERE c.link LIKE '%$module%'
ORDER BY c.accno|;
......
$self->{exchangerate} =
$self->get_exchangerate($dbh, $self->{currency}, $self->{transdate},
$fld);
my $index=0;
my $index = 0;
# store amounts in {acc_trans}{$key} for multiple accounts
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
$ref->{exchangerate} =
$self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate},
$fld);
if ( !($xkeyref{ $ref->{accno} } =~ /tax/)) {
if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
$index++;
}
$ref->{index} = $index;
......
$main::lxdebug->leave_sub();
}
sub get_pricegroup {
$main::lxdebug->enter_sub();
......
$main::lxdebug->leave_sub();
}
sub audittrail {
my ($self, $dbh, $myconfig, $audittrail) = @_;
# table, $reference, $formname, $action, $id, $transdate) = @_;
# table, $reference, $formname, $action, $id, $transdate) = @_;
my $query;
my $rv;
my $disconnect;
if (! $dbh) {
$dbh = $self->dbconnect($myconfig);
if (!$dbh) {
$dbh = $self->dbconnect($myconfig);
$disconnect = 1;
}
# if we have an id add audittrail, otherwise get a new timestamp
if ($audittrail->{id}) {
$query = qq|SELECT audittrail FROM defaults|;
if ($dbh->selectrow_array($query)) {
my ($null, $employee_id) = $self->get_employee($dbh);
if ($self->{audittrail} && !$myconfig) {
chop $self->{audittrail};
my @a = split /\|/, $self->{audittrail};
my %newtrail = ();
my $key;
my $i;
my @flds = qw(tablename reference formname action transdate);
# put into hash and remove dups
while (@a) {
$key = "$a[2]$a[3]";
$i = 0;
$newtrail{$key} = { map { $_ => $a[$i++] } @flds };
splice @a, 0, 5;
}
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
chop $self->{audittrail};
my @a = split /\|/, $self->{audittrail};
my %newtrail = ();
my $key;
my $i;
my @flds = qw(tablename reference formname action transdate);
# put into hash and remove dups
while (@a) {
$key = "$a[2]$a[3]";
$i = 0;
$newtrail{$key} = { map { $_ => $a[$i++] } @flds };
splice @a, 0, 5;
}
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
formname, action, employee_id, transdate)
VALUES ($audittrail->{id}, ?, ?,
?, ?, $employee_id, ?)|;
my $sth = $dbh->prepare($query) || $self->dberror($query);
foreach $key (sort { $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} } keys %newtrail) {
$i = 1;
for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) }
$sth->execute || $self->dberror;
$sth->finish;
}
my $sth = $dbh->prepare($query) || $self->dberror($query);
foreach $key (
sort {
$newtrail{$a}{transdate} cmp $newtrail{$b}{transdate}
} keys %newtrail
) {
$i = 1;
for (@flds) { $sth->bind_param($i++, $newtrail{$key}{$_}) }
$sth->execute || $self->dberror;
$sth->finish;
}
}
if ($audittrail->{transdate}) {
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
formname, action, employee_id, transdate) VALUES (
$audittrail->{id}, '$audittrail->{tablename}', |
.$dbh->quote($audittrail->{reference}).qq|,
. $dbh->quote($audittrail->{reference}) . qq|,
'$audittrail->{formname}', '$audittrail->{action}',
$employee_id, '$audittrail->{transdate}')|;
} else {
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
$query = qq|INSERT INTO audittrail (trans_id, tablename, reference,
formname, action, employee_id) VALUES ($audittrail->{id},
'$audittrail->{tablename}', |
.$dbh->quote($audittrail->{reference}).qq|,
. $dbh->quote($audittrail->{reference}) . qq|,
'$audittrail->{formname}', '$audittrail->{action}',
$employee_id)|;
}
$dbh->do($query);
}
} else {
$query = qq|SELECT current_timestamp FROM defaults|;
my ($timestamp) = $dbh->selectrow_array($query);
$rv = "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|";
$rv =
"$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|";
}
$dbh->disconnect if $disconnect;
$rv;
}
package Locale;
SL/GL.pm
$apwhere .= " AND c.gifi_accno = '$form->{gifi_accno}'";
}
if ($form->{category} ne 'X') {
$glwhere .= " AND gl.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
$arwhere .= " AND ar.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
$apwhere .= " AND ap.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
$glwhere .=
" AND gl.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
$arwhere .=
" AND ar.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
$apwhere .=
" AND ap.id in (SELECT trans_id FROM acc_trans ac2 WHERE ac2.chart_id IN (SELECT id FROM chart c2 WHERE c2.category = '$form->{category}'))";
}
if ($form->{accno}) {
......
my $false = ($myconfig->{dbdriver} eq 'Pg') ? FALSE: q|'0'|;
my $sortorder = join ', ', $form->sort_columns(qw(transdate reference source description accno));
my %ordinal = ( transdate => 6,
reference => 4,
source => 7,
description => 5 );
map { $sortorder =~ s/$_/$ordinal{$_}/ } keys %ordinal;
if ($form->{sort}) {
$sortorder = $form->{sort} . ",";
} else {
$sortorder = "";
}
my $sortorder = join ', ',
$form->sort_columns(qw(transdate reference source description accno));
my %ordinal = (transdate => 6,
reference => 4,
source => 7,
description => 5);
map { $sortorder =~ s/$_/$ordinal{$_}/ } keys %ordinal;
if ($form->{sort}) {
$sortorder = $form->{sort} . ",";
} else {
$sortorder = "";
}
my $query =
qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference, ac.taxkey, t.taxkey AS sorttax,
g.description, ac.transdate, ac.source, ac.trans_id,
......
ORDER BY $sortorder transdate, trans_id, taxkey DESC, sorttax DESC,oid|;
my $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
my $trans_id = "";
my $trans_id = "";
my $trans_id2 = "";
while (my $ref0 = $sth->fetchrow_hashref(NAME_lc)) {
$trans_id = $ref0->{id};
......
push @{ $form->{GL} }, $ref;
$balance = 0;
}
$ref = $ref0;
$ref = $ref0;
$trans_id2 = $ref->{id};
# gl
if ($ref->{type} eq "gl") {
$ref->{module} = "gl";
}
# ap
if ($ref->{type} eq "ap") {
if ($ref->{invoice}) {
......
$ref->{module} = "ap";
}
}
# ar
if ($ref->{type} eq "ar") {
if ($ref->{invoice}) {
......
}
}
} else {
$ref2 = $ref0;
$ref2 = $ref0;
$trans_id2 = $ref2->{id};
# if ($form->{accno} eq ''){ # flo & udo: if general report,
# then check balance
# while (abs($balance) >= 0.015) {
# my $ref2 = $sth->fetchrow_hashref(NAME_lc)
# || $form->error("Unbalanced ledger!");
#
$balance =
(int($balance * 100000) + int(100000 * $ref2->{amount})) / 100000;
if ($ref2->{amount} < 0) {
if ($ref2->{chart_id} > 0) {
if ($ref->{debit_tax_accno}{$i} ne "") {
$i++;
}
$ref->{debit_tax}{$i} = $ref2->{amount} * -1;
$ref->{debit_tax_accno}{$i} = $ref2->{accno};
} else {
if ($ref->{debit_accno}{$k} ne "") {
$k++;
}
$ref->{debit}{$k} = $ref2->{amount} * -1;
$ref->{debit_accno}{$k} = $ref2->{accno};
$ref->{debit_taxkey}{$k} = $ref2->{taxkey};
}
} else {
if ($ref2->{chart_id} > 0) {
if ($ref->{credit_tax_accno}{$j} ne "") {
$j++;
}
$ref->{credit_tax}{$j} = $ref2->{amount};
$ref->{credit_tax_accno}{$j} = $ref2->{accno};
} else {
if ($ref->{credit_accno}{$l} ne "") {
$l++;
}
$ref->{credit}{$l} = $ref2->{amount};
$ref->{credit_accno}{$l} = $ref2->{accno};
$ref->{credit_taxkey}{$l} = $ref2->{taxkey};
}
# if ($form->{accno} eq ''){ # flo & udo: if general report,
# then check balance
# while (abs($balance) >= 0.015) {
# my $ref2 = $sth->fetchrow_hashref(NAME_lc)
# || $form->error("Unbalanced ledger!");
#
$balance =
(int($balance * 100000) + int(100000 * $ref2->{amount})) / 100000;
if ($ref2->{amount} < 0) {
if ($ref2->{chart_id} > 0) {
if ($ref->{debit_tax_accno}{$i} ne "") {
$i++;
}
# }
# } else {
# # if account-report, then calculate the Balance?!
# # ToDo: Calculate the Balance
# 1;
# }
$ref->{debit_tax}{$i} = $ref2->{amount} * -1;
$ref->{debit_tax_accno}{$i} = $ref2->{accno};
} else {
if ($ref->{debit_accno}{$k} ne "") {
$k++;
}
$ref->{debit}{$k} = $ref2->{amount} * -1;
$ref->{debit_accno}{$k} = $ref2->{accno};
$ref->{debit_taxkey}{$k} = $ref2->{taxkey};
}
} else {
if ($ref2->{chart_id} > 0) {
if ($ref->{credit_tax_accno}{$j} ne "") {
$j++;
}
$ref->{credit_tax}{$j} = $ref2->{amount};
$ref->{credit_tax_accno}{$j} = $ref2->{accno};
} else {
if ($ref->{credit_accno}{$l} ne "") {
$l++;
}
$ref->{credit}{$l} = $ref2->{amount};
$ref->{credit_accno}{$l} = $ref2->{accno};
$ref->{credit_taxkey}{$l} = $ref2->{taxkey};
}
}
# }
# } else {
# # if account-report, then calculate the Balance?!
# # ToDo: Calculate the Balance
# 1;
# }
}
}
push @{ $form->{GL} }, $ref;
SL/IC.pm
package IC;
use Data::Dumper;
sub get_part {
$main::lxdebug->enter_sub();
......
$main::lxdebug->enter_sub();
my ($self, $myconfig, $form) = @_;
my $dbh = $form->dbconnect($myconfig);
my $i = 1;
my $dbh = $form->dbconnect($myconfig);
my $i = 1;
my @pricegroups_not_used = ();
# get pricegroups
......
$main::lxdebug->leave_sub();
}
sub save {
$main::lxdebug->enter_sub();
......
# insert price records only if different to sellprice
for my $i (1 .. $form->{price_rows}) {
if ($form->{"price_$i"} eq "0") {
$form->{"price_$i"} = $form->{sellprice};
$form->{"price_$i"} = $form->{sellprice};
}
if (( $form->{"price_$i"}
|| $form->{"klass_$i"}
|| $form->{"pricegroup_id_$i"}) and $form->{"price_$i"} != $form->{sellprice}) {
if (
( $form->{"price_$i"}
|| $form->{"klass_$i"}
|| $form->{"pricegroup_id_$i"})
and $form->{"price_$i"} != $form->{sellprice}
) {
$klass = $form->parse_amount($myconfig, $form->{"klass_$i"});
$price = $form->parse_amount($myconfig, $form->{"price_$i"});
$pricegroup_id =
......
$ordwhere .= " AND lower(oi.description) LIKE '$var'";
}
$flds = qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
$flds =
qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
oi.qty AS onhand, oi.unit, p.bin, oi.sellprice,
p.listprice, p.lastcost, p.rop, p.weight,
p.priceupdate, p.image, p.drawing, p.microfiche,
......
}
if ($form->{onorder}) {
$flds = qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
$flds =
qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
oi.qty * -1 AS onhand, oi.unit, p.bin, oi.sellprice,
p.listprice, p.lastcost, p.rop, p.weight,
p.priceupdate, p.image, p.drawing, p.microfiche,
......
$quowhere .= " AND lower(oi.description) LIKE '$var'";
}
$flds = qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
$flds =
qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
oi.qty AS onhand, oi.unit, p.bin, oi.sellprice,
p.listprice, p.lastcost, p.rop, p.weight,
p.priceupdate, p.image, p.drawing, p.microfiche,
......
}
if ($form->{rfq}) {
$flds = qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
$flds =
qq|p.id, p.partnumber, oi.description, oi.serialnumber AS serialnumber,
oi.qty * -1 AS onhand, oi.unit, p.bin, oi.sellprice,
p.listprice, p.lastcost, p.rop, p.weight,
p.priceupdate, p.image, p.drawing, p.microfiche,
SL/IS.pm
push(@{ $form->{description} }, qq|$form->{"description_$i"}|);
push(@{ $form->{qty} },
$form->format_amount($myconfig, $form->{"qty_$i"}));
push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|);
push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|);
push(@{ $form->{deliverydate_oe} }, qq|$form->{"deliverydate_$i"}|);
push(@{ $form->{sellprice} }, $form->{"sellprice_$i"});
push(@{ $form->{sellprice} }, $form->{"sellprice_$i"});
push(@{ $form->{ordnumber_oe} }, qq|$form->{"ordnumber_$i"}|);
push(@{ $form->{transdate_oe} }, qq|$form->{"transdate_$i"}|);
......
$dec = length $dec;
my $decimalplaces = ($dec > 2) ? $dec : 2;
my $i_discount = $form->round_amount($sellprice *
$form->parse_amount($myconfig, $form->{"discount_$i"}) / 100, $decimalplaces);
my $i_discount =
$form->round_amount(
$sellprice * $form->parse_amount($myconfig,
$form->{"discount_$i"}) / 100,
$decimalplaces);
my $discount = $form->round_amount($form->{"qty_$i"} * $i_discount, $decimalplaces);
my $discount =
$form->round_amount($form->{"qty_$i"} * $i_discount, $decimalplaces);
# keep a netprice as well, (sellprice - discount)
$form->{"netprice_$i"} = $sellprice - $i_discount;
......
: " ";
$linetotal = ($linetotal != 0) ? $linetotal : " ";
push(@{ $form->{discount} }, $discount);
push(@{ $form->{discount} }, $discount);
push(@{ $form->{p_discount} }, $form->{"discount_$i"});
$form->{total} += $linetotal;
......
# set values which could be empty to 0
$form->{terms} *= 1;
$form->{taxincluded} *= 1;
my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL";
my $duedate = ($form->{duedate}) ? qq|'$form->{duedate}'| : "NULL";
my $deliverydate = ($form->{deliverydate}) ? qq|'$form->{deliverydate}'| : "NULL";
my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL";
my $duedate = ($form->{duedate}) ? qq|'$form->{duedate}'| : "NULL";
my $deliverydate =
($form->{deliverydate}) ? qq|'$form->{deliverydate}'| : "NULL";
# fill in subject if there is none
$form->{subject} = qq|$form->{label} $form->{invnumber}|
SL/LXDebug.pm
package LXDebug;
use constant NONE => 0;
use constant INFO => 1;
use constant NONE => 0;
use constant INFO => 1;
use constant DEBUG1 => 2;
use constant DEBUG2 => 3;
SL/OE.pm
for my $i (1 .. $form->{rowcount}) {
map {
$form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"})
$form->{"${_}_$i"} =
$form->parse_amount($myconfig, $form->{"${_}_$i"})
} qw(qty ship);
if ($form->{"qty_$i"}) {
......
return $rc;
}
# this function closes multiple orders given in $form->{ordnumber_#}.
# this function closes multiple orders given in $form->{ordnumber_#}.
# use this for multiple orders that don't have to be saved back
# single orders should use OE::save instead.
sub close_orders {
$main::lxdebug->enter_sub();
my ($self, $myconfig ,$form) = @_;
my ($self, $myconfig, $form) = @_;
for my $i (1 .. $form->{rowcount}) {
map {
$form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"})
$form->{"${_}_$i"} =
$form->parse_amount($myconfig, $form->{"${_}_$i"})
} qw(qty ship);
if ($delete_oe_id) {
$form->{"orderitems_id_$i"} = "";
......
$form->parse_amount($myconfig, $form->{"sellprice_$i"});
}
}
# get ids from $form
map { push @ids, $form->{"ordnumber_$_"} if $form->{"ordnumber_$_"} } (1 .. $form->{rowcount});
map { push @ids, $form->{"ordnumber_$_"} if $form->{"ordnumber_$_"} }
(1 .. $form->{rowcount});
my $dbh = $form->dbconnect($myconfig);
$query = qq|UPDATE oe SET
closed = TRUE
WHERE ordnumber IN (|.join(', ', map{ $dbh->quote($_) }@ids).qq|)|;
WHERE ordnumber IN (|
. join(', ', map { $dbh->quote($_) } @ids) . qq|)|;
$dbh->do($query) || $form->dberror($query);
$dbh->disconnect;
......
my $query, @ids;
# translate the ids (given by id_# and trans_id_#) into one array of ids, so we can join them later
map { push @ids, $form->{"trans_id_$_"} if ($form->{"id_$_"} and $form->{"trans_id_$_"}) } (1 .. $form->{"rowcount"});
map {
push @ids, $form->{"trans_id_$_"}
if ($form->{"id_$_"} and $form->{"trans_id_$_"})
} (1 .. $form->{"rowcount"});
# if called in multi id mode, and still only got one id, switch back to single id
# if called in multi id mode, and still only got one id, switch back to single id
if ($form->{"rowcount"} and $#ids == 0) {
$form->{"id"} = $ids[0];
undef @ids;
......
($form->{currency}) = split /:/, $form->{currencies};
# set reqdate if this is an invoice->order conversion. If someone knows a better check to ensure
# set reqdate if this is an invoice->order conversion. If someone knows a better check to ensure
# we come from invoices, feel free.
$form->{reqdate} = $form->{deliverydate} if ($form->{deliverydate} and $form->{callback} =~ /action=ar_transactions/);
$form->{reqdate} = $form->{deliverydate}
if ( $form->{deliverydate}
and $form->{callback} =~ /action=ar_transactions/);
if ($form->{id} or @ids) {
# retrieve order for single id
# NOTE: this query is intended to fetch all information only ONCE.
# so if any of these infos is important (or even different) for any item,
# so if any of these infos is important (or even different) for any item,
# it will be killed out and then has to be fetched from the item scope query further down
$query = qq|SELECT o.cp_id, o.ordnumber, o.transdate, o.reqdate,
o.taxincluded, o.shippingpoint, o.shipvia, o.notes, o.intnotes,
......
JOIN $form->{vc} cv ON (o.$form->{vc}_id = cv.id)
LEFT JOIN employee e ON (o.employee_id = e.id)
LEFT JOIN department d ON (o.department_id = d.id)
|. ($form->{id}
? qq|WHERE o.id = $form->{id}|
: qq|WHERE o.id IN (|.join(', ', @ids).qq|)|
);
|
. ($form->{id}
? qq|WHERE o.id = $form->{id}|
: qq|WHERE o.id IN (| . join(', ', @ids) . qq|)|);
#$main::lxdebug->message(0, $query);
#$main::lxdebug->message(0, $query);
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
......
}
# if not given, fill transdate with current_date
$form->{transdate} = $form->current_date($myconfig) unless $form->{transdate};
$form->{transdate} = $form->current_date($myconfig)
unless $form->{transdate};
$sth->finish;
# shipto and pinted/mailed/queued status makes only sense for single id retrieve
# shipto and pinted/mailed/queued status makes only sense for single id retrieve
if (!@ids) {
$query = qq|SELECT s.* FROM shipto s
WHERE s.trans_id = $form->{id}|;
......
while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
$form->{printed} .= "$ref->{formname} " if $ref->{printed};
$form->{emailed} .= "$ref->{formname} " if $ref->{emailed};
$form->{queued} .= "$ref->{formname} $ref->{spoolfile} " if $ref->{spoolfile};
$form->{queued} .= "$ref->{formname} $ref->{spoolfile} "
if $ref->{spoolfile};
}
$sth->finish;
map { $form->{$_} =~ s/ +$//g } qw(printed emailed queued);
} # if !@ids
} # if !@ids
my %oid = ('Pg' => 'oid',
'Oracle' => 'rowid');
......
LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id)
LEFT JOIN project pr ON (o.project_id = pr.id)
LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
|. ($form->{id}
? qq|WHERE o.trans_id = $form->{id}|
: qq|WHERE o.trans_id IN (|.join(", ", @ids).qq|)|
).qq|
|
. ($form->{id}
? qq|WHERE o.trans_id = $form->{id}|
: qq|WHERE o.trans_id IN (| . join(", ", @ids) . qq|)|)
. qq|
ORDER BY o.$oid{$myconfig->{dbdriver}}|;
$sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
# in collective order, copy global ordnumber, transdate, cusordnumber into item scope
# unless already present there
# unless already present there
# remove _oe entries afterwards
map { $ref->{$_} = $ref->{"${_}_oe"} if ($ref->{$_} eq '') }
qw|ordnumber transdate cusordnumber| if (@ids);
map{ delete $ref->{$_} }
qw|ordnumber_oe transdate_oe cusordnumber_oe|;
qw|ordnumber transdate cusordnumber|
if (@ids);
map { delete $ref->{$_} } qw|ordnumber_oe transdate_oe cusordnumber_oe|;
#set expense_accno=inventory_accno if they are different => bilanz
$vendor_accno =
......
$dec = length $dec;
my $decimalplaces = ($dec > 2) ? $dec : 2;
my $i_discount = $form->round_amount($sellprice *
$form->parse_amount($myconfig, $form->{"discount_$i"}) / 100, $decimalplaces);
my $i_discount =
$form->round_amount(
$sellprice * $form->parse_amount($myconfig,
$form->{"discount_$i"}) / 100,
$decimalplaces);
my $discount = $form->round_amount($form->{"qty_$i"} * $i_discount, $decimalplaces);
my $discount =
$form->round_amount($form->{"qty_$i"} * $i_discount, $decimalplaces);
# keep a netprice as well, (sellprice - discount)
#$form->{"netprice_$i"} = $sellprice - $discount;
......
: " ";
$linetotal = ($linetotal != 0) ? $linetotal : " ";
push(@{ $form->{discount} }, $discount);
push(@{ $form->{discount} }, $discount);
push(@{ $form->{p_discount} }, $form->{"discount_$i"});
$form->{ordtotal} += $linetotal;
......
}
}
$tax_rate = $taxrate*100;
$tax_rate = $taxrate * 100;
push(@{ $form->{tax_rate} }, qq|$tax_rate|);
if ($form->{"assembly_$i"}) {
SL/RP.pm
package RP;
sub balance_sheet {
$main::lxdebug->enter_sub();
......
my @accno;
my $accno;
my $ref;
#print $query;
my $sth = $dbh->prepare($query);
$sth->execute || $form->dberror($query);
......
my $sortorder = join ', ',
$form->sort_columns(qw(name invnumber ordnumber transdate source));
$sortorder = $form->{sort} if $form->{sort};
$sortorder = $form->{sort} if $form->{sort};
# cycle through each id
foreach my $accno (split(/ /, $form->{paymentaccounts})) {
......
$form->{ "$key" . "gesamtleistung" } = 0;
$form->{ "$key" . "gesamtkosten" } = 0;
foreach $category (@categories) {
if (defined($form->{$category}{$key})) {
$form->{"$key$category"} =
$form->format_amount($myconfig,
$form->round_amount($form->{$category}{$key}, 2
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@gesamtleistung) {
......
$form->{ "$key" . "ergebnisvorsteuern" } =
$form->{ "$key" . "betriebsergebnis" } -
$form->{ "$key" . "neutraleraufwand" } +
$form->{ "$key" . "neutralertrag" };
$form->{ "$key" . "neutralertrag" };
$form->{ "$key" . "ergebnis" } =
$form->{ "$key" . "ergebnisvorsteuern" } + $form->{35}{$key};
......
$form->{ "$key" . "gesamtleistung" } * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@ergebnisse) {
......
$form->{ "$key" . "gesamtleistung" } * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
......
$form->{ "$key" . "gesamtkosten" } * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@ergebnisse) {
......
$form->{ "$key" . "gesamtkosten" } * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
......
if (defined($form->{$category}{$key})) {
$form->{ "$key" . "pk" . "$category" } =
$form->format_amount(
$myconfig,
$form->round_amount(
($form->{$category}{$key} / $form->{10}{$key} * 100),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
$myconfig,
$form->round_amount(
($form->{$category}{$key} / $form->{10}{$key} * 100),
$form->{decimalplaces}
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@ergebnisse) {
......
$form->{10}{$key} * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
......
if (defined($form->{$category}{$key})) {
$form->{ "$key" . "auf" . "$category" } =
$form->format_amount(
$myconfig,
$form->round_amount(
($form->{$category}{$key} / $form->{4}{$key} * 100),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
$myconfig,
$form->round_amount(
($form->{$category}{$key} / $form->{4}{$key} * 100),
$form->{decimalplaces}
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@ergebnisse) {
......
$form->{4}{$key} * 100
),
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
),
$form->{decimalplaces},
'0');
}
}
foreach $item (@ergebnisse) {
$form->{ "$key" . "$item" } =
$form->format_amount($myconfig,
$form->round_amount($form->{ "$key" . "$item" },
$form->{decimalplaces}
), $form->{decimalplaces}, '0');
$form->round_amount($form->{ "$key" . "$item" },
$form->{decimalplaces}
),
$form->{decimalplaces},
'0');
}
}
......
my $last_period = 0;
my $category = "pos_ustva";
my @categories_cent = qw(51r 511 86r 861 97r 971 93r 931
96 66 43 45 53 62 65 67);
96 66 43 45 53 62 65 67);
my @categories_euro = qw(48 51 86 91 97 93 94);
$form->{decimalplaces} *= 1;
......
# }
#
# }
#
# Berechnung der USTVA Formularfelder
#
......
$form->{"86r"} = $form->{"861"};
$form->{"97r"} = $form->{"971"};
$form->{"93r"} = $form->{"931"};
#$form->{"96"} = $form->{"94"} * 0.16;
$form->{"43"} =
$form->{"43"} =
$form->{"51r"} + $form->{"86r"} + $form->{"97r"} + $form->{"93r"} +
$form->{"96"};
$form->{"45"} = $form->{"43"};
......
foreach $item (@categories_cent) {
$form->{$item} =
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 2), 2, '0');
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 2),
2, '0');
}
foreach $item (@categories_euro) {
$form->{$item} =
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 0), 0, '0');
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 0),
0, '0');
}
$dbh->disconnect;
SL/USTVA.pm
$elster_land_fa{$FFFF} = $elster_init->{$elster_land}->{$FFFF}->[0];
}
foreach $ffff (sort { $elster_land_fa{$a} cmp $elster_land_fa{$b} }
keys(%elster_land_fa)) {
keys(%elster_land_fa)
) {
print qq|
elsterFAAuswahl.options[$j] = new Option("$elster_land_fa{$ffff} ($ffff)","$ffff");|;
$j++;
......
print qq|<option value="Auswahl" $checked>hier ausw?hlen...</option>|;
} else {
foreach $ffff (sort { $elster_land_fa{$a} cmp $elster_land_fa{$b} }
keys(%elster_land_fa)) {
keys(%elster_land_fa)
) {
print qq|
<option value="$ffff"|;
......
$main::lxdebug->leave_sub();
}
sub ustva {
$main::lxdebug->enter_sub();
......
my $last_period = 0;
my $category = "pos_ustva";
my @categories_cent = qw(511 861 36 80 971 931 98 96 53 74
85 65 66 61 62 67 63 64 59 69 39 83
Z43 Z45 Z53 Z62 Z65 Z67);
my @categories_euro = qw(41 44 49 43 48 51 86 35 77 76 91 97 93
95 94 42 60 45 52 73 84);
my @categories_cent = qw(511 861 36 80 971 931 98 96 53 74
85 65 66 61 62 67 63 64 59 69 39 83
Z43 Z45 Z53 Z62 Z65 Z67);
my @categories_euro = qw(41 44 49 43 48 51 86 35 77 76 91 97 93
95 94 42 60 45 52 73 84);
$form->{decimalplaces} *= 1;
......
$form->{"$item"} = 0;
}
&get_accounts_ustva($dbh, $last_period, $form->{fromdate}, $form->{todate},
$form, $category);
$form, $category);
#
# Berechnung der USTVA Formularfelder
......
$form->{"86r"} = $form->{"861"};
$form->{"97r"} = $form->{"971"};
$form->{"93r"} = $form->{"931"};
$form->{"Z43"} = $form->{"511"}+ $form->{"861"} +
$form->{"36"} + $form->{"80"} +
$form->{"971"}+ $form->{"931"} +
$form->{"96"} + $form->{"98"};
$form->{"Z43"} =
$form->{"511"} + $form->{"861"} + $form->{"36"} + $form->{"80"} +
$form->{"971"} + $form->{"931"} + $form->{"96"} + $form->{"98"};
$form->{"Z45"} = $form->{"Z43"};
$form->{"Z53"} = $form->{"Z43"};
$form->{"Z62"} = $form->{"Z43"}- $form->{"66"} -
$form->{"61"} - $form->{"62"} -
$form->{"63"} - $form->{"64"} -
$form->{"59"};
$form->{"Z65"} = $form->{"Z62"}- $form->{"69"};
$form->{"83"} = $form->{"Z65"}- $form->{"39"};
$form->{"Z62"} =
$form->{"Z43"} - $form->{"66"} - $form->{"61"} - $form->{"62"} -
$form->{"63"} - $form->{"64"} - $form->{"59"};
$form->{"Z65"} = $form->{"Z62"} - $form->{"69"};
$form->{"83"} = $form->{"Z65"} - $form->{"39"};
foreach $item (@categories_cent) {
$form->{$item} =
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 2), 2, '0');
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 2),
2, '0');
}
foreach $item (@categories_euro) {
$form->{$item} =
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 0), 0, '0');
$form->format_amount($myconfig, $form->round_amount($form->{$item}, 0),
0, '0');
}
$dbh->disconnect;
......
my $where = "1 = 1";
my $glwhere = "";
my $subwhere = "";
my $ARwhere = "";
my $arwhere = "";
my $ARwhere = "";
my $arwhere = "";
my $item;
if ($fromdate) {
... Dieser Diff wurde abgeschnitten, weil er die maximale Anzahl anzuzeigender Zeilen überschreitet.

Auch abrufbar als: Unified diff