1 package SL::BackgroundJob::SelfTest;
5 use parent qw(SL::BackgroundJob::Base);
9 use TAP::Parser::Aggregator;
16 use SL::Locale::String qw(t8);
19 use Rose::Object::MakeMethods::Generic (
22 'add_modules' => { interface => 'add', hash_key => 'modules' },
24 'add_errors' => { interface => 'add', hash_key => 'errors' },
26 'add_full_diag' => { interface => 'add', hash_key => 'full_diag' },
29 qw(diag tester config aggreg),
34 $_[0]->create_standard_job('20 2 * * *'); # every day at 2:20 am
40 $self->config($::lx_office_conf{self_test} || {});
42 $self->tester(Test::Builder->new);
43 $self->tester->reset; # stupid Test::Builder mplementation uses class variables
44 $self->aggreg(TAP::Parser::Aggregator->new);
46 $self->modules(split /\s+/, $self->config->{modules});
53 my $options = $db_obj->data_as_hash;
56 return 1 unless $self->modules;
59 $main::lxdebug->message(0, 'optioni' . Dumper($self->modules));
60 foreach my $module ($self->modules) {
61 next unless $module eq $options->{module};
62 $main::lxdebug->message(0, 'hieur' . $module);
63 $self->run_module($module);
67 sprintf "SelfTest status: %s, passed: %s, failed: %s, unexpectedly succeeded: %s",
68 $self->aggreg->get_status,
69 $self->aggreg->passed,
70 $self->aggreg->failed,
71 $self->aggreg->todo_passed,
74 if (!$self->aggreg->all_passed || $self->config->{send_email_on_success}) {
78 croak t8("Unsuccessfully executed:" . join ("\n", $self->errors)) if $self->errors;
83 my ($self, $module) = @_;
85 # TAP usually prints out to STDOUT and STDERR, capture those for TAP::Parser
88 $self->tester->output (\$output);
89 $self->tester->failure_output(\$output);
90 $self->tester->todo_output (\$output);
92 # sanitize module name;
93 # this allows unicode package names, which are known to be buggy in 5.10, you should avoid them
94 $module =~ s/[^\w:]//g;
95 $module = "SL::BackgroundJob::SelfTest::$module";
98 (my $file = $module) =~ s|::|/|g;
100 require $file . '.pm';
102 } or $self->add_errors($::locale->text('Could not load class #1 (#2): "#3"', $module, $file, $@)) && return;
105 $self->tester->subtest($module => sub {
109 } or $self->add_errors($::locale->text('Could not load class #1, #2', $module, $@)) && return;
111 $self->add_full_diag($output);
112 $self->{diag_per_module}{$module} = $output;
114 my $parser = TAP::Parser->new({ tap => $output});
117 $self->aggreg->add($module => $parser);
121 $_[0]{email_user} ||= SL::DB::Manager::AuthUser->find_by(login => $_[0]->config->{send_email_to});
127 return if !$self->config || !$self->config->{send_email_to};
129 my $user = $self->_email_user;
130 my $email = $user ? $user->get_config_value('email') : undef;
132 return unless $email;
134 my ($output, $content_type) = $self->_prepare_report;
136 my $mail = Mailer->new;
137 $mail->{from} = $self->config->{email_from};
138 $mail->{to} = $email;
139 $mail->{subject} = $self->config->{email_subject};
140 $mail->{content_type} = $content_type;
141 $mail->{message} = $$output;
146 sub _prepare_report {
149 my $user = $self->_email_user;
150 my $template = Template->new({ 'INTERPOLATE' => 0,
156 return unless $template;
157 my $email_template = $self->config->{email_template};
158 my $filename = $email_template || ( (SL::DB::Default->get->templates || "templates/mails") . "/self_test/status_mail.txt" );
159 my $content_type = $filename =~ m/.html$/ ? 'text/html' : 'text/plain';
165 database => $::auth->client->{dbname},
166 client => $::auth->client->{name},
167 path => $FindBin::Bin,
168 errors => $self->errors,
172 $template->process($filename, \%params, \$output) || die $template->error;
174 return (\$output, $content_type);
179 $::lxdebug->message(0, "[" . __PACKAGE__ . "] @_") if $self->config->{log_to_file};
189 SL::BackgroundJob::SelfTest - pluggable self testing
193 use SL::BackgroundJob::SelfTest;
194 SL::BackgroundJob::SelfTest->new->run;;