Startup: Include-Pfade mittels FindBin ermitteln

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.

diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm
index 5c8280b..496d15f 100644 (file)
--- 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 357f9f8..fbe63f2 100644 (file)
--- 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 4e26c4e..588e87f 100644 (file)
--- 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 482e6d3..36f1f65 100644 (file)
--- 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 c835036..9b7c98b 100755 (executable)
--- 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 433ffe9..e5621f6 100755 (executable)
--- 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 6eed2a0..9ba492f 100755 (executable)
--- 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 7b614a8..04c024e 100755 (executable)
--- 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 3df14f4..b9220d4 100755 (executable)
--- 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 a51c669..f7f9a16 100755 (executable)
--- 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 250fe17..8557f9e 100755 (executable)
--- 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 <<EOL ;
 +------------------------------------------------------------------------------+

diff --git a/scripts/locales.pl b/scripts/locales.pl
index 922f042..2931963 100755 (executable)
--- a/scripts/locales.pl
+++ b/scripts/locales.pl
@@ -10,8 +10,11 @@ use utf8;
 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 . '/..');
+  push   (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version.
 }
 
 use Carp;
@@ -28,6 +31,7 @@ use Pod::Usage;
 use YAML ();
 use YAML::Loader (); # YAML tries to load Y:L at runtime, but can't find it after we chdir'ed
 use SL::DBUpgrade2;
+use SL::System::Process;
 
 $OUTPUT_AUTOFLUSH = 1;
 
@@ -546,7 +550,7 @@ sub scandbupgrades {
   # we only need to do this for auth atm, because only auth scripts can include new rights, which are translateable
   my $auth = 1;
 
-  my $dbu = SL::DBUpgrade2->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 (file)
new mode 100755 (executable)
index f5ec66e..8b4f463
--- 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 36c78da..2604fce 100755 (executable)
--- 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 f22ce13..1dbfb45 100755 (executable)
--- 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 d9fdaf4..dcc738b 100755 (executable)
--- 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 = (