Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 8317b7aa

Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt

  • ID 8317b7aa1407238c9fa8d609a1795b4ee20cb2dd
  • Vorgänger 94d3a3e9
  • Nachfolger d5d805a7

Tests: eigene Datenbank für Unit-Tests hochziehen

Unterschiede anzeigen:

t/000setup_database.t
1
#!/usr/bin/perl
2

  
3
use strict;
4

  
5
use lib 't';
6

  
7
use Data::Dumper;
8
use Test::More;
9

  
10
use SL::Auth;
11
use SL::DBConnect;
12
use SL::Form;
13
use SL::LXDebug;
14
use SL::Layout::None;
15
use SL::LxOfficeConf;
16

  
17
our ($db_cfg, $dbh);
18

  
19
sub dbg {
20
  # diag(@_);
21
}
22

  
23
sub dbh_do {
24
  my ($dbh, $query, %params) = @_;
25

  
26
  if (ref($query)) {
27
    return if $query->execute(@{ $params{bind} || [] });
28
    BAIL_OUT($dbh->errstr);
29
  }
30

  
31
  return if $dbh->do($query, undef, @{ $params{bind} || [] });
32

  
33
  BAIL_OUT($params{message} . ": " . $dbh->errstr) if $params{message};
34
  BAIL_OUT("Query failed: " . $dbh->errstr . " ; query: $query");
35
}
36

  
37
sub verify_configuration {
38
  SL::LxOfficeConf->read;
39

  
40
  my %config = %{ $::lx_office_conf{'testing/database'} || {} };
41
  my @unset  = sort grep { !$config{$_} } qw(host port db user template);
42

  
43
  BAIL_OUT("Missing entries in configuration in section [testing/database]: " . join(' ', @unset)) if @unset;
44
}
45

  
46
sub setup {
47
  package main;
48

  
49
  $SIG{__DIE__}    = sub { Carp::confess( @_ ) } if $::lx_office_conf{debug}->{backtrace_on_die};
50
  $::lxdebug       = LXDebug->new(target => LXDebug::STDERR_TARGET);
51
  $::lxdebug->disable_sub_tracing;
52
  $::locale        = Locale->new($::lx_office_conf{system}->{language});
53
  $::form          = Form->new;
54
  $::auth          = SL::Auth->new(unit_tests_database => 1);
55
  $::locale        = Locale->new('de');
56
  $db_cfg          = $::lx_office_conf{'testing/database'};
57
}
58

  
59
sub drop_and_create_database {
60
  my @dbi_options = (
61
    'dbi:Pg:dbname=' . $db_cfg->{template} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
62
    $db_cfg->{user},
63
    $db_cfg->{password},
64
    SL::DBConnect->get_options,
65
  );
66

  
67
  $::auth->reset;
68
  my $dbh_template = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("No database connection to the template database: " . $DBI::errstr);
69
  my $auth_dbh     = $::auth->dbconnect(1);
70

  
71
  if ($auth_dbh) {
72
    dbg("Database exists; dropping");
73
    $auth_dbh->disconnect;
74

  
75
    dbh_do($dbh_template, "DROP DATABASE \"" . $db_cfg->{db} . "\"", message => "Database could not be dropped");
76

  
77
    $::auth->reset;
78
  }
79

  
80
  dbg("Creating database");
81

  
82
  dbh_do($dbh_template, "CREATE DATABASE \"" . $db_cfg->{db} . "\" TEMPLATE \"" . $db_cfg->{template} . "\" ENCODING 'UNICODE'", message => "Database could not be created");
83
  $dbh_template->disconnect;
84
}
85

  
86
sub report_success {
87
  $dbh->disconnect;
88
  ok(1, "Database has been setup sucessfully.");
89
  done_testing();
90
}
91

  
92
sub apply_dbupgrade {
93
  my ($dbupdater, $control_or_file) = @_;
94

  
95
  my $file    = ref($control_or_file) ? ("sql/Pg-upgrade2" . ($dbupdater->{auth} ? "-auth" : "") . "/$control_or_file->{file}") : $control_or_file;
96
  my $control = ref($control_or_file) ? $control_or_file                                                                        : undef;
97

  
98
  dbg("Applying $file");
99

  
100
  my $error = $dbupdater->process_file($dbh, $file, $control);
101

  
102
  BAIL_OUT("Error applying $file: $error") if $error;
103
}
104

  
105
sub create_initial_schema {
106
  dbg("Creating initial schema");
107

  
108
  my @dbi_options = (
109
    'dbi:Pg:dbname=' . $db_cfg->{db} . ';host=' . $db_cfg->{host} . ';port=' . $db_cfg->{port},
110
    $db_cfg->{user},
111
    $db_cfg->{password},
112
    SL::DBConnect->get_options(PrintError => 0, PrintWarn => 0),
113
  );
114

  
115
  $dbh           = SL::DBConnect->connect(@dbi_options) || BAIL_OUT("Database connection failed: " . $DBI::errstr);
116
  $::auth->{dbh} = $dbh;
117
  my $dbupdater  = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, silent => 1);
118
  my $coa        = 'Germany-DATEV-SKR03EU';
119

  
120
  apply_dbupgrade($dbupdater, "sql/lx-office.sql");
121
  apply_dbupgrade($dbupdater, "sql/${coa}-chart.sql");
122

  
123
  dbh_do($dbh, qq|UPDATE defaults SET coa = '${coa}', accounting_method = 'cash', profit_determination = 'income', inventory_system = 'periodic', curr = 'EUR'|);
124
  dbh_do($dbh, qq|CREATE TABLE schema_info (tag TEXT, login TEXT, itime TIMESTAMP DEFAULT now(), PRIMARY KEY (tag))|);
125
}
126

  
127
sub create_initial_auth_schema {
128
  dbg("Creating initial auth schema");
129

  
130
  my $dbupdater = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => 1);
131
  apply_dbupgrade($dbupdater, 'sql/auth_db.sql');
132
}
133

  
134
sub apply_upgrades {
135
  my %params            = @_;
136
  my $dbupdater         = SL::DBUpgrade2->new(form => $::form, return_on_error => 1, auth => $params{auth});
137
  my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($dbh);
138

  
139
  apply_dbupgrade($dbupdater, $_) for @unapplied_scripts;
140
}
141

  
142
sub create_client_user_and_employee {
143
  dbg("Creating client, user, group and employee");
144

  
145
  dbh_do($dbh, qq|DELETE FROM auth.clients|);
146
  dbh_do($dbh, qq|INSERT INTO auth.clients (id, name, dbhost, dbport, dbname, dbuser, dbpasswd, is_default) VALUES (1, 'Unit-Tests', ?, ?, ?, ?, ?, TRUE)|,
147
         bind => [ @{ $db_cfg }{ qw(host port db user password) } ]);
148
  dbh_do($dbh, qq|INSERT INTO auth."user"         (id,        login)    VALUES (1, 'unittests')|);
149
  dbh_do($dbh, qq|INSERT INTO auth."group"        (id,        name)     VALUES (1, 'Vollzugriff')|);
150
  dbh_do($dbh, qq|INSERT INTO auth.clients_users  (client_id, user_id)  VALUES (1, 1)|);
151
  dbh_do($dbh, qq|INSERT INTO auth.clients_groups (client_id, group_id) VALUES (1, 1)|);
152
  dbh_do($dbh, qq|INSERT INTO auth.user_group     (user_id,   group_id) VALUES (1, 1)|);
153

  
154
  my %config                 = (
155
    default_printer_id       => '',
156
    template_format          => '',
157
    default_media            => '',
158
    email                    => 'unit@tester',
159
    tel                      => '',
160
    dateformat               => 'dd.mm.yy',
161
    show_form_details        => '',
162
    name                     => 'Unit Tester',
163
    signature                => '',
164
    hide_cvar_search_options => '',
165
    numberformat             => '1.000,00',
166
    vclimit                  => 0,
167
    favorites                => '',
168
    copies                   => '',
169
    menustyle                => 'v3',
170
    fax                      => '',
171
    stylesheet               => 'lx-office-erp.css',
172
    mandatory_departments    => 0,
173
    countrycode              => 'de',
174
  );
175

  
176
  my $sth = $dbh->prepare(qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (1, ?, ?)|) || BAIL_OUT($dbh->errstr);
177
  dbh_do($dbh, $sth, bind => [ $_, $config{$_} ]) for sort keys %config;
178
  $sth->finish;
179

  
180
  my $sth = $dbh->prepare(qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (1, ?, TRUE)|) || BAIL_OUT($dbh->errstr);
181
  dbh_do($dbh, $sth, bind => [ $_ ]) for sort $::auth->all_rights;
182
  $sth->finish;
183

  
184
  dbh_do($dbh, qq|INSERT INTO employee (id, login, name) VALUES (1, 'unittests', 'Unit Tester')|);
185

  
186
  $::auth->set_client(1) || BAIL_OUT("\$::auth->set_client(1) failed");
187
  %::myconfig = $::auth->read_user(login => 'unittests');
188
}
189

  
190
verify_configuration();
191
setup();
192
drop_and_create_database();
193
create_initial_schema();
194
create_initial_auth_schema();
195
apply_upgrades(auth => 1);
196
create_client_user_and_employee();
197
apply_upgrades();
198
report_success();
199

  
200
1;
t/Support/TestSetup.pm
15 15
use SL::InstanceConfiguration;
16 16
use SL::Request;
17 17

  
18
sub _login {
19
  my ($client, $login) = @_;
18
sub login {
19
  SL::LxOfficeConf->read;
20 20

  
21
  die 'need client and login' unless $client && $login;
21
  my $client = 'Unit-Tests';
22
  my $login  = 'unittests';
22 23

  
23 24
  package main;
24 25

  
......
51 52
  return 1;
52 53
}
53 54

  
54
sub login {
55
  SL::LxOfficeConf->read;
56

  
57
  my $login        = shift || $::lx_office_conf{testing}{login}        || 'demo';
58
  my $client        = shift || $::lx_office_conf{testing}{client}      || '';
59
  _login($client, $login);
60
}
61

  
62 55
sub templates_cache_writable {
63 56
  my $dir = $::lx_office_conf{paths}->{userspath} . '/templates-cache';
64 57
  return 1 if -w $dir;
t/test.pl
1
#!/usr/bin/perl -X
2

  
3
use strict;
4

  
5
use Data::Dumper;
6
use File::Find ();
7
use Test::Harness qw(runtests execute_tests);
8

  
9
BEGIN {
10
  $ENV{HARNESS_OPTIONS} = 'j:c';
11
  unshift @INC, 'modules/override';
12
  push    @INC, 'modules/fallback';
13
}
14

  
15
sub find_files_to_test {
16
  my @files;
17
  File::Find::find(sub { push @files, $File::Find::name if (-f _) && m/\.t$/ }, 't');
18
  return @files;
19
}
20

  
21
my (@tests_to_run, @tests_to_run_first);
22

  
23
if (@ARGV) {
24
  @tests_to_run       = @ARGV;
25

  
26
} else {
27
  @tests_to_run_first = qw(t/000setup_database.t);
28
  my %exclude         = map  { ($_ => 1)     } @tests_to_run_first;
29
  @tests_to_run       = grep { !$exclude{$_} } sort(find_files_to_test());
30
}
31

  
32
if (@tests_to_run_first) {
33
  my ($total, $failed) = execute_tests(tests => \@tests_to_run_first);
34
  exit(1) unless !$total->{bad} && (0 < $total->{max});
35
}
36

  
37
runtests(@tests_to_run);
t/test.sh
1
#!/bin/bash
2

  
3
{
4
  if [[ -z $1 ]]; then
5
    find t -type f -name '*.t'
6
  else
7
    echo -- "$@"
8
  fi
9
} | HARNESS_OPTIONS=j:c xargs perl -X -Imodules/override -MTest::Harness -e 'BEGIN { push @INC, "modules/fallback" } runtests(@ARGV)'

Auch abrufbar als: Unified diff