SelfTests

Es gibt jetzt ein Grundgerüst um Selbsttests durchzuführen, und bei Problemen
einen Administrator per Mail zu benachrichtigen. Die Selbsttests werden Über
das SelfTest Modul für den Taskserver verwaltet, und in config/lx_office.conf
im Block [self_test] konfiguriert. Die Tests werden in TAP ausgeliefert und
können bei Bedarf weiter maschinell ausgewertet werden.

Weitere Tests können von SL::BackgroundJob::SelfTest::Base abgeleitet werden.

Zur Demonstration gibt es einen Selbsttest Transactions, der die Datenbank
auf Fehlbuchungen untersucht.

diff --git a/SL/BackgroundJob/SelfTest.pm b/SL/BackgroundJob/SelfTest.pm
new file mode 100644 (file)
index 0000000..241a995
--- /dev/null
+++ b/SL/BackgroundJob/SelfTest.pm
@@ -0,0 +1,193 @@
+package SL::BackgroundJob::SelfTest;
+
+use strict;
+
+use parent qw(SL::BackgroundJob::Base);
+
+use Test::Builder;
+use TAP::Parser;
+use TAP::Parser::Aggregator;
+use Sys::Hostname;
+use FindBin;
+
+use SL::DB::AuthUser;
+use SL::Common;
+
+use Rose::Object::MakeMethods::Generic (
+  array => [
+   'modules'     => {},
+   'add_modules' => { interface => 'add', hash_key => 'modules' },
+   'errors'      => {},
+   'add_errors'  => { interface => 'add', hash_key => 'errors' },
+   'full_diag'      => {},
+   'add_full_diag'  => { interface => 'add', hash_key => 'full_diag' },
+  ],
+  scalar => [
+   qw(diag tester config aggreg),
+  ],
+);
+
+sub create_job {
+  $_[0]->create_standard_job('20 2 * * *'); # every day at 2:20 am
+}
+
+sub setup {
+  my ($self) = @_;
+
+  $self->config($::lx_office_conf{self_test} || {});
+
+  $self->tester(Test::Builder->new);
+  $self->aggreg(TAP::Parser::Aggregator->new);
+
+  $self->modules(split /\s+/, $self->config->{modules});
+}
+
+sub run {
+  my $self        = shift;
+  $self->setup;
+
+  return 1 unless $self->modules;
+
+  foreach my $module ($self->modules) {
+    $self->run_module($module);
+  }
+
+  $self->log(
+    sprintf "SelfTest status: %s, passed: %s, failed: %s, unexpectedly succeeded: %s",
+             $self->aggreg->get_status,
+             $self->aggreg->passed,
+             $self->aggreg->failed,
+             $self->aggreg->todo_passed,
+  );
+
+  if (!$self->aggreg->all_passed || $self->config->{send_email_on_success}) {
+    $self->_send_email;
+  }
+
+  return 1;
+}
+
+sub run_module {
+  my ($self, $module) = @_;
+
+  # TAP usually prints out to STDOUT and STDERR, capture those for TAP::Parser
+  my $output;
+
+  $self->tester->output        (\$output);
+  $self->tester->failure_output(\$output);
+  $self->tester->todo_output   (\$output);
+
+  # sanitize module name;
+  # this allows unicode package names, which are known to be buggy in 5.10, you should avoid them
+  $module =~ s/[^\w:]//g;
+  $module = "SL::BackgroundJob::SelfTest::$module";
+
+  # try to load module;
+  (my $file = $module) =~ s|::|/|g;
+  eval {
+    require $file . '.pm';
+    1
+  } or $self->add_errors($::locale->text('Could not load class #1 (#2): "#3"', $module, $file, $@)) && return;
+
+  eval {
+    my $worker = $module->new;
+    $worker->tester($self->tester);
+
+    $worker->run;
+    1;
+  } or $self->add_errors($::locale->text('Could not load class #1, #2', $module, $@)) && return;
+
+  $self->add_full_diag($output);
+  $self->{diag_per_module}{$module} = $output;
+
+  my $parser = TAP::Parser->new({ tap => $output});
+  $parser->run;
+
+  $self->aggreg->add($module => $parser);
+}
+
+sub _email_user {
+  $_[0]{email_user} ||= SL::DB::Manager::AuthUser->find_by(login => $_[0]->config->{send_email_to});
+}
+
+sub _send_email {
+  my ($self) = @_;
+
+  return if !$self->config || !$self->config->{send_email_to};
+
+  my $user  = $self->_email_user;
+  my $email = $user ? $user->get_config_value('email') : undef;
+
+  return unless $email;
+
+  my ($output, $content_type) = $self->_prepare_report;
+
+  my $mail              = Mailer->new(charset => $::locale->is_utf8 ? 'UTF-8' : Common->DEFAULT_CHARSET );
+  $mail->{from}         = $self->config->{email_from};
+  $mail->{to}           = $email;
+  $mail->{subject}      = $self->config->{email_subject};
+  $mail->{content_type} = $content_type;
+  $mail->{message}      = $$output;
+
+  $mail->send;
+}
+
+sub _prepare_report {
+  my ($self) = @_;
+
+  my $user = $self->_email_user;
+  my $template = Template->new({ 'INTERPOLATE' => 0,
+                                 'EVAL_PERL'   => 0,
+                                 'ABSOLUTE'    => 1,
+                                 'CACHE_SIZE'  => 0,
+                               });
+
+  return unless $template;
+  my $email_template = $self->config->{email_template};
+  my $filename       = $email_template || ( ($user->get_config_value('templates') || "templates/mails") . "/self_test/status_mail.txt" );
+  my $content_type   = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
+
+
+  my %params = (
+    SELF     => $self,
+    host     => hostname,
+    database => $::myconfig{dbname},
+    path     => $FindBin::Bin,
+  );
+
+  my $output;
+  $template->process($filename, \%params, \$output) || die $template->error;
+
+  return (\$output, $content_type);
+}
+
+sub log {
+  my $self = shift;
+  $::lxdebug->message(0, "[" . __PACKAGE__ . "] @_") if $self->config->{log_to_file};
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::BackgroundJob::TelfTests - pluggable self testing
+
+=head1 SYNOPSIS
+
+  use SL::BackgroundJob::SelfTests;
+  SL::BackgroundJob::SelfTests->new->run;;
+
+=head1 DESCRIPTION
+
+
+
+=head1 FUNCTIONS
+
+=head1 BUGS
+
+=head1 AUTHOR
+
+=cut

diff --git a/SL/BackgroundJob/SelfTest/Base.pm b/SL/BackgroundJob/SelfTest/Base.pm
new file mode 100644 (file)
index 0000000..f790137
--- /dev/null
+++ b/SL/BackgroundJob/SelfTest/Base.pm
@@ -0,0 +1,100 @@
+package SL::BackgroundJob::SelfTest::Base;
+
+use Test::Builder;
+
+use parent qw(Rose::Object);
+
+use Rose::Object::MakeMethods::Generic (
+  'scalar --get_set_init' => 'tester',
+);
+
+sub run {
+  my ($self) = @_;
+  die 'needs to be overwritten';
+}
+
+sub todo {
+  0
+}
+
+sub skipped {
+  0
+}
+
+
+sub init_tester {
+  Test::Builder->new;
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::BackgroundJob::SelfTests::Base - Base class for background job self tests.
+
+=head1 SYNOPSIS
+
+  # in self test:
+  use parent qw(SL::BackgroundJob::SelfTests::Base);
+
+  # optionally use a different tester
+  sub init_tester {
+    Test::Deeply->new;
+  }
+
+  # implement interface
+  sub run {
+    my $self = shift;
+
+    $self->tester->plan(tests => 1);
+
+    $self->tester->ok($value_from_database == $expected_value, 'short explanation');
+  }
+
+=head1 DESCRIPTION
+
+This is a base class for self tests.
+
+=head1 INTERFACE
+
+Your class will inherit L<Rose::Object> so you can use the class building utils
+from there, and won't need to worry about writing a new constructor.
+
+Your test will be instanciated and the run method will be invoked. The output
+of your tester object will be collected and processed.
+
+=head2 THE TESTER
+
+=over 4
+
+=item E<tester>
+
+=item E<init_tester>
+
+If you don't bother overriding E<init_tester>, your test will use a
+L<Test::More> object by default. Any other L<Test::Builder> object will do.
+
+The TAP output of your builder will be collected and processed for further handling.
+
+=back
+
+=head1 ERROR HANDLING
+
+If a self test module dies, it will be recorded as failed, and the bubbled
+exception will be used as diagnosis.
+
+=head1 TODO
+
+It is currently not possible to indicate if a test skipped (indicating no actual testing was done but it wasn't an error) nor returning a todo status (indicating that the test failed, but that being ok, because it's a todo).
+
+Stub methods "todo" and "skipped" exist, but are currently not used.
+
+=head1 AUTHOR
+
+Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut

diff --git a/SL/BackgroundJob/SelfTest/Transactions.pm b/SL/BackgroundJob/SelfTest/Transactions.pm
new file mode 100644 (file)
index 0000000..a3000c2
--- /dev/null
+++ b/SL/BackgroundJob/SelfTest/Transactions.pm
@@ -0,0 +1,399 @@
+package SL::BackgroundJob::SelfTest::Transactions;
+
+use utf8;
+use strict;
+use parent qw(SL::BackgroundJob::SelfTest::Base);
+
+use SL::DBUtils;
+
+use Rose::Object::MakeMethods::Generic (
+  scalar => [ qw(dbh fromdate todate) ],
+);
+
+sub run {
+  my ($self) = @_;
+
+  $self->_setup;
+
+  $self->tester->plan(tests => 14);
+
+  $self->check_konten_mit_saldo_nicht_in_guv;
+  $self->check_balanced_individual_transactions;
+  $self->check_verwaiste_acc_trans_eintraege;
+  $self->check_netamount_laut_invoice_ar;
+  $self->check_invnumbers_unique;
+  $self->check_summe_stornobuchungen;
+  $self->check_ar_paid;
+  $self->check_ap_paid;
+  $self->check_ar_overpayments;
+  $self->check_ap_overpayments;
+  $self->check_paid_stornos;
+  $self->check_stornos_ohne_partner;
+  $self->check_overpayments;
+  $self->calc_saldenvortraege;
+}
+
+sub _setup {
+  my ($self) = @_;
+
+  # TODO FIXME calc dates better, unless this is wanted
+  $self->fromdate(DateTime->new(day => 1, month => 1, year => DateTime->today->year));
+  $self->todate($self->fromdate->clone->add(years => 1)->add(days => -1));
+
+  $self->dbh($::form->get_standard_dbh);
+}
+
+sub check_konten_mit_saldo_nicht_in_guv {
+  my ($self) = @_;
+
+  my $query = qq|
+    SELECT c.accno, c.description, c.category, SUM(a.amount) AS Saldo
+    FROM chart c,
+         acc_trans a
+    WHERE c.id = a.chart_id
+     and  (c.category like 'I' or c.category like 'E')
+     and  amount != 0
+     and  pos_eur is null
+         and  a.transdate >= ? and a.transdate <= ?
+    GROUP BY c.accno,c.description,c.category,c.pos_bilanz,c.pos_eur
+    ORDER BY c.accno|;
+
+  my $konten_nicht_in_guv =  selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $correct = 0 == scalar grep { $_->{Saldo} } @$konten_nicht_in_guv;
+
+  $self->tester->ok($correct, "Erfolgskonten mit Saldo nicht in GuV (Saldenvortragskonten können ignoriert werden, sollten aber 0 sein)");
+  if (!$correct) {
+    for my $konto (@$konten_nicht_in_guv) {
+      $self->tester->diag($konto);
+    }
+  }
+}
+
+sub check_balanced_individual_transactions {
+  my ($self) = @_;
+
+  my $query = qq|
+    select sum(ac.amount) as amount,trans_id,ar.invnumber as ar,ap.invnumber as ap,gl.reference as gl
+      from acc_trans ac
+      left join ar on (ar.id = ac.trans_id)
+      left join ap on (ap.id = ac.trans_id)
+      left join gl on (gl.id = ac.trans_id)
+    where ac.transdate >= ? AND ac.transdate <= ?
+    group by trans_id,ar.invnumber,ap.invnumber,gl.reference
+    having sum(ac.amount) != 0;|;
+
+  my $acs = selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+  if (@$acs) {
+    $self->tester->ok(0, "Es gibt unausgeglichene acc_trans-Transaktionen:");
+    for my $ac (@{ $acs }) {
+      $self->tester->diag("trans_id: $ac->{trans_id},  amount = $ac->{amount}, ar: $ac->{ar} ap: $ac->{ap} gl: $ac->{gl}");
+    }
+  } else {
+    $self->tester->ok(1, "Alle acc_trans Transaktionen ergeben in Summe 0, keine unausgeglichenen Transaktionen");
+  }
+}
+
+sub check_verwaiste_acc_trans_eintraege {
+  my ($self) = @_;
+
+  my $query = qq|
+      select trans_id,amount,accno,description from acc_trans a
+    left join chart c on (c.id = a.chart_id)
+    where trans_id not in (select id from gl union select id from ar union select id from ap order by id)
+      and a.transdate >= ? and a.transdate <= ? ;|;
+
+  my $verwaiste_acs = selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+  if (@$verwaiste_acs) {
+     $self->tester->ok(0, "Es gibt verwaiste acc-trans Einträge! (wo ar/ap/gl-Eintrag fehlt)");
+     $self->tester->diag($_) for @$verwaiste_acs;
+  } else {
+     $self->tester->ok(1, "Keine verwaisten acc-trans Einträge (wo ar/ap/gl-Eintrag fehlt)");
+  }
+}
+
+sub check_netamount_laut_invoice_ar {
+  my ($self) = @_;
+  my $query = qq|
+    select sum(round(cast(i.qty*(i.fxsellprice * (1-i.discount)) as numeric), 2))
+    from invoice i
+    left join ar a on (a.id = i.trans_id)
+    where a.transdate >= ? and a.transdate <= ?;|;
+  my ($netamount_laut_invoice) =  selectfirst_array_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  $query = qq| select sum(netamount) from ar where transdate >= ? and transdate <= ?; |;
+  my ($netamount_laut_ar) =  selectfirst_array_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $correct = $netamount_laut_invoice - $netamount_laut_ar == 0;
+
+  $self->tester->ok($correct, "Summe laut Verkaufsbericht sollte gleich Summe aus Verkauf -> Berichte -> Rechnungen sein");
+  if (!$correct) {
+    $self->tester->diag("Netto-Summe laut Verkaufsbericht (invoice): $netamount_laut_invoice");
+    $self->tester->diag("Netto-Summe laut Verkauf -> Berichte -> Rechnungen: $netamount_laut_ar");
+  }
+}
+
+sub check_invnumbers_unique {
+  my ($self) = @_;
+
+  my $query = qq| select  invnumber,count(invnumber) as count from ar
+               where transdate >= ? and transdate <= ?
+               group by invnumber
+               having count(invnumber) > 1; |;
+  my $non_unique_invnumbers =  selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  if (@$non_unique_invnumbers) {
+    $self->tester->ok(0, "Es gibt doppelte Rechnungsnummern");
+    for my $invnumber (@{ $non_unique_invnumbers }) {
+      $self->tester->diag("invnumber: $invnumber->{invnumber}    $invnumber->{count}x");
+    }
+  } else {
+    $self->tester->ok(1, "Alle Rechnungsnummern sind eindeutig");
+  }
+}
+
+sub check_summe_stornobuchungen {
+  my ($self) = @_;
+
+  my $query = qq|
+    select sum(amount) from ar a JOIN customer c ON (a.customer_id = c.id)
+    WHERE storno is true
+      AND a.transdate >= ? and a.transdate <= ?|;
+  my ($summe_stornobuchungen_ar) = selectfirst_array_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  $query = qq|
+    select sum(amount) from ap a JOIN vendor c ON (a.vendor_id = c.id)
+    WHERE storno is true
+      AND a.transdate >= ? and a.transdate <= ?|;
+  my ($summe_stornobuchungen_ap) = selectfirst_array_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  $self->tester->ok($summe_stornobuchungen_ap == 0, 'Summe aller Einkaufsrechnungen (stornos + stronierte) soll 0 sein');
+  $self->tester->ok($summe_stornobuchungen_ar == 0, 'Summe aller Verkaufsrechnungen (stornos + stronierte) soll 0 sein');
+  $self->tester->diag("Summe Einkaufsrechnungen (ar): $summe_stornobuchungen_ar") if $summe_stornobuchungen_ar;
+  $self->tester->diag("Summe Einkaufsrechnungen (ap): $summe_stornobuchungen_ap") if $summe_stornobuchungen_ap;
+}
+
+sub check_ar_paid {
+  my ($self) = @_;
+
+  my $query = qq|
+      select invnumber,paid,
+           (select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ar.id and c.link like '%AR_paid%') as accpaid ,
+           paid+(select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ar.id and c.link like '%AR_paid%') as diff
+    from ar
+    where
+          (select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ar.id and c.link like '%AR_paid%') is not null
+            AND storno is false
+      AND transdate >= ? and transdate <= ?
+    order by diff |;
+
+  my $paid_diffs_ar = selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $errors = scalar grep { $_->{diff} != 0 } @$paid_diffs_ar;
+
+  $self->tester->ok(!$errors, "Vergleich ar paid mit acc_trans AR_paid");
+
+  for my $paid_diff_ar (@{ $paid_diffs_ar }) {
+    next if $paid_diff_ar->{diff} == 0;
+    $self->tester->diag("ar invnumber: $paid_diff_ar->{invnumber} : paid: $paid_diff_ar->{paid}    acc_paid= $paid_diff_ar->{accpaid}    diff: $paid_diff_ar->{diff}");
+  }
+}
+
+sub check_ap_paid {
+  my ($self) = @_;
+
+  my $query = qq|
+      select invnumber,paid,
+            (select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ap.id and c.link like '%AP_paid%') as accpaid ,
+            paid-(select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ap.id and c.link like '%AP_paid%') as diff
+     from ap
+     where
+           (select sum(amount) from acc_trans a left join chart c on (c.id = a.chart_id) where trans_id = ap.id and c.link like '%AP_paid%') is not null
+       AND transdate >= ? and transdate <= ?
+     order by diff |;
+
+  my $paid_diffs_ap = selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $errors = scalar grep { $_->{diff} != 0 } @$paid_diffs_ap;
+
+  $self->tester->ok(!$errors, "Vergleich ap paid mit acc_trans AP_paid");
+  for my $paid_diff_ap (@{ $paid_diffs_ap }) {
+     next if $paid_diff_ap->{diff} == 0;
+     $self->tester->diag("ap invnumber: $paid_diff_ap->{invnumber} : paid: $paid_diff_ap->{paid}    acc_paid= $paid_diff_ap->{accpaid}    diff: $paid_diff_ap->{diff}");
+  }
+}
+
+sub check_ar_overpayments {
+  my ($self) = @_;
+
+  my $query = qq|
+       select invnumber,paid,amount,transdate,c.customernumber,c.name from ar left join customer c on (ar.customer_id = c.id)
+     where abs(paid) > abs(amount)
+       AND transdate >= ? and transdate <= ?
+         order by invnumber;|;
+
+  my $overpaids_ar =  selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $correct = 0 == @$overpaids_ar;
+
+  $self->tester->ok($correct, "Keine Überzahlungen laut ar.paid");
+  for my $overpaid_ar (@{ $overpaids_ar }) {
+    $self->tester->diag("ar invnumber: $overpaid_ar->{invnumber} : paid: $overpaid_ar->{paid}    amount= $overpaid_ar->{amount}  transdate = $overpaid_ar->{transdate}");
+  }
+}
+
+sub check_ap_overpayments {
+  my ($self) = @_;
+
+  my $query = qq|
+      select invnumber,paid,amount,transdate,vc.vendornumber,vc.name from ap left join vendor vc on (ap.vendor_id = vc.id)
+    where abs(paid) > abs(amount)
+      AND transdate >= ? and transdate <= ?
+        order by invnumber;|;
+
+  my $overpaids_ap =  selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  my $correct = 0 == @$overpaids_ap;
+
+  $self->tester->ok($correct, "Überzahlungen laut ap.paid:");
+  for my $overpaid_ap (@{ $overpaids_ap }) {
+    $self->tester->diag("ap invnumber: $overpaid_ap->{invnumber} : paid: $overpaid_ap->{paid}    amount= $overpaid_ap->{amount}  transdate = $overpaid_ap->{transdate}");
+  }
+}
+
+sub check_paid_stornos {
+  my ($self) = @_;
+
+  my $query = qq|
+    SELECT ar.invnumber,sum(amount - COALESCE((SELECT sum(amount)*-1 FROM acc_trans LEFT JOIN chart ON (acc_trans.chart_id=chart.id) WHERE link ilike '%paid%' AND acc_trans.trans_id=ar.id ),0)) as "open"
+    FROM ar, customer
+    WHERE paid != amount
+      AND ar.storno
+      AND (ar.customer_id = customer.id)
+      AND ar.transdate >= ? and ar.transdate <= ?
+    GROUP BY ar.invnumber;|;
+  my $paid_stornos = selectall_hashref_query($::form, $self->dbh, $query, $self->fromdate, $self->todate);
+
+  $self->tester->ok(0 == @$paid_stornos, "Keine bezahlten Stornos");
+  for my $paid_storno (@{ $paid_stornos }) {
+    $self->tester->diag("invnumber: $paid_storno->{invnumber}   offen: $paid_storno->{open}");
+  }
+}
+
+sub check_stornos_ohne_partner {
+  my ($self) = @_;
+
+  my $query = qq|
+      select ar.id,invnumber,storno,amount,transdate,type,customernumber
+    from ar
+    left join customer c on (c.id = ar.customer_id)
+    where storno_id is null and storno is true and ar.id not in (select storno_id from ar where storno_id is not null and storno is true);
+  |;
+  my $stornos_ohne_partner =  selectall_hashref_query($::form, $self->dbh, $query);
+
+  $self->tester->ok(@$stornos_ohne_partner == 0, 'Es sollte keine Stornos ohne Partner geben');
+  if (@$stornos_ohne_partner) {
+    $self->tester->diag("stornos ohne partner:   (kann passieren wenn Stornorechnung außerhalb Zeitraum liegt)");
+    $self->tester->diag("gilt aber trotzdem als paid zu dem Zeitpunkt, oder?");
+  }
+  my $stornoheader = 0;
+  for my $storno (@{ $stornos_ohne_partner }) {
+    if (!$stornoheader++) {
+      $self->tester->diag(join "\t", keys %$storno);
+    }
+    $self->tester->diag(join "\t", map { $storno->{$_} } keys %$storno);
+  }
+}
+
+sub check_overpayments {
+  my ($self) = @_;
+
+  # Vergleich ar.paid und das was laut acc_trans bezahlt wurde
+  # "als bezahlt markieren" ohne sauberes Ausbuchen führt zu Differenzen bei offenen Forderungen
+  # geht nur auf wenn acc_trans Zahlungseingänge auch im Untersuchungszeitraum lagen
+  # Stornos werden rausgefiltert
+  my $query = qq|
+SELECT
+invnumber,customernumber,name,ar.transdate,ar.datepaid,
+amount,
+amount-paid as "open via ar",
+paid as "paid via ar",
+coalesce((SELECT sum(amount)*-1 FROM acc_trans LEFT JOIN chart ON (acc_trans.chart_id=chart.id) WHERE link ilike '%paid%' AND acc_trans.trans_id=ar.id AND acc_trans.transdate <= ?),0) as "paid via acc_trans"
+FROM ar left join customer c on (c.id = ar.customer_id)
+WHERE
+ (ar.storno IS FALSE)
+ AND (transdate <= ? )
+;|;
+
+  my $invoices = selectall_hashref_query($::form, $self->dbh, $query, $self->todate, $self->todate);
+
+  my $count_overpayments = scalar grep {
+       $_->{"paid via ar"} != $_->{"paid via acc_trans"}
+    || (    $_->{"amount"} - $_->{"paid via acc_trans"} != $_->{"open via ar"}
+         && $_->{"paid via ar"} != $_->{"paid via acc_trans"} )
+  } @$invoices;
+
+  $self->tester->ok($count_overpayments == 0, 'Vergleich ar.paid und das was laut acc_trans bezahlt wurde');
+
+  if ($count_overpayments) {
+    for my $invoice (@{ $invoices }) {
+      if ($invoice->{"paid via ar"} != $invoice->{"paid via acc_trans"}) {
+        $self->tester->diag("paid via ar (@{[ $invoice->{'paid via ar'} * 1 ]}) !=   paid via acc_trans  (@{[ $invoice->{'paid via acc_trans'} * 1 ]}) (at least until transdate!)");
+        if (defined $invoice->{datepaid}) {
+          $self->tester->diag("datepaid = $invoice->{datepaid})");
+        }
+        $self->tester->diag("Überzahlung!") if $invoice->{"paid via acc_trans"} > $invoice->{amount};
+      } elsif ( $invoice->{"amount"} - $invoice->{"paid via acc_trans"} != $invoice->{"open via ar"} && $invoice->{"paid via ar"} != $invoice->{"paid via acc_trans"}) {
+        $self->tester->diag("amount - paid_via_acc_trans !=  open_via_ar");
+        $self->tester->diag("Überzahlung!") if $invoice->{"paid via acc_trans"} > $invoice->{amount};
+      } else {
+        # nothing wrong
+      }
+    }
+  }
+}
+
+sub calc_saldenvortraege {
+  my ($self) = @_;
+
+  my $saldenvortragskonto = '9000';
+
+  # Saldo Saldenvortragskonto 9000 am Jahresanfang
+  my $query = qq|
+      select sum(amount) from acc_trans where chart_id = (select id from chart where accno = ?) and transdate <= ?|;
+  my ($saldo_9000_jahresanfang) = selectfirst_array_query($::form, $self->dbh, $query, $saldenvortragskonto, DateTime->new(day => 1, month => 1, year => DateTime->today->year));
+  $self->tester->diag("Saldo 9000 am 01.01.@{[DateTime->today->year]}: @{[ $saldo_9000_jahresanfang * 1 ]}    (sollte 0 sein)");
+
+    # Saldo Saldenvortragskonto 9000 am Jahresende
+  $query = qq|
+      select sum(amount) from acc_trans where chart_id = (select id from chart where accno = ?) and transdate <= ?|;
+  my ($saldo_9000_jahresende) = selectfirst_array_query($::form, $self->dbh, $query, $saldenvortragskonto, DateTime->new(day => 31, month => 12, year => DateTime->today->year));
+  $self->tester->diag("Saldo $saldenvortragskonto am 31.12.@{[DateTime->today->year]}: @{[ $saldo_9000_jahresende * 1 ]}    (sollte 0 sein)");
+}
+
+1;
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+SL::BackgroundJob::SelfTest::Transactions - base tests
+
+=head1 DESCRIPTION
+
+Several tests for data integrity.
+
+=head1 FUNCTIONS
+
+=head1 BUGS
+
+=head1 AUTHOR
+
+Geoffrey Richardsom E<lt>information@richardsonbueren.deE<gt>
+Jan Büren E<lt>information@richardsonbueren.deE<gt>
+Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
+

diff --git a/config/lx_office.conf.default b/config/lx_office.conf.default
index 53bacffbfb482d2dd90579c7d6b6615ff1781e8d..7b95f4c1cd2f67f3da3d7c75be667cc17049abee 100644 (file)
--- a/config/lx_office.conf.default
+++ b/config/lx_office.conf.default
@@ -163,6 +163,29 @@ email_subject  = Benachrichtigung: automatisch erstellte Rechnungen
 # The template file used for the email's body.
 email_template = templates/webpages/oe/periodic_invoices_email.txt
 
 # The template file used for the email's body.
 email_template = templates/webpages/oe/periodic_invoices_email.txt
 

+[self_test]
+
+# modules to be tested
+# Add without SL::BackgroundJob::SelfTest:: prefix
+# Separate with space.
+modules = Transactions
+
+# you probably don't want to be spammed with "everything ok" every day. enable
+# this when you add new tests to make sure they run correctly for a few days
+send_email_on_success = 0
+
+# will log into the standard logfile
+log_to_file = 0
+
+# user login (!) to send the email to.
+send_email_to  =
+# will be used to send your report mail
+email_from     =
+# The subject line for your report mail
+email_subject  = kivitendo self test report
+# template. currently txt and html templates are recognized and correctly mime send.
+email_template = templates/mail/self_test/status_mail.txt
+

 [datev_check]
 # it is possible to make a quick DATEV export everytime you post a record to ensure things
 # work nicely with their data requirements. This will result in a slight overhead though
 [datev_check]
 # it is possible to make a quick DATEV export everytime you post a record to ensure things
 # work nicely with their data requirements. This will result in a slight overhead though

diff --git a/doc/changelog b/doc/changelog
index bc2f09228357df80f899e0ef377ea5b81494aefb..56522d541a15b29c18fe25512fe7171eee3c2fbb 100644 (file)
--- a/doc/changelog
+++ b/doc/changelog
@@ -19,6 +19,16 @@ Größere neue Features:
 
 Experimentelle Features:
 
 
 Experimentelle Features:
 

+- Automatisierte Selbsttests
+  Es gibt jetzt ein Grundgerüst um Selbsttests durchzuführen, und bei Problemen
+  einen Administrator per Mail zu benachrichtigen. Die Selbsttests werden Über
+  das SelfTest Modul für den Taskserver verwaltet, und in config/lx_office.conf
+  im Block [self_test] konfiguriert. Die Tests werden in TAP ausgeliefert und
+  können bei Bedarf weiter maschinell ausgewertet werden.
+
+  Zur Demonstration gibt es einen Selbsttest Transactions, der die Datenbank
+  auf Fehlbuchungen untersucht.
+

 - Es ist möglich benutzerdefinierte Variablen vom Typ "Lieferant" und "Ware"
   anzulegen. Für die Auswahl in den webpages steht ein L.vendor_selector und
   ein L.part_selector zur Verfügung, der einfach das select_tag verwendet.
 - Es ist möglich benutzerdefinierte Variablen vom Typ "Lieferant" und "Ware"
   anzulegen. Für die Auswahl in den webpages steht ein L.vendor_selector und
   ein L.part_selector zur Verfügung, der einfach das select_tag verwendet.

diff --git a/locale/de/all b/locale/de/all
index b5047be5033ef83e332e8f1db74c51af124cad7b..9f31c8c669cc6a7c9fb4c8bc85a86e2b2c512c47 100644 (file)
--- a/locale/de/all
+++ b/locale/de/all
@@ -432,6 +432,8 @@ $self->{texts} = {
   'Corrections'                 => 'Korrekturen',
   'Costs'                       => 'Kosten',
   'Could not copy %s to %s. Reason: %s' => 'Die Datei "%s" konnte nicht nach "%s" kopiert werden. Grund: %s',
   'Corrections'                 => 'Korrekturen',
   'Costs'                       => 'Kosten',
   'Could not copy %s to %s. Reason: %s' => 'Die Datei "%s" konnte nicht nach "%s" kopiert werden. Grund: %s',

+  'Could not load class #1 (#2): "#3"' => 'Konnte Klasse #1 (#2) nicht laden: "#3"',
+  'Could not load class #1, #2' => 'Konnte Klasse #1 nicht laden: "#2"',

   'Could not load employee'     => 'Konnte Benutzer nicht laden',
   'Could not open the file users/members.' => 'Die Datei "users/members" konnte nicht geöffnet werden.',
   'Could not open the old memberfile.' => 'Die Datei mit den Benutzerdaten konnte nicht geöffnet werden.',
   'Could not load employee'     => 'Konnte Benutzer nicht laden',
   'Could not open the file users/members.' => 'Die Datei "users/members" konnte nicht geöffnet werden.',
   'Could not open the old memberfile.' => 'Die Datei mit den Benutzerdaten konnte nicht geöffnet werden.',

diff --git a/sql/Pg-upgrade2/self_test_background_job.pl b/sql/Pg-upgrade2/self_test_background_job.pl
new file mode 100644 (file)
index 0000000..796c6c9
--- /dev/null
+++ b/sql/Pg-upgrade2/self_test_background_job.pl
@@ -0,0 +1,12 @@
+# @tag: self_test_background_job
+# @description: Hintergrundjob für tägliche Selbsttests
+# @depends: release_2_7_0
+# @charset: utf-8
+
+use strict;
+
+use SL::BackgroundJob::SelfTest;
+
+SL::BackgroundJob::SelfTest->create_job;
+
+1;

diff --git a/templates/mail/self_test/status_mail.txt b/templates/mail/self_test/status_mail.txt
new file mode 100644 (file)
index 0000000..2dc69dc
--- /dev/null
+++ b/templates/mail/self_test/status_mail.txt
@@ -0,0 +1,18 @@
+kivitendo selftest report.
+
+Host:   [% host %]
+Path:   [% path %]
+DB:     [% database %]
+Result: [% SELF.aggreg.get_status %]
+
+------------
+Full report:
+------------
+
+[% FOREACH module = SELF.diag_per_module.keys %]
+Module: [% module %]
+--------------------
+
+[% SELF.diag_per_module.$module %]
+
+[% END %]