Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision e6e11400

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

  • ID e6e114003a61eeb9769443051ec0192ec5d856a9
  • Vorgänger 9bb140df
  • Nachfolger ed915d11

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
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