Revision 3d967be3
Von Sven Schöling vor etwa 15 Jahren hinzugefügt
| SL/AR.pm | ||
|---|---|---|
| 38 | 38 |
use SL::DBUtils; |
| 39 | 39 |
use SL::MoreCommon; |
| 40 | 40 |
|
| 41 |
use strict; |
|
| 42 |
|
|
| 41 | 43 |
our (%myconfig, $form); |
| 42 | 44 |
|
| 43 | 45 |
sub post_transaction {
|
| ... | ... | |
| 252 | 254 |
$amount = $form->round_amount( $form->{"paid_$i"} * ($form->{exchangerate} - $form->{"exchangerate_$i"}) * -1, 2);
|
| 253 | 255 |
|
| 254 | 256 |
if ($amount != 0) {
|
| 255 |
$accno = ($amount > 0) ? $form->{fxgain_accno} : $form->{fxloss_accno};
|
|
| 257 |
my $accno = ($amount > 0) ? $form->{fxgain_accno} : $form->{fxloss_accno};
|
|
| 256 | 258 |
$query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, fx_transaction, cleared, project_id, taxkey) |
| 257 | 259 |
VALUES (?, (SELECT id FROM chart WHERE accno = ?), ?, ?, 't', 'f', ?, (SELECT taxkey_id FROM chart WHERE accno = ?))|; |
| 258 | 260 |
@values = (conv_i($form->{id}), $accno, $amount, conv_date($form->{"datepaid_$i"}), $project_id, $accno);
|
| ... | ... | |
| 524 | 526 |
|
| 525 | 527 |
my ($self, $form) = @_; |
| 526 | 528 |
|
| 527 |
my ($exchangerate, $key, $akey, $i, $j, $k, $index, $taxamount, $totaltax, $taxrate, $diff); |
|
| 529 |
my ($exchangerate, $key, $akey, $i, $j, $k, $index, $taxamount, $totaltax, $taxrate, $diff, $totalwithholding, $withholdingrate, |
|
| 530 |
$totalamount, $taxincluded, $tax); |
|
| 528 | 531 |
|
| 529 | 532 |
# forex |
| 530 | 533 |
$form->{forex} = $form->{exchangerate};
|
| SL/DBUtils.pm | ||
|---|---|---|
| 12 | 12 |
create_sort_spec does_table_exist |
| 13 | 13 |
add_token); |
| 14 | 14 |
|
| 15 |
use strict; |
|
| 16 |
|
|
| 15 | 17 |
sub conv_i {
|
| 16 | 18 |
my ($value, $default) = @_; |
| 17 | 19 |
return (defined($value) && "$value" ne "") ? $value * 1 : $default; |
| SL/InstallationCheck.pm | ||
|---|---|---|
| 5 | 5 |
|
| 6 | 6 |
use vars qw(@required_modules @optional_modules); |
| 7 | 7 |
|
| 8 |
use strict; |
|
| 9 |
|
|
| 8 | 10 |
@required_modules = ( |
| 9 | 11 |
{ "name" => "Class::Accessor", "url" => "http://search.cpan.org/~kasei/" },
|
| 10 | 12 |
{ "name" => "CGI", "url" => "http://search.cpan.org/~lds/" },
|
| SL/PE.pm | ||
|---|---|---|
| 38 | 38 |
|
| 39 | 39 |
use SL::DBUtils; |
| 40 | 40 |
|
| 41 |
use strict; |
|
| 42 |
|
|
| 41 | 43 |
sub partsgroups {
|
| 42 | 44 |
$main::lxdebug->enter_sub(); |
| 43 | 45 |
|
| ... | ... | |
| 90 | 92 |
$form->{discount} /= 100;
|
| 91 | 93 |
|
| 92 | 94 |
my @values = ($form->{partsgroup});
|
| 95 |
my $query; |
|
| 93 | 96 |
|
| 94 | 97 |
if ($form->{id}) {
|
| 95 | 98 |
$query = qq|UPDATE partsgroup SET partsgroup = ? WHERE id = ?|; |
| ... | ... | |
| 119 | 122 |
qq|WHERE pg.id = ?|; |
| 120 | 123 |
my $sth = prepare_execute_query($form, $dbh, $query, $form->{id},
|
| 121 | 124 |
$form->{id});
|
| 122 |
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
|
| 125 |
my $ref = $sth->fetchrow_hashref("NAME_lc");
|
|
| 123 | 126 |
|
| 124 | 127 |
map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
|
| 125 | 128 |
$sth->finish; |
| ... | ... | |
| 139 | 142 |
|
| 140 | 143 |
my $table = $form->{type} eq "pricegroup" ? "pricegroup" : "partsgroup";
|
| 141 | 144 |
|
| 142 |
$query = qq|DELETE FROM $table WHERE id = ?|; |
|
| 145 |
my $query = qq|DELETE FROM $table WHERE id = ?|;
|
|
| 143 | 146 |
do_query($form, $dbh, $query, $form->{id});
|
| 144 | 147 |
|
| 145 | 148 |
$dbh->disconnect; |
| ... | ... | |
| 240 | 243 |
|
| 241 | 244 |
my $query = qq|SELECT id, pricegroup FROM pricegroup WHERE id = ?|; |
| 242 | 245 |
my $sth = prepare_execute_query($form, $dbh, $query, $form->{id});
|
| 243 |
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
|
| 246 |
my $ref = $sth->fetchrow_hashref("NAME_lc");
|
|
| 244 | 247 |
|
| 245 | 248 |
map({ $form->{$_} = $ref->{$_} } keys(%{$ref}));
|
| 246 | 249 |
|
| SL/User.pm | ||
|---|---|---|
| 34 | 34 |
|
| 35 | 35 |
package User; |
| 36 | 36 |
|
| 37 |
#use strict; |
|
| 38 |
|
|
| 39 | 37 |
use IO::File; |
| 40 | 38 |
use Fcntl qw(:seek); |
| 41 | 39 |
|
| ... | ... | |
| 45 | 43 |
use SL::Iconv; |
| 46 | 44 |
use SL::Inifile; |
| 47 | 45 |
|
| 46 |
use strict; |
|
| 47 |
|
|
| 48 | 48 |
sub new {
|
| 49 | 49 |
$main::lxdebug->enter_sub(); |
| 50 | 50 |
|
| ... | ... | |
| 107 | 107 |
my $dbh = |
| 108 | 108 |
DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
|
| 109 | 109 |
$myconfig{dbpasswd})
|
| 110 |
or $self->error(DBI::errstr); |
|
| 110 |
or $self->error($DBI::errstr);
|
|
| 111 | 111 |
|
| 112 | 112 |
# we got a connection, check the version |
| 113 | 113 |
my $query = qq|SELECT version FROM defaults|; |
| ... | ... | |
| 802 | 802 |
last if ($version < $mindb); |
| 803 | 803 |
|
| 804 | 804 |
# apply upgrade |
| 805 |
$main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $upgradescript");
|
|
| 805 |
$main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
|
|
| 806 | 806 |
if ($file_type eq "sql") {
|
| 807 | 807 |
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
| 808 | 808 |
"-upgrade/$upgradescript", $str_maxdb, $db_charset); |
| ... | ... | |
| 886 | 886 |
my $file_type = $1; |
| 887 | 887 |
|
| 888 | 888 |
# apply upgrade |
| 889 |
$main::lxdebug->message(LXDebug::DEBUG2, "Applying Update $control->{file}");
|
|
| 889 |
$main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
|
|
| 890 | 890 |
print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
|
| 891 | 891 |
|
| 892 | 892 |
if ($file_type eq "sql") {
|
Auch abrufbar als: Unified diff
weitere stricts