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