Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 30b348e0

Von Jan Büren vor etwa 2 Jahren hinzugefügt

  • ID 30b348e06a999d8f65f1b171be74f7416697092c
  • Vorgänger 50df1983
  • Nachfolger 9aa4d575

Form: update_exchangerate, check_exchangerate um Belegwechselkurs erw.

Ferner POD, strikte Parameter-Überprüfung und Verdacht auf
weiteren ungenutzen Code hinzugefügt.

Unterschiede anzeigen:

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