X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=t%2FSupport%2FTestSetup.pm;h=7e5774ea1878e93457d2ba37ac76ada9adcef5da;hb=b50f89e56d91662eb69a47351c430ff6270c7d39;hp=cb8fd7ffb86bbb061be5bab771ac0b19a36aac40;hpb=fef4ba5a95e3e38261d497edd6852d4db77531cf;p=kivitendo-erp.git diff --git a/t/Support/TestSetup.pm b/t/Support/TestSetup.pm index cb8fd7ffb..7e5774ea1 100644 --- a/t/Support/TestSetup.pm +++ b/t/Support/TestSetup.pm @@ -4,27 +4,37 @@ use strict; use Data::Dumper; use CGI qw( -no_xhtml); +use IO::File; use SL::Auth; use SL::Form; use SL::Locale; use SL::LXDebug; use Data::Dumper; +use SL::Layout::None; 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; - $::lxdebug = LXDebug->new(file => \*STDERR); + $::lxdebug = LXDebug->new(target => LXDebug::STDERR_TARGET); + $::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 = { cgi => CGI->new({}) }; + $::request = SL::Request->new( cgi => CGI->new({}), layout => SL::Layout::None->new ); die 'cannot reach auth db' unless $::auth->session_tables_present; @@ -38,16 +48,24 @@ sub _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;