Revision 30b348e0
Von Jan Büren vor etwa 2 Jahren hinzugefügt
SL/Form.pm | ||
---|---|---|
1423 | 1423 |
sub update_exchangerate { |
1424 | 1424 |
$main::lxdebug->enter_sub(); |
1425 | 1425 |
|
1426 |
my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; |
|
1427 |
my ($query); |
|
1428 |
# some sanity check for currency |
|
1429 |
if ($curr eq '') { |
|
1430 |
$main::lxdebug->leave_sub(); |
|
1431 |
return; |
|
1432 |
} |
|
1433 |
$query = qq|SELECT name AS curr FROM currencies WHERE id=(SELECT currency_id FROM defaults)|; |
|
1426 |
validate_pos(@_, |
|
1427 |
{ isa => 'Form'}, |
|
1428 |
{ isa => 'DBI::db'}, |
|
1429 |
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217) |
|
1430 |
{ type => SCALAR, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numers |
|
1431 |
{ type => SCALAR, callbacks => { is_null_or_digit => sub { shift =~ m/(^0$|\d+)/ } } }, # value buy fxrate |
|
1432 |
{ type => SCALAR, callbacks => { is_null_or_digit => sub { shift =~ m/(^0$|\d+)/ } } }, # value sell fxrate |
|
1433 |
{ type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 }, |
|
1434 |
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap|bank_transactions)/ } }, optional => 1 } |
|
1435 |
); |
|
1434 | 1436 |
|
1435 |
my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
|
|
1437 |
my ($self, $dbh, $curr, $transdate, $buy, $sell, $id, $record_table) = @_;
|
|
1436 | 1438 |
|
1437 |
if ($curr eq $defaultcurrency) { |
|
1439 |
# record has a exchange rate and should be updated |
|
1440 |
if ($record_table && $id) { |
|
1441 |
do_query($self, $dbh, qq|UPDATE $record_table SET exchangerate = ? WHERE id = ?|, $buy || $sell, $id); |
|
1438 | 1442 |
$main::lxdebug->leave_sub(); |
1439 | 1443 |
return; |
1440 | 1444 |
} |
1441 | 1445 |
|
1446 |
my ($query); |
|
1442 | 1447 |
$query = qq|SELECT e.currency_id FROM exchangerate e |
1443 | 1448 |
WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ? |
1444 | 1449 |
FOR UPDATE|; |
... | ... | |
1464 | 1469 |
} |
1465 | 1470 |
|
1466 | 1471 |
if ($sth->fetchrow_array) { |
1472 |
die "this never happens never"; |
|
1467 | 1473 |
$query = qq|UPDATE exchangerate |
1468 | 1474 |
SET $set |
1469 | 1475 |
WHERE currency_id = (SELECT id FROM currencies WHERE name = ?) |
... | ... | |
1482 | 1488 |
sub check_exchangerate { |
1483 | 1489 |
$main::lxdebug->enter_sub(); |
1484 | 1490 |
|
1485 |
my $self = shift; |
|
1486 | 1491 |
validate_pos(@_, |
1492 |
{ isa => 'Form'}, |
|
1487 | 1493 |
{ type => HASHREF, callbacks => { has_yy_in_dateformat => sub { $_[0]->{dateformat} =~ m/yy/ } } }, |
1488 |
{ type => SCALAR }, # should be ISO three letter codes for currency identification (ISO 4217)
|
|
1494 |
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
|
|
1489 | 1495 |
{ type => SCALAR, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numers |
1490 | 1496 |
{ type => SCALAR, callbacks => { is_buy_or_sell_rate => sub { shift =~ m/^buy|sell$/ } } }, |
1497 |
{ type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 }, |
|
1498 |
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap|bank_transactions)/ } }, optional => 1 } |
|
1491 | 1499 |
); |
1492 |
my ($myconfig, $currency, $transdate, $fld) = @_;
|
|
1500 |
my ($self, $myconfig, $currency, $transdate, $fld, $id, $record_table) = @_;
|
|
1493 | 1501 |
|
1494 |
my ($defaultcurrency) = $self->get_default_currency($myconfig); |
|
1495 |
if ($currency eq $defaultcurrency) { |
|
1496 |
$main::lxdebug->leave_sub(); |
|
1497 |
return 1; |
|
1502 |
my $dbh = $self->get_standard_dbh($myconfig); |
|
1503 |
|
|
1504 |
# callers wants a check if record has a exchange rate and should be fetched instead |
|
1505 |
if ($record_table && $id) { |
|
1506 |
my ($record_exchange_rate) = selectrow_query($self, $dbh, qq|SELECT exchangerate FROM $record_table WHERE id = ?|, $id); |
|
1507 |
if ($record_exchange_rate) { |
|
1508 |
|
|
1509 |
$main::lxdebug->leave_sub(); |
|
1510 |
|
|
1511 |
return $record_exchange_rate; |
|
1512 |
} |
|
1498 | 1513 |
} |
1499 | 1514 |
|
1500 |
my $dbh = $self->get_standard_dbh($myconfig);
|
|
1515 |
# fetch default from exchangerate table
|
|
1501 | 1516 |
my $query = qq|SELECT e.$fld FROM exchangerate e |
1502 | 1517 |
WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|; |
1503 | 1518 |
|
... | ... | |
3518 | 3533 |
Returns undef if no save operation has been done yet ($self->{id} not present). |
3519 | 3534 |
Returns undef if no concurrent write process is detected otherwise a error message. |
3520 | 3535 |
|
3536 |
=back |
|
3537 |
|
|
3538 |
=over 4 |
|
3539 |
|
|
3540 |
=item C<check_exchangerate> $myconfig, $currency, $transdate, $fld, $id, $record_table |
|
3541 |
|
|
3542 |
Needs a local myconfig, a currency string, a date of the transaction, a field (fld) which |
|
3543 |
has to be either the buy or sell exchangerate and checks if there is already a buy or |
|
3544 |
sell exchangerate for this date. |
|
3545 |
Returns 0 or (NULL) if no entry is found or the already stored exchangerate. |
|
3546 |
If the optional parameter id and record_table is passed, the method tries to look up |
|
3547 |
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions. |
|
3548 |
If none is found the default (daily) entry will be checked. |
|
3549 |
The method is very strict about the parameters and tries to fail if anything does |
|
3550 |
not look like the expected type. |
|
3551 |
|
|
3552 |
=item C<update_exchangerate> $dbh, $curr, $transdate, $buy, $sell, $id, $record_table |
|
3553 |
|
|
3554 |
Needs a dbh connection, a currency string, a date of the transaction, buy (0|1), sell (0|1) which |
|
3555 |
determines if either the buy or sell or both exchangerates should be updated and updates |
|
3556 |
the exchangerate for this currency for this date. |
|
3557 |
If the optional parameter id and record_table is passed, the method saves |
|
3558 |
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions. |
|
3559 |
|
|
3560 |
The method is very strict about the parameters and tries to fail if anything does not look |
|
3561 |
like the expected type. |
|
3562 |
|
|
3563 |
|
|
3564 |
|
|
3565 |
|
|
3521 | 3566 |
=back |
3522 | 3567 |
|
3523 | 3568 |
=cut |
Auch abrufbar als: Unified diff
Form: update_exchangerate, check_exchangerate um Belegwechselkurs erw.
Ferner POD, strikte Parameter-Überprüfung und Verdacht auf
weiteren ungenutzen Code hinzugefügt.