From cff913a1c984f82558a7d59dec0b8b1a06c5530d Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Tue, 8 Nov 2016 12:58:44 +0100 Subject: [PATCH] Startup: Include-Pfade mittels FindBin ermitteln MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Neue Perl-Versionen werden das aktuelle Verzeichnis '.' aus dem Standard-Include-Pfad @INC entfernen. Das bedeutet für uns, dass wir nicht mehr einfach »use SL::Dispatcher;« und ähnliche Konstrukte machen können. Daher stellt dieser Commit all diejenigen Perl-Dateien, die als externe Einstiegsquelle dienen, auf die Verwendung von FindBin um. Es werden nicht nur die Verzeichnisse »modules/override« und »modules/fallback« behandelt, sondern auch das Installationsverzeichins selber mit in @INC aufgenommen, um für die Entfernung von '.' gewappnet zu sein. Zusätzlich wurden die meisten Scripte so modifiziert, dass sie nicht mehr direkt aus dem kivitendo-Installationsverzeichnis heraus aufgerufen werden müssen sondern aus beliebigen Verzeichnissen heraus aufgerufen werden können. Sie wechseln schlicht zu allererst das aktuelle Verzeichnis ins kivitendo-Installationsverzeichnis. Perl-Module, die nicht direkt Scripte sind und den Pfad zum Installationsverzeichnis benötigen (also z.B. SL/DBUpgrade2.pm), dürfen allerdings FindBin nicht benutzen, weil $FindBin::Bin das Verzeichnis zum aufgerufenen Perl-Script enthält, und das kann mal dispatcher.pl sein, mal scripts/dbupgrade2.pl. Für diese Module gibt es weiterhin SL::System::Process->exe_dir, die das kivitendo-Installationsverzeichnis zuverlässig ermittelt. Leider ist es nicht möglich, nur SL::System::Process->exe_dir anstelle von $FindBin::Bin zu nutzen, da zuerst SL::System::Process eingebunden werden muss, und um das zu tun, muss das Installationsverzeichnis ja bereits im Include-Pfad vorhanden sein — typical case of catch 22. --- SL/DBUpgrade2.pm | 3 ++- SL/Dispatcher.pm | 9 --------- SL/LxOfficeConf.pm | 8 +++++--- SL/System/Process.pm | 21 ++++++++++++--------- dispatcher.fpl | 8 ++++++++ dispatcher.pl | 8 ++++++++ scripts/dbconnect.pl | 9 ++++----- scripts/dbupgrade2_tool.pl | 11 ++++------- scripts/find-use.pl | 11 +++++++++++ scripts/generate_client_js_actions.pl | 5 +++-- scripts/installation_check.pl | 20 ++++++++++++-------- scripts/locales.pl | 10 +++++++--- scripts/make_docs.pl | 3 +++ scripts/rose_auto_create_model.pl | 9 +++++++-- scripts/task_server.pl | 20 +++++++------------- t/test.pl | 12 +++++++++--- 16 files changed, 102 insertions(+), 65 deletions(-) mode change 100644 => 100755 scripts/make_docs.pl diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index 5c8280b2c..496d15f26 100644 --- a/SL/DBUpgrade2.pm +++ b/SL/DBUpgrade2.pm @@ -7,6 +7,7 @@ use List::MoreUtils qw(any); use SL::Common; use SL::DBUpgrade2::Base; use SL::DBUtils; +use SL::System::Process; use strict; @@ -26,7 +27,7 @@ sub init { $params{path_suffix} ||= ''; $params{schema} ||= ''; - $params{path} ||= "sql/Pg-upgrade2" . $params{path_suffix}; + $params{path} ||= SL::System::Process->exe_dir . "/sql/Pg-upgrade2" . $params{path_suffix}; map { $self->{$_} = $params{$_} } keys %params; diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm index 357f9f8fd..fbe63f2ec 100644 --- a/SL/Dispatcher.pm +++ b/SL/Dispatcher.pm @@ -7,15 +7,6 @@ use strict; # parse_html_template('login_screen/user_login') # parse_html_template('generic/error') -BEGIN { - use SL::System::Process; - my $exe_dir = SL::System::Process::exe_dir; - - unshift @INC, "${exe_dir}/modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "${exe_dir}/modules/fallback"; # Only use our own versions of modules if there's no system version. - unshift @INC, $exe_dir; -} - use Carp; use CGI qw( -no_xhtml); use Config::Std; diff --git a/SL/LxOfficeConf.pm b/SL/LxOfficeConf.pm index 4e26c4e25..588e87f8b 100644 --- a/SL/LxOfficeConf.pm +++ b/SL/LxOfficeConf.pm @@ -3,6 +3,7 @@ package SL::LxOfficeConf; use strict; use Encode; +use SL::System::Process; my $environment_initialized; @@ -32,11 +33,12 @@ sub read { # Backwards compatibility: read lx_office.conf.default if # kivitendo.conf.default does't exist. - my $default_config = -f "config/kivitendo.conf.default" ? 'kivitendo' : 'lx_office'; - read_config("config/${default_config}.conf.default" => \%::lx_office_conf); + my $dir = SL::System::Process->exe_dir; + my $default_config = -f "${dir}/config/kivitendo.conf.default" ? 'kivitendo' : 'lx_office'; + read_config("${dir}/config/${default_config}.conf.default" => \%::lx_office_conf); _decode_recursively(\%::lx_office_conf); - $file_name ||= -f 'config/kivitendo.conf' ? 'config/kivitendo.conf' : 'config/lx_office.conf'; + $file_name ||= -f "${dir}/config/kivitendo.conf" ? "${dir}/config/kivitendo.conf" : "${dir}/config/lx_office.conf"; if (-f $file_name) { read_config($file_name => \ my %local_conf); diff --git a/SL/System/Process.pm b/SL/System/Process.pm index 482e6d33f..36f1f657f 100644 --- a/SL/System/Process.pm +++ b/SL/System/Process.pm @@ -5,21 +5,24 @@ use strict; use parent qw(Rose::Object); use English qw(-no_match_vars); +use FindBin; use File::Spec; use File::Basename; +use List::Util qw(first); + +my $cached_exe_dir; sub exe_dir { - my $dir = dirname(File::Spec->rel2abs($PROGRAM_NAME)); - my $system_dir = File::Spec->catdir($dir, 'SL', 'System'); - return $dir if -d $system_dir && -f File::Spec->catfile($system_dir, 'TaskServer.pm'); + return $cached_exe_dir if defined $cached_exe_dir; + + my $bin_dir = File::Spec->rel2abs($FindBin::Bin); + my @dirs = File::Spec->splitdir($bin_dir); - my @dirs = reverse File::Spec->splitdir($dir); - shift @dirs; - $dir = File::Spec->catdir(reverse @dirs); - $system_dir = File::Spec->catdir($dir, 'SL', 'System'); - return File::Spec->curdir unless -d $system_dir && -f File::Spec->catfile($system_dir, 'TaskServer.pm'); + $cached_exe_dir = first { -f File::Spec->catdir(@dirs[0..$_], 'SL', 'System', 'TaskServer.pm') } + reverse(0..scalar(@dirs) - 1); + $cached_exe_dir = defined($cached_exe_dir) ? File::Spec->catdir(@dirs[0..$cached_exe_dir]) : File::Spec->curdir; - return $dir; + return $cached_exe_dir; } 1; diff --git a/dispatcher.fpl b/dispatcher.fpl index c83503612..9b7c98b7d 100755 --- a/dispatcher.fpl +++ b/dispatcher.fpl @@ -2,6 +2,14 @@ use strict; +BEGIN { + use FindBin; + + unshift(@INC, $FindBin::Bin . '/modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/modules/fallback'); # Only use our own versions of modules if there's no system version. +} + use SL::Dispatcher; use SL::FCGIFixes; use SL::LXDebug; diff --git a/dispatcher.pl b/dispatcher.pl index 433ffe9d3..e5621f6f5 100755 --- a/dispatcher.pl +++ b/dispatcher.pl @@ -2,6 +2,14 @@ use strict; +BEGIN { + use FindBin; + + unshift(@INC, $FindBin::Bin . '/modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/modules/fallback'); # Only use our own versions of modules if there's no system version. +} + use SL::Dispatcher; our $dispatcher = SL::Dispatcher->new('CGI'); diff --git a/scripts/dbconnect.pl b/scripts/dbconnect.pl index 6eed2a0cf..9ba492f5d 100755 --- a/scripts/dbconnect.pl +++ b/scripts/dbconnect.pl @@ -1,12 +1,11 @@ #!/usr/bin/perl BEGIN { - use SL::System::Process; - my $exe_dir = SL::System::Process::exe_dir; + use FindBin; - unshift @INC, "${exe_dir}/modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "${exe_dir}/modules/fallback"; # Only use our own versions of modules if there's no system version. - unshift @INC, $exe_dir; + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. } use strict; diff --git a/scripts/dbupgrade2_tool.pl b/scripts/dbupgrade2_tool.pl index 7b614a8ec..04c024e17 100755 --- a/scripts/dbupgrade2_tool.pl +++ b/scripts/dbupgrade2_tool.pl @@ -1,16 +1,13 @@ #!/usr/bin/perl BEGIN { - if (! -d "bin" || ! -d "SL") { - print("This tool must be run from the kivitendo ERP base directory.\n"); - exit(1); - } + use FindBin; - unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. } - use strict; use warnings; diff --git a/scripts/find-use.pl b/scripts/find-use.pl index 3df14f459..b9220d423 100755 --- a/scripts/find-use.pl +++ b/scripts/find-use.pl @@ -1,4 +1,13 @@ #!/usr/bin/perl -l + +BEGIN { + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. +} + use strict; #use warnings; # corelist and find throw tons of warnings use File::Find; @@ -55,6 +64,8 @@ GetOptions( 'files-with-match|l' => \ my $l, ); +chmod($FindBin::Bin . '/..'); + find(sub { return unless /(\.p[lm]|console)$/; diff --git a/scripts/generate_client_js_actions.pl b/scripts/generate_client_js_actions.pl index a51c669c7..f7f9a16ef 100755 --- a/scripts/generate_client_js_actions.pl +++ b/scripts/generate_client_js_actions.pl @@ -4,10 +4,11 @@ use strict; use warnings; use File::Slurp; +use FindBin; use List::Util qw(first max); use Template; -my $rel_dir = (first { -f "${_}/SL/ClientJS.pm" } qw(. ..)) || die "ClientJS.pm not found"; +my $rel_dir = $FindBin::Bin . '/..'; my @actions; foreach (read_file("${rel_dir}/SL/ClientJS.pm")) { @@ -58,6 +59,6 @@ foreach my $action (@actions) { $output .= sprintf "\n else\%sconsole.log('Unknown action: ' + action[0]);\n", ' ' x (4 + 2 + 6 + 3 + 4 + 2 + $longest + 1); -my $template = Template->new({ RELATIVE => 1 }); +my $template = Template->new({ ABSOLUTE => 1 }); $template->process($rel_dir . '/scripts/generate_client_js_actions.tpl', { actions => $output }, $rel_dir . '/js/client_js.js') || die $template->error(), "\n"; print "js/client_js.js generated automatically.\n"; diff --git a/scripts/installation_check.pl b/scripts/installation_check.pl index 250fe1712..8557f9e9b 100755 --- a/scripts/installation_check.pl +++ b/scripts/installation_check.pl @@ -1,19 +1,23 @@ #!/usr/bin/perl -w -use strict; -use Getopt::Long; -use Pod::Usage; -use Term::ANSIColor; -use Text::Wrap; our $master_templates; BEGIN { - unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. # this is a default dir. may be wrong in your installation, change it then - $master_templates = './templates/print/'; + $master_templates = $FindBin::Bin . '/../templates/print/'; } +use strict; +use Getopt::Long; +use Pod::Usage; +use Term::ANSIColor; +use Text::Wrap; + unless (eval { require Config::Std; 1 }){ print STDERR <new(auth => $auth, path => '../../sql/Pg-upgrade2-auth'); + my $dbu = SL::DBUpgrade2->new(auth => $auth, path => SL::System::Process->exe_dir . '/sql/Pg-upgrade2-auth'); for my $upgrade ($dbu->sort_dbupdate_controls) { for my $string (@{ $upgrade->{locales} || [] }) { diff --git a/scripts/make_docs.pl b/scripts/make_docs.pl old mode 100644 new mode 100755 index f5ec66ef8..8b4f46325 --- a/scripts/make_docs.pl +++ b/scripts/make_docs.pl @@ -4,6 +4,9 @@ use strict; use Pod::Html; use File::Find; +use FindBin; + +chdir($FindBin::Bin . '/..'); my $doc_path = "doc/online"; #my $pod2html_bin = `which pod2html` or die 'cannot find pod2html on your system'; diff --git a/scripts/rose_auto_create_model.pl b/scripts/rose_auto_create_model.pl index 36c78da38..2604fcefa 100755 --- a/scripts/rose_auto_create_model.pl +++ b/scripts/rose_auto_create_model.pl @@ -3,8 +3,11 @@ use strict; BEGIN { - unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. } use CGI qw( -no_xhtml); @@ -30,6 +33,8 @@ use SL::LxOfficeConf; use SL::DB::Helper::ALL; use SL::DB::Helper::Mappings; +chdir($FindBin::Bin . '/..'); + my %blacklist = SL::DB::Helper::Mappings->get_blacklist; my %package_names = SL::DB::Helper::Mappings->get_package_names; diff --git a/scripts/task_server.pl b/scripts/task_server.pl index f22ce13b0..1dbfb4505 100755 --- a/scripts/task_server.pl +++ b/scripts/task_server.pl @@ -1,24 +1,15 @@ #!/usr/bin/perl - -use List::MoreUtils qw(any); - use strict; my $exe_dir; BEGIN { use FindBin; - use lib "$FindBin::Bin/.."; - use SL::System::Process; - $exe_dir = SL::System::Process::exe_dir; - - unshift @INC, "${exe_dir}/modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "${exe_dir}/modules/fallback"; # Only use our own versions of modules if there's no system version. - unshift @INC, $exe_dir; - - chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n"; + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. } use CGI qw( -no_xhtml); @@ -29,6 +20,7 @@ use DateTime; use Encode qw(); use English qw(-no_match_vars); use File::Spec; +use List::MoreUtils qw(any); use List::Util qw(first); use POSIX qw(setuid setgid); use SL::Auth; @@ -43,6 +35,7 @@ use SL::LXDebug; use SL::LxOfficeConf; use SL::Locale; use SL::Mailer; +use SL::System::Process; use SL::System::TaskServer; use Template; @@ -294,7 +287,8 @@ sub gd_run { } } -chdir $exe_dir; +$exe_dir = SL::System::Process->exe_dir; +chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n"; mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE(); diff --git a/t/test.pl b/t/test.pl index d9fdaf495..dcc738b8b 100755 --- a/t/test.pl +++ b/t/test.pl @@ -8,9 +8,15 @@ use Test::Harness qw(runtests execute_tests); use Getopt::Long; BEGIN { - $ENV{HARNESS_OPTIONS} = 'c'; - unshift @INC, 'modules/override'; - push @INC, 'modules/fallback'; + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); # '.' will be removed from @INC soon. + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. + + $ENV{HARNESS_OPTIONS} = 'c'; + + chdir($FindBin::Bin . '/..'); } my @exclude_for_fast = ( -- 2.20.1