X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=t%2FSupport%2FTestSetup.pm;h=037cfb547e7b06a08e857863792776c8f6fd7f61;hb=ef6a2cbcb3571634b44bf2ea1927f657fc43fc30;hp=671e6d9dcbb1e6da24c7b6a38e2d68307c736bfe;hpb=dac8a13645336de9db50c3d1ee5c5009ec129958;p=kivitendo-erp.git diff --git a/t/Support/TestSetup.pm b/t/Support/TestSetup.pm index 671e6d9dc..037cfb547 100644 --- a/t/Support/TestSetup.pm +++ b/t/Support/TestSetup.pm @@ -4,6 +4,7 @@ use strict; use Data::Dumper; use CGI qw( -no_xhtml); +use IO::File; use SL::Auth; use SL::Form; use SL::Locale; @@ -14,10 +15,14 @@ use SL::LxOfficeConf; use SL::InstanceConfiguration; use SL::Request; -sub _login { - my $login = shift; +sub login { + $Data::Dumper::Sortkeys = 1; + $Data::Dumper::Indent = 2; + + SL::LxOfficeConf->read; - die 'need login' unless $login; + my $client = 'Unit-Tests'; + my $login = 'unittests'; package main; @@ -25,7 +30,9 @@ sub _login { $::lxdebug->disable_sub_tracing; $::locale = Locale->new($::lx_office_conf{system}->{language}); $::form = Form->new; - $::auth = SL::Auth->new; + $::auth = SL::Auth->new(unit_tests_database => 1); + die "Cannot find client with ID or name '$client'" if !$::auth->set_client($client); + $::instance_conf = SL::InstanceConfiguration->new; $::request = SL::Request->new( cgi => CGI->new({}), layout => SL::Layout::None->new ); @@ -37,20 +44,26 @@ sub _login { die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login); - $::form->{login} = $login; # normaly implicit at login - die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode}); - $::instance_conf->init; + $SIG{__DIE__} = sub { Carp::confess( @_ ) } if $::lx_office_conf{debug}->{backtrace_on_die}; return 1; } -sub login { - SL::LxOfficeConf->read; +sub templates_cache_writable { + my $dir = $::lx_office_conf{paths}->{userspath} . '/templates-cache'; + return 1 if -w $dir; - my $login = shift || $::lx_office_conf{testing}{login} || 'demo'; - _login($login); + # Try actually creating a file. Due to ACLs this might be possible + # even if the basic Unix permissions and Perl's -w test say + # otherwise. + my $file = "${dir}/.writetest"; + my $out = IO::File->new($file, "w") || return 0; + $out->close; + unlink $file; + + return 1; } 1;