From a0ce0340d0f95514008cfac751fe58748bbadd88 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Thu, 20 Mar 2008 00:04:16 +0000 Subject: * Switched indent used in Perl-code and settings files from tabs to 4 spaces. May need some manual corrections here and there, but should basically be ok. git-svn-id: http://svn.openslx.org/svn/openslx/openslx/trunk@1658 95ad53e4-c205-0410-b2fa-d234c58c8868 --- lib/OpenSLX/Basics.pm | 704 +++++++++++++++++++------------------- lib/OpenSLX/ConfigFolder.pm | 116 +++---- lib/OpenSLX/Translations/de.pm | 486 +++++++++++++------------- lib/OpenSLX/Translations/posix.pm | 486 +++++++++++++------------- lib/OpenSLX/Utils.pm | 428 +++++++++++------------ 5 files changed, 1110 insertions(+), 1110 deletions(-) (limited to 'lib/OpenSLX') diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm index e5a57b15..a9e017d2 100644 --- a/lib/OpenSLX/Basics.pm +++ b/lib/OpenSLX/Basics.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Basics.pm -# - provides basic functionality of the OpenSLX config-db. +# - provides basic functionality of the OpenSLX config-db. # ----------------------------------------------------------------------------- package OpenSLX::Basics; @@ -23,14 +23,14 @@ $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = qw( - &openslxInit %openslxConfig %cmdlineConfig - &_tr &trInit - &warn &die &croak &carp &confess &cluck - &callInSubprocess &executeInSubprocess &slxsystem - &vlog - &checkParams - &instantiateClass - &addCleanupFunction &removeCleanupFunction + &openslxInit %openslxConfig %cmdlineConfig + &_tr &trInit + &warn &die &croak &carp &confess &cluck + &callInSubprocess &executeInSubprocess &slxsystem + &vlog + &checkParams + &instantiateClass + &addCleanupFunction &removeCleanupFunction ); our (%openslxConfig, %cmdlineConfig, %openslxPath); @@ -42,8 +42,8 @@ use open ':utf8'; ################################################################################ ### Module implementation ################################################################################ -require Carp; # do not import anything as we are going to overload carp - # and croak! +require Carp; # do not import anything as we are going to overload carp + # and croak! use Carp::Heavy; # use it here to have it loaded immediately, not at # the time when carp() is being invoked (which might # be at a point in time where the script executes in @@ -62,80 +62,80 @@ my $translations; # the initial content is based on environment variables or default values. # Each value may be overridden from config files and/or cmdline arguments. %openslxConfig = ( - 'db-name' => $ENV{SLX_DB_NAME} || 'openslx', - 'db-spec' => $ENV{SLX_DB_SPEC}, - 'db-type' => $ENV{SLX_DB_TYPE} || 'SQLite', - 'locale' => setlocale(LC_MESSAGES), - 'locale-charmap' => `locale charmap`, - 'base-path' => $ENV{SLX_BASE_PATH} || '/opt/openslx', - 'config-path' => $ENV{SLX_CONFIG_PATH} || '/etc/opt/openslx', - 'private-path' => $ENV{SLX_PRIVATE_PATH} || '/var/opt/openslx', - 'public-path' => $ENV{SLX_PUBLIC_PATH} || '/srv/openslx', - 'temp-path' => $ENV{SLX_TEMP_PATH} || '/tmp', - 'verbose-level' => $ENV{SLX_VERBOSE_LEVEL} || '0', - - # - # options useful during development only: - # - 'debug-confess' => '0', - - # - # extended settings follow, which are only supported by slxsettings, - # but not by any other script: - # - 'db-user' => undef, - 'db-passwd' => undef, - 'default-shell' => 'bash', - 'default-timezone' => 'Europe/Berlin', - 'mirrors-preferred-top-level-domain' => undef, - 'mirrors-to-try-count' => '20', - 'mirrors-to-use-count' => '5', - 'ossetup-max-try-count' => '5', - 'pxe-theme' => undef, - 'pxe-theme-menu-margin' => '9', + 'db-name' => $ENV{SLX_DB_NAME} || 'openslx', + 'db-spec' => $ENV{SLX_DB_SPEC}, + 'db-type' => $ENV{SLX_DB_TYPE} || 'SQLite', + 'locale' => setlocale(LC_MESSAGES), + 'locale-charmap' => `locale charmap`, + 'base-path' => $ENV{SLX_BASE_PATH} || '/opt/openslx', + 'config-path' => $ENV{SLX_CONFIG_PATH} || '/etc/opt/openslx', + 'private-path' => $ENV{SLX_PRIVATE_PATH} || '/var/opt/openslx', + 'public-path' => $ENV{SLX_PUBLIC_PATH} || '/srv/openslx', + 'temp-path' => $ENV{SLX_TEMP_PATH} || '/tmp', + 'verbose-level' => $ENV{SLX_VERBOSE_LEVEL} || '0', + + # + # options useful during development only: + # + 'debug-confess' => '0', + + # + # extended settings follow, which are only supported by slxsettings, + # but not by any other script: + # + 'db-user' => undef, + 'db-passwd' => undef, + 'default-shell' => 'bash', + 'default-timezone' => 'Europe/Berlin', + 'mirrors-preferred-top-level-domain' => undef, + 'mirrors-to-try-count' => '20', + 'mirrors-to-use-count' => '5', + 'ossetup-max-try-count' => '5', + 'pxe-theme' => undef, + 'pxe-theme-menu-margin' => '9', ); chomp($openslxConfig{'locale-charmap'}); # specification of cmdline arguments that are shared by all openslx-scripts: my %openslxCmdlineArgs = ( - # name of database, defaults to 'openslx' - 'db-name=s' => \$cmdlineConfig{'db-name'}, + # name of database, defaults to 'openslx' + 'db-name=s' => \$cmdlineConfig{'db-name'}, - # full specification of database, a special string defining the - # precise database to connect to (the contents of this string - # depend on db-type) - 'db-spec=s' => \$cmdlineConfig{'db-spec'}, + # full specification of database, a special string defining the + # precise database to connect to (the contents of this string + # depend on db-type) + 'db-spec=s' => \$cmdlineConfig{'db-spec'}, - # type of database to connect to (SQLite, mysql, ...), defaults to 'SQLite' - 'db-type=s' => \$cmdlineConfig{'db-type'}, + # type of database to connect to (SQLite, mysql, ...), defaults to 'SQLite' + 'db-type=s' => \$cmdlineConfig{'db-type'}, - # activates debug mode, this will show the lines where any error occured - # (followed by a stacktrace): - 'debug-confess' => \$cmdlineConfig{'debug-confess'}, + # activates debug mode, this will show the lines where any error occured + # (followed by a stacktrace): + 'debug-confess' => \$cmdlineConfig{'debug-confess'}, - # locale to use for translations - 'locale=s' => \$cmdlineConfig{'locale'}, + # locale to use for translations + 'locale=s' => \$cmdlineConfig{'locale'}, - # locale-charmap to use for I/O (iso-8859-1, utf-8, etc.) - 'locale-charmap=s' => \$cmdlineConfig{'locale-charmap'}, + # locale-charmap to use for I/O (iso-8859-1, utf-8, etc.) + 'locale-charmap=s' => \$cmdlineConfig{'locale-charmap'}, - # file to write logging output to, defaults to STDERR - 'logfile=s' => \$cmdlineConfig{'locale'}, + # file to write logging output to, defaults to STDERR + 'logfile=s' => \$cmdlineConfig{'locale'}, - # path to private data (which is *not* accesible by clients and contains - # database, vendorOSes and all local extensions [system specific scripts]) - 'private-path=s' => \$cmdlineConfig{'private-path'}, + # path to private data (which is *not* accesible by clients and contains + # database, vendorOSes and all local extensions [system specific scripts]) + 'private-path=s' => \$cmdlineConfig{'private-path'}, - # path to public data (which is accesible by clients and contains - # PXE-configurations, kernels, initramfs and client configurations) - 'public-path=s' => \$cmdlineConfig{'public-path'}, + # path to public data (which is accesible by clients and contains + # PXE-configurations, kernels, initramfs and client configurations) + 'public-path=s' => \$cmdlineConfig{'public-path'}, - # path to temporary data (used during demuxing) - 'temp-path=s' => \$cmdlineConfig{'temp-path'}, + # path to temporary data (used during demuxing) + 'temp-path=s' => \$cmdlineConfig{'temp-path'}, - # level of logging verbosity (0-3) - 'verbose-level=i' => \$cmdlineConfig{'verbose-level'}, + # level of logging verbosity (0-3) + 'verbose-level=i' => \$cmdlineConfig{'verbose-level'}, ); my %cleanupFunctions; @@ -148,344 +148,344 @@ $Carp::CarpLevel = 1; # ------------------------------------------------------------------------------ sub vlog { - my $minLevel = shift; - return if $minLevel > $openslxConfig{'verbose-level'}; - my $str = join("", '-' x $minLevel, @_); - if (substr($str, -1, 1) ne "\n") { - $str .= "\n"; - } - print $openslxLog $str; - return; + my $minLevel = shift; + return if $minLevel > $openslxConfig{'verbose-level'}; + my $str = join("", '-' x $minLevel, @_); + if (substr($str, -1, 1) ne "\n") { + $str .= "\n"; + } + print $openslxLog $str; + return; } # ------------------------------------------------------------------------------ sub openslxInit { - # evaluate cmdline arguments: - Getopt::Long::Configure('no_pass_through'); - GetOptions(%openslxCmdlineArgs); - - # try to read and evaluate config files: - my $configPath = $cmdlineConfig{'config-path'} - || $openslxConfig{'config-path'}; - my $sharePath = "$openslxConfig{'base-path'}/share"; - my $verboseLevel = $cmdlineConfig{'verbose-level'} || 0; - foreach my $f ("$sharePath/settings.default", "$configPath/settings", - "$ENV{HOME}/.openslx/settings") - { - next unless -e $f; - if ($verboseLevel >= 2) { - vlog(0, "reading config-file $f..."); - } - my $configObject = Config::General->new( - -AutoTrue => 1, - -ConfigFile => $f, - -LowerCaseNames => 1, - -SplitPolicy => 'equalsign', - ); - my %config = $configObject->getall(); - foreach my $key (keys %config) { - # N.B.: these config files are used by shell-scripts, too, so in - # order to comply with shell-style, the config files use shell - # syntax and an uppercase, underline-as-separator format. - # Internally, we use lowercase, minus-as-separator format, so we - # need to convert the environment variable names to our own - # internal style here (e.g. 'SLX_BASE_PATH' to 'base-path'): - my $ourKey = $key; - $ourKey =~ s[^slx_][]; - $ourKey =~ tr/_/-/; - $openslxConfig{$ourKey} = $config{$key}; - } - } - - # push any cmdline argument into our config hash, possibly overriding any - # setting from the config files: - while (my ($key, $val) = each(%cmdlineConfig)) { - next unless defined $val; - $openslxConfig{$key} = $val; - } - - if (defined $openslxConfig{'logfile'}) { - open($openslxLog, '>>', $openslxConfig{'logfile'}) - or croak( - _tr( - "unable to append to logfile '%s'! (%s)", - $openslxConfig{'logfile'}, $! - ) - ); - } - if ($openslxConfig{'verbose-level'} >= 2) { - foreach my $key (sort keys %openslxConfig) { - my $val = $openslxConfig{$key} || ''; - vlog(2, "config-dump: $key = $val"); - } - } - - # setup translation "engine": - trInit(); - - return 1; + # evaluate cmdline arguments: + Getopt::Long::Configure('no_pass_through'); + GetOptions(%openslxCmdlineArgs); + + # try to read and evaluate config files: + my $configPath = $cmdlineConfig{'config-path'} + || $openslxConfig{'config-path'}; + my $sharePath = "$openslxConfig{'base-path'}/share"; + my $verboseLevel = $cmdlineConfig{'verbose-level'} || 0; + foreach my $f ("$sharePath/settings.default", "$configPath/settings", + "$ENV{HOME}/.openslx/settings") + { + next unless -e $f; + if ($verboseLevel >= 2) { + vlog(0, "reading config-file $f..."); + } + my $configObject = Config::General->new( + -AutoTrue => 1, + -ConfigFile => $f, + -LowerCaseNames => 1, + -SplitPolicy => 'equalsign', + ); + my %config = $configObject->getall(); + foreach my $key (keys %config) { + # N.B.: these config files are used by shell-scripts, too, so in + # order to comply with shell-style, the config files use shell + # syntax and an uppercase, underline-as-separator format. + # Internally, we use lowercase, minus-as-separator format, so we + # need to convert the environment variable names to our own + # internal style here (e.g. 'SLX_BASE_PATH' to 'base-path'): + my $ourKey = $key; + $ourKey =~ s[^slx_][]; + $ourKey =~ tr/_/-/; + $openslxConfig{$ourKey} = $config{$key}; + } + } + + # push any cmdline argument into our config hash, possibly overriding any + # setting from the config files: + while (my ($key, $val) = each(%cmdlineConfig)) { + next unless defined $val; + $openslxConfig{$key} = $val; + } + + if (defined $openslxConfig{'logfile'}) { + open($openslxLog, '>>', $openslxConfig{'logfile'}) + or croak( + _tr( + "unable to append to logfile '%s'! (%s)", + $openslxConfig{'logfile'}, $! + ) + ); + } + if ($openslxConfig{'verbose-level'} >= 2) { + foreach my $key (sort keys %openslxConfig) { + my $val = $openslxConfig{$key} || ''; + vlog(2, "config-dump: $key = $val"); + } + } + + # setup translation "engine": + trInit(); + + return 1; } # ------------------------------------------------------------------------------ sub trInit { - # activate automatic charset conversion on all the standard I/O streams, - # just to give *some* support to shells in other charsets: - binmode(STDIN, ":encoding($openslxConfig{'locale-charmap'})"); - binmode(STDOUT, ":encoding($openslxConfig{'locale-charmap'})"); - binmode(STDERR, ":encoding($openslxConfig{'locale-charmap'})"); - - my $locale = $openslxConfig{'locale'}; - if (lc($locale) eq 'c') { - # treat locale 'c' as equivalent for 'posix': - $locale = 'posix'; - } - - if (lc($locale) ne 'posix') { - # parse locale and canonicalize it (e.g. to 'de_DE') and generate - # two filenames from it (language+country and language only): - if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) { - die "locale $locale has unknown format!?!"; - } - my @locales; - if (defined $2) { - push @locales, lc($1) . '_' . uc($2); - } - push @locales, lc($1); - - # try to load any of the Translation modules (starting with the more - # specific one [language+country]): - my $loadedTranslationModule; - foreach my $trName (@locales) { - vlog(2, "trying to load translation module $trName..."); - my $trModule = "OpenSLX/Translations/$trName.pm"; - my $trModuleSpec = "OpenSLX::Translations::$trName"; - if (eval { require $trModule } ) { - # copy the translations available in the given locale into our - # hash: - $translations = $trModuleSpec->getAllTranslations(); - $loadedTranslationModule = $trModule; - vlog( - 1, - _tr( - "translations module %s loaded successfully", $trModule - ) - ); - last; - } - } - if (!defined $loadedTranslationModule) { - vlog(1, - "unable to load any translations module for locale '$locale' ($!)." - ); - } - } - return; + # activate automatic charset conversion on all the standard I/O streams, + # just to give *some* support to shells in other charsets: + binmode(STDIN, ":encoding($openslxConfig{'locale-charmap'})"); + binmode(STDOUT, ":encoding($openslxConfig{'locale-charmap'})"); + binmode(STDERR, ":encoding($openslxConfig{'locale-charmap'})"); + + my $locale = $openslxConfig{'locale'}; + if (lc($locale) eq 'c') { + # treat locale 'c' as equivalent for 'posix': + $locale = 'posix'; + } + + if (lc($locale) ne 'posix') { + # parse locale and canonicalize it (e.g. to 'de_DE') and generate + # two filenames from it (language+country and language only): + if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) { + die "locale $locale has unknown format!?!"; + } + my @locales; + if (defined $2) { + push @locales, lc($1) . '_' . uc($2); + } + push @locales, lc($1); + + # try to load any of the Translation modules (starting with the more + # specific one [language+country]): + my $loadedTranslationModule; + foreach my $trName (@locales) { + vlog(2, "trying to load translation module $trName..."); + my $trModule = "OpenSLX/Translations/$trName.pm"; + my $trModuleSpec = "OpenSLX::Translations::$trName"; + if (eval { require $trModule } ) { + # copy the translations available in the given locale into our + # hash: + $translations = $trModuleSpec->getAllTranslations(); + $loadedTranslationModule = $trModule; + vlog( + 1, + _tr( + "translations module %s loaded successfully", $trModule + ) + ); + last; + } + } + if (!defined $loadedTranslationModule) { + vlog(1, + "unable to load any translations module for locale '$locale' ($!)." + ); + } + } + return; } # ------------------------------------------------------------------------------ sub _tr { - my $trOrig = shift; - - my $trKey = $trOrig; - $trKey =~ s[\n][\\n]g; - $trKey =~ s[\t][\\t]g; - - my $formatStr; - if (defined $translations) { - $formatStr = $translations->{$trKey}; - } - if (!defined $formatStr) { - $formatStr = $trOrig; - } - return sprintf($formatStr, @_); + my $trOrig = shift; + + my $trKey = $trOrig; + $trKey =~ s[\n][\\n]g; + $trKey =~ s[\t][\\t]g; + + my $formatStr; + if (defined $translations) { + $formatStr = $translations->{$trKey}; + } + if (!defined $formatStr) { + $formatStr = $trOrig; + } + return sprintf($formatStr, @_); } # ------------------------------------------------------------------------------ sub callInSubprocess { - my $childFunc = shift; - - my $pid = fork(); - if (!$pid) { - - # child... - # ...execute the given function and exit: - my $ok = eval { $childFunc->(); 1 }; - if (!$ok) { - print STDERR "*** $@"; - exit 5; - } - exit 0; - } - - # parent... - # ...pass on interrupt- and terminate-signals to child... - local $SIG{INT} = sub { kill 'INT', $pid; waitpid($pid, 0); exit $? }; - local $SIG{TERM} = sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? }; - - # ...and wait for child to do its work: - waitpid($pid, 0); - if ($?) { - exit $?; - } - return; + my $childFunc = shift; + + my $pid = fork(); + if (!$pid) { + + # child... + # ...execute the given function and exit: + my $ok = eval { $childFunc->(); 1 }; + if (!$ok) { + print STDERR "*** $@"; + exit 5; + } + exit 0; + } + + # parent... + # ...pass on interrupt- and terminate-signals to child... + local $SIG{INT} = sub { kill 'INT', $pid; waitpid($pid, 0); exit $? }; + local $SIG{TERM} = sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? }; + + # ...and wait for child to do its work: + waitpid($pid, 0); + if ($?) { + exit $?; + } + return; } # ------------------------------------------------------------------------------ sub executeInSubprocess { - my @cmdlineArgs = @_; + my @cmdlineArgs = @_; - my $pid = fork(); - if (!$pid) { + my $pid = fork(); + if (!$pid) { - # child... - # ...exec the given cmdline: - exec(@cmdlineArgs); - } + # child... + # ...exec the given cmdline: + exec(@cmdlineArgs); + } - # parent... - return $pid; + # parent... + return $pid; } # ------------------------------------------------------------------------------ sub addCleanupFunction { - my $name = shift; - my $func = shift; + my $name = shift; + my $func = shift; - $cleanupFunctions{$name} = $func; - return; + $cleanupFunctions{$name} = $func; + return; } # ------------------------------------------------------------------------------ sub removeCleanupFunction { - my $name = shift; + my $name = shift; - delete $cleanupFunctions{$name}; - return; + delete $cleanupFunctions{$name}; + return; } # ------------------------------------------------------------------------------ sub invokeCleanupFunctions { - my @funcNames = keys %cleanupFunctions; - foreach my $name (@funcNames) { - vlog(2, "invoking cleanup function '$name'..."); - $cleanupFunctions{$name}->(); - } - return; + my @funcNames = keys %cleanupFunctions; + foreach my $name (@funcNames) { + vlog(2, "invoking cleanup function '$name'..."); + $cleanupFunctions{$name}->(); + } + return; } # ------------------------------------------------------------------------------ sub slxsystem { - vlog(2, _tr("executing: %s", join ' ', @_)); - my $res = system(@_); - if ($res > 0) { - # check if child got killed, if so we stop, too (unless the signal is - # SIGPIPE, which we ignore in order to loop over failed FTP connections - # and the like): - my $signalNo = $res & 127; - if ($signalNo > 0 && $signalNo != 13) { - die _tr("child-process reveived signal '%s', parent stops!", - $signalNo); - } - } - return $res; + vlog(2, _tr("executing: %s", join ' ', @_)); + my $res = system(@_); + if ($res > 0) { + # check if child got killed, if so we stop, too (unless the signal is + # SIGPIPE, which we ignore in order to loop over failed FTP connections + # and the like): + my $signalNo = $res & 127; + if ($signalNo > 0 && $signalNo != 13) { + die _tr("child-process reveived signal '%s', parent stops!", + $signalNo); + } + } + return $res; } # ------------------------------------------------------------------------------ sub cluck { - _doThrowOrWarn('cluck', @_); - return; + _doThrowOrWarn('cluck', @_); + return; } # ------------------------------------------------------------------------------ sub carp { - _doThrowOrWarn('carp', @_); - return; + _doThrowOrWarn('carp', @_); + return; } # ------------------------------------------------------------------------------ sub warn { - _doThrowOrWarn('warn', @_); - return; + _doThrowOrWarn('warn', @_); + return; } # ------------------------------------------------------------------------------ sub confess { - invokeCleanupFunctions(); - _doThrowOrWarn('confess', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('confess', @_); + return; } # ------------------------------------------------------------------------------ sub croak { - invokeCleanupFunctions(); - _doThrowOrWarn('croak', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('croak', @_); + return; } # ------------------------------------------------------------------------------ sub die { - invokeCleanupFunctions(); - _doThrowOrWarn('die', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('die', @_); + return; } # ------------------------------------------------------------------------------ sub _doThrowOrWarn { - my $type = shift; - my $msg = shift; - - # use '°°°' for warnings and '***' for errors - if ($type eq 'carp' || $type eq 'warn' || $type eq 'cluck') { - $msg =~ s[^°°° ][]igms; - $msg =~ s[^][°°° ]igms; - } - else { - $msg =~ s[^\*\*\* ][]igms; - $msg =~ s[^][*** ]igms; - } - - if ($openslxConfig{'debug-confess'}) { - my %functionFor = ( - 'carp' => sub { Carp::cluck @_ }, - 'cluck' => sub { Carp::cluck @_ }, - 'confess' => sub { Carp::confess @_ }, - 'croak' => sub { Carp::confess @_ }, - 'die' => sub { Carp::confess @_ }, - 'warn' => sub { Carp::cluck @_ }, - ); - my $func = $functionFor{$type}; - $func->($msg); - } - else { - chomp $msg; - my %functionFor = ( - 'carp' => sub { Carp::carp @_ }, - 'cluck' => sub { Carp::cluck @_ }, - 'confess' => sub { Carp::confess @_ }, - 'croak' => sub { Carp::croak @_ }, - 'die' => sub { CORE::die @_}, - 'warn' => sub { CORE::warn @_ }, - ); - my $func = $functionFor{$type}; - $func->("$msg\n"); - } - return; + my $type = shift; + my $msg = shift; + + # use '°°°' for warnings and '***' for errors + if ($type eq 'carp' || $type eq 'warn' || $type eq 'cluck') { + $msg =~ s[^°°° ][]igms; + $msg =~ s[^][°°° ]igms; + } + else { + $msg =~ s[^\*\*\* ][]igms; + $msg =~ s[^][*** ]igms; + } + + if ($openslxConfig{'debug-confess'}) { + my %functionFor = ( + 'carp' => sub { Carp::cluck @_ }, + 'cluck' => sub { Carp::cluck @_ }, + 'confess' => sub { Carp::confess @_ }, + 'croak' => sub { Carp::confess @_ }, + 'die' => sub { Carp::confess @_ }, + 'warn' => sub { Carp::cluck @_ }, + ); + my $func = $functionFor{$type}; + $func->($msg); + } + else { + chomp $msg; + my %functionFor = ( + 'carp' => sub { Carp::carp @_ }, + 'cluck' => sub { Carp::cluck @_ }, + 'confess' => sub { Carp::confess @_ }, + 'croak' => sub { Carp::croak @_ }, + 'die' => sub { CORE::die @_}, + 'warn' => sub { CORE::warn @_ }, + ); + my $func = $functionFor{$type}; + $func->("$msg\n"); + } + return; } =item checkParams() @@ -598,36 +598,36 @@ sub checkParams # ------------------------------------------------------------------------------ sub instantiateClass { - my $class = shift; - my $flags = shift || {}; - - checkParams($flags, { - 'pathToClass' => '?', - 'version' => '?' - }); - my $pathToClass = $flags->{pathToClass}; - my $requestedVersion = $flags->{version}; - - my $moduleName = defined $pathToClass ? "$pathToClass/$class" : $class; - $moduleName =~ s[::][/]g; - $moduleName .= '.pm'; - unless (eval { require $moduleName } ) { - if ($! == 2) { - die _tr("Module '%s' not found!\n", $moduleName); - } - else { - die _tr("Unable to load module '%s' (%s)\n", $moduleName, $@); - } - } - if (defined $requestedVersion) { - my $classVersion = $class->VERSION; - if ($classVersion < $requestedVersion) { - die _tr( - 'Could not load class <%s> (Version <%s> required, but <%s> found)', - $class, $requestedVersion, $classVersion); - } - } - return $class->new; + my $class = shift; + my $flags = shift || {}; + + checkParams($flags, { + 'pathToClass' => '?', + 'version' => '?' + }); + my $pathToClass = $flags->{pathToClass}; + my $requestedVersion = $flags->{version}; + + my $moduleName = defined $pathToClass ? "$pathToClass/$class" : $class; + $moduleName =~ s[::][/]g; + $moduleName .= '.pm'; + unless (eval { require $moduleName } ) { + if ($! == 2) { + die _tr("Module '%s' not found!\n", $moduleName); + } + else { + die _tr("Unable to load module '%s' (%s)\n", $moduleName, $@); + } + } + if (defined $requestedVersion) { + my $classVersion = $class->VERSION; + if ($classVersion < $requestedVersion) { + die _tr( + 'Could not load class <%s> (Version <%s> required, but <%s> found)', + $class, $requestedVersion, $classVersion); + } + } + return $class->new; } 1; diff --git a/lib/OpenSLX/ConfigFolder.pm b/lib/OpenSLX/ConfigFolder.pm index 99289881..e8c3ee8f 100644 --- a/lib/OpenSLX/ConfigFolder.pm +++ b/lib/OpenSLX/ConfigFolder.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # ConfigFolder.pm -# - provides utility functions for generation of configuration folders +# - provides utility functions for generation of configuration folders # ----------------------------------------------------------------------------- package OpenSLX::ConfigFolder; @@ -23,8 +23,8 @@ $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = qw( - &createConfigFolderForDefaultSystem - &createConfigFolderForSystem + &createConfigFolderForDefaultSystem + &createConfigFolderForSystem ); ################################################################################ @@ -35,68 +35,68 @@ use OpenSLX::Utils; sub createConfigFolderForDefaultSystem { - my $result = 0; - my $defaultConfigPath = "$openslxConfig{'private-path'}/config/default"; - if (!-e "$defaultConfigPath/initramfs") { - slxsystem("mkdir -p $defaultConfigPath/initramfs"); - $result = 1; - } - if (!-e "$defaultConfigPath/rootfs") { - slxsystem("mkdir -p $defaultConfigPath/rootfs"); - $result = 1; - } + my $result = 0; + my $defaultConfigPath = "$openslxConfig{'private-path'}/config/default"; + if (!-e "$defaultConfigPath/initramfs") { + slxsystem("mkdir -p $defaultConfigPath/initramfs"); + $result = 1; + } + if (!-e "$defaultConfigPath/rootfs") { + slxsystem("mkdir -p $defaultConfigPath/rootfs"); + $result = 1; + } - # create default pre-/postinit scripts for us in initramfs: - my $preInitFile = "$defaultConfigPath/initramfs/preinit.local"; - if (!-e $preInitFile) { - my $preInit = unshiftHereDoc(<<' END-of-HERE'); - #!/bin/sh - # - # This script allows the local admin to extend the - # capabilities at the beginning of the initramfs (stage3). - # The toolset is rather limited and you have to keep in mind - # that stage4 rootfs has the prefix '/mnt'. - END-of-HERE - spitFile($preInitFile, $preInit); - slxsystem("chmod u+x $preInitFile"); - $result = 1; - } + # create default pre-/postinit scripts for us in initramfs: + my $preInitFile = "$defaultConfigPath/initramfs/preinit.local"; + if (!-e $preInitFile) { + my $preInit = unshiftHereDoc(<<' END-of-HERE'); + #!/bin/sh + # + # This script allows the local admin to extend the + # capabilities at the beginning of the initramfs (stage3). + # The toolset is rather limited and you have to keep in mind + # that stage4 rootfs has the prefix '/mnt'. + END-of-HERE + spitFile($preInitFile, $preInit); + slxsystem("chmod u+x $preInitFile"); + $result = 1; + } - my $postInitFile = "$defaultConfigPath/initramfs/postinit.local"; - if (!-e $postInitFile) { - my $postInit = unshiftHereDoc(<<' END-of-HERE'); - #!/bin/sh - # - # This script allows the local admin to extend the - # capabilities at the end of the initramfs (stage3). - # The toolset is rather limited and you have to keep in mind - # that stage4 rootfs has the prefix '/mnt'. - # But you may use some special slx-functions available via - # inclusion: '. /etc/functions' ... - END-of-HERE - spitFile($postInitFile, $postInit); - slxsystem("chmod u+x $postInitFile"); - $result = 1; - } - return $result; + my $postInitFile = "$defaultConfigPath/initramfs/postinit.local"; + if (!-e $postInitFile) { + my $postInit = unshiftHereDoc(<<' END-of-HERE'); + #!/bin/sh + # + # This script allows the local admin to extend the + # capabilities at the end of the initramfs (stage3). + # The toolset is rather limited and you have to keep in mind + # that stage4 rootfs has the prefix '/mnt'. + # But you may use some special slx-functions available via + # inclusion: '. /etc/functions' ... + END-of-HERE + spitFile($postInitFile, $postInit); + slxsystem("chmod u+x $postInitFile"); + $result = 1; + } + return $result; } sub createConfigFolderForSystem { - my $systemName = shift || confess "need to pass in system-name!"; + my $systemName = shift || confess "need to pass in system-name!"; - my $result = 0; - my $systemConfigPath - = "$openslxConfig{'private-path'}/config/$systemName/default"; - if (!-e "$systemConfigPath/initramfs") { - slxsystem("mkdir -p $systemConfigPath/initramfs"); - $result = 1; - } - if (!-e "$systemConfigPath/rootfs") { - slxsystem("mkdir -p $systemConfigPath/rootfs"); - $result = 1; - } - return $result; + my $result = 0; + my $systemConfigPath + = "$openslxConfig{'private-path'}/config/$systemName/default"; + if (!-e "$systemConfigPath/initramfs") { + slxsystem("mkdir -p $systemConfigPath/initramfs"); + $result = 1; + } + if (!-e "$systemConfigPath/rootfs") { + slxsystem("mkdir -p $systemConfigPath/rootfs"); + $result = 1; + } + return $result; } 1; diff --git a/lib/OpenSLX/Translations/de.pm b/lib/OpenSLX/Translations/de.pm index e98edd03..b0783b81 100644 --- a/lib/OpenSLX/Translations/de.pm +++ b/lib/OpenSLX/Translations/de.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # de.pm -# - OpenSLX-translations for the German language. +# - OpenSLX-translations for the German language. # ----------------------------------------------------------------------------- package OpenSLX::Translations::de; @@ -25,8 +25,8 @@ my %translations; ################################################################################ sub getAllTranslations { - my $class = shift; - return \%translations; + my $class = shift; + return \%translations; } ################################################################################ @@ -34,325 +34,325 @@ sub getAllTranslations ################################################################################ %translations = ( - q{NEW:%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} - => - qq{}, + q{NEW:%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} + => + qq{}, - q{NEW:%s has wrong bitwidth (%s instead of %s)} - => - qq{}, + q{NEW:%s has wrong bitwidth (%s instead of %s)} + => + qq{}, - q{NEW:%s: ignored, as it isn't an executable or a shared library\n} - => - qq{}, + q{NEW:%s: ignored, as it isn't an executable or a shared library\n} + => + qq{}, - q{NEW:'%s' already exists!\n} - => - qq{}, + q{NEW:'%s' already exists!\n} + => + qq{}, - q{NEW:'%s' not found, maybe wrong root-path?\n} - => - qq{}, + q{NEW:'%s' not found, maybe wrong root-path?\n} + => + qq{}, - q{NEW:\trpath='%s'\n} - => - qq{}, + q{NEW:\trpath='%s'\n} + => + qq{}, - q{NEW:\ttrying objdump...\n} - => - qq{}, + q{NEW:\ttrying objdump...\n} + => + qq{}, - q{NEW:\ttrying readelf...\n} - => - qq{}, + q{NEW:\ttrying readelf...\n} + => + qq{}, - q{NEW:analyzing '%s'...\n} - => - qq{}, + q{NEW:analyzing '%s'...\n} + => + qq{}, - q{NEW:Can't add column to table <%s> (%s)} - => - qq{}, + q{NEW:Can't add column to table <%s> (%s)} + => + qq{}, - q{NEW:Can't add columns to table <%s> (%s)} - => - qq{}, + q{NEW:Can't add columns to table <%s> (%s)} + => + qq{}, - q{NEW:Can't change columns in table <%s> (%s)} - => - qq{}, + q{NEW:Can't change columns in table <%s> (%s)} + => + qq{}, - q{NEW:Can't create table <%s> (%s)} - => - qq{}, + q{NEW:Can't create table <%s> (%s)} + => + qq{}, - q{NEW:Can't delete from table <%s> (%s)} - => - qq{}, + q{NEW:Can't delete from table <%s> (%s)} + => + qq{}, - q{NEW:Can't drop columns from table <%s> (%s)} - => - qq{}, + q{NEW:Can't drop columns from table <%s> (%s)} + => + qq{}, - q{NEW:Can't drop table <%s> (%s)} - => - qq{}, + q{NEW:Can't drop table <%s> (%s)} + => + qq{}, - q{NEW:Can't execute SQL-statement <%s> (%s)} - => - qq{}, + q{NEW:Can't execute SQL-statement <%s> (%s)} + => + qq{}, - q{NEW:Can't insert into table <%s> (%s)} - => - qq{}, + q{NEW:Can't insert into table <%s> (%s)} + => + qq{}, - q{NEW:Can't lock ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't lock ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't open ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't open ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't prepare SQL-statement <%s> (%s)} - => - qq{}, + q{NEW:Can't prepare SQL-statement <%s> (%s)} + => + qq{}, - q{NEW:Can't rename table <%s> (%s)} - => - qq{}, + q{NEW:Can't rename table <%s> (%s)} + => + qq{}, - q{NEW:Can't to seek ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't to seek ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't truncate ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't truncate ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't update ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't update ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't update table <%s> (%s)} - => - qq{}, + q{NEW:Can't update table <%s> (%s)} + => + qq{}, - q{NEW:Cannot connect to database <%s> (%s)} - => - qq{}, + q{NEW:Cannot connect to database <%s> (%s)} + => + qq{}, - q{NEW:config-file <%s> has incorrect syntax here:\n\t%s\n} - => - qq{}, + q{NEW:config-file <%s> has incorrect syntax here:\n\t%s\n} + => + qq{}, - q{NEW:copying kernel %s to %s/kernel} - => - qq{}, + q{NEW:copying kernel %s to %s/kernel} + => + qq{}, - q{Could not determine schema version of database} - => - qq{Die Version des Datenbank-Schemas konnte nicht bestimmt werden}, + q{Could not determine schema version of database} + => + qq{Die Version des Datenbank-Schemas konnte nicht bestimmt werden}, - q{NEW:Could not load module <%s> (Version <%s> required, but <%s> found)} - => - qq{}, + q{NEW:Could not load module <%s> (Version <%s> required, but <%s> found)} + => + qq{}, - q{NEW:creating tar %s} - => - qq{}, + q{NEW:creating tar %s} + => + qq{}, - q{NEW:DB matches current schema version %s} - => - qq{}, + q{NEW:DB matches current schema version %s} + => + qq{}, - q{NEW:executing %s} - => - qq{}, + q{NEW:executing %s} + => + qq{}, - q{NEW:exporting client %d:%s} - => - qq{}, + q{NEW:exporting client %d:%s} + => + qq{}, - q{NEW:exporting system %d:%s} - => - qq{}, + q{NEW:exporting system %d:%s} + => + qq{}, - q{NEW:generating initialramfs %s/initramfs} - => - qq{}, + q{NEW:generating initialramfs %s/initramfs} + => + qq{}, - q{NEW:ignoring unknown key <%s>} - => - qq{}, + q{NEW:ignoring unknown key <%s>} + => + qq{}, - q{NEW:List of supported systems:\n\t} - => - qq{}, + q{NEW:List of supported systems:\n\t} + => + qq{}, - q{NEW:Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} - => - qq{}, + q{NEW:Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} + => + qq{}, - q{NEW:merging %s (val=%s)} - => - qq{}, + q{NEW:merging %s (val=%s)} + => + qq{}, - q{NEW:merging from default client...} - => - qq{}, + q{NEW:merging from default client...} + => + qq{}, - q{NEW:merging from group %d:%s...} - => - qq{}, + q{NEW:merging from group %d:%s...} + => + qq{}, - q{NEW:neither objdump nor readelf seems to be installed, giving up!\n} - => - qq{}, + q{NEW:neither objdump nor readelf seems to be installed, giving up!\n} + => + qq{}, - q{no} - => - qq{nein}, + q{no} + => + qq{nein}, - q{NEW:Our schema-version is %s, DB is %s, upgrading DB...} - => - qq{}, + q{NEW:Our schema-version is %s, DB is %s, upgrading DB...} + => + qq{}, - q{NEW:PXE-system %s already exists!} - => - qq{}, + q{NEW:PXE-system %s already exists!} + => + qq{}, - q{NEW:removing %s} - => - qq{}, + q{NEW:removing %s} + => + qq{}, - q{NEW:setting %s to <%s>} - => - qq{}, + q{NEW:setting %s to <%s>} + => + qq{}, - q{NEW:slxldd: unable to find file '%s', skipping it\n} - => - qq{}, + q{NEW:slxldd: unable to find file '%s', skipping it\n} + => + qq{}, - q{NEW:Sorry, system '%s' is unsupported.\n} - => - qq{}, + q{NEW:Sorry, system '%s' is unsupported.\n} + => + qq{}, - q{NEW:system-error: illegal target-path <%s>!} - => - qq{}, + q{NEW:system-error: illegal target-path <%s>!} + => + qq{}, - q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } - => - qq{Die aktuelle OpenSLX-Datenbank wird mit einem Beispiel-Datensatz überschrieben.\nAlle Daten (%s Systeme und %s Clients) werden gelöscht!\nMöchten Sie den Vorgang fortsetzen(%s/%s)? }, + q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } + => + qq{Die aktuelle OpenSLX-Datenbank wird mit einem Beispiel-Datensatz überschrieben.\nAlle Daten (%s Systeme und %s Clients) werden gelöscht!\nMöchten Sie den Vorgang fortsetzen(%s/%s)? }, - q{NEW:translations module %s loaded successfully} - => - qq{}, + q{NEW:translations module %s loaded successfully} + => + qq{}, - q{NEW:Unable to access client-config-path '%s'!} - => - qq{}, + q{NEW:Unable to access client-config-path '%s'!} + => + qq{}, - q{NEW:unable to create db-datadir %s! (%s)\n} - => - qq{}, + q{NEW:unable to create db-datadir %s! (%s)\n} + => + qq{}, - q{NEW:Unable to create lock-file <%s>, exiting!\n} - => - qq{}, + q{NEW:Unable to create lock-file <%s>, exiting!\n} + => + qq{}, - q{NEW:Unable to create or access temp-path '%s'!} - => - qq{}, + q{NEW:Unable to create or access temp-path '%s'!} + => + qq{}, - q{NEW:Unable to create or access tftpboot-path '%s'!} - => - qq{}, + q{NEW:Unable to create or access tftpboot-path '%s'!} + => + qq{}, - q{NEW:unable to execute shell-command:\n\t%s \n\t(%s)} - => - qq{}, + q{NEW:unable to execute shell-command:\n\t%s \n\t(%s)} + => + qq{}, - q{NEW:unable to fetch file info for '%s', giving up!\n} - => - qq{}, + q{NEW:unable to fetch file info for '%s', giving up!\n} + => + qq{}, - q{NEW:Unable to load DB-module <%s> (%s)\n} - => - qq{}, + q{NEW:Unable to load DB-module <%s> (%s)\n} + => + qq{}, - q{NEW:Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} - => - qq{}, + q{NEW:Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} + => + qq{}, - q{NEW:unable to load DHCP-Export backend '%s'! (%s)\n} - => - qq{}, + q{NEW:unable to load DHCP-Export backend '%s'! (%s)\n} + => + qq{}, - q{NEW:Unable to load module <%s> (Version <%s> required)} - => - qq{}, + q{NEW:Unable to load module <%s> (Version <%s> required)} + => + qq{}, - q{NEW:Unable to load module <%s> (Version <%s> required, but <%s> found)} - => - qq{}, + q{NEW:Unable to load module <%s> (Version <%s> required, but <%s> found)} + => + qq{}, - q{NEW:Unable to load system-module <%s> (%s)\n} - => - qq{}, + q{NEW:Unable to load system-module <%s> (%s)\n} + => + qq{}, - q{NEW:Unable to load system-module <%s>!\n} - => - qq{}, + q{NEW:Unable to load system-module <%s>!\n} + => + qq{}, - q{NEW:Unable to write local settings file <%s> (%s)} - => - qq{}, + q{NEW:Unable to write local settings file <%s> (%s)} + => + qq{}, - q{NEW:unknown settings key <%s>!\n} - => - qq{}, + q{NEW:unknown settings key <%s>!\n} + => + qq{}, - q{NEW:UnknownDbSchemaColumnDescr} - => - qq{}, + q{NEW:UnknownDbSchemaColumnDescr} + => + qq{}, - q{UnknownDbSchemaCommand} - => - qq{Unbekannter DbSchema-Befehl <%s> wird übergangen}, + q{UnknownDbSchemaCommand} + => + qq{Unbekannter DbSchema-Befehl <%s> wird übergangen}, - q{NEW:UnknownDbSchemaTypeDescr} - => - qq{}, + q{NEW:UnknownDbSchemaTypeDescr} + => + qq{}, - q{NEW:upgrade done} - => - qq{}, + q{NEW:upgrade done} + => + qq{}, - q{NEW:writing dhcp-config for %s clients} - => - qq{}, + q{NEW:writing dhcp-config for %s clients} + => + qq{}, - q{NEW:writing PXE-file %s} - => - qq{}, + q{NEW:writing PXE-file %s} + => + qq{}, - q{yes} - => - qq{ja}, + q{yes} + => + qq{ja}, - q{NEW:You need to specify at least one file!\n} - => - qq{}, + q{NEW:You need to specify at least one file!\n} + => + qq{}, - q{NEW:You need to specify exactly one system name!\n} - => - qq{}, + q{NEW:You need to specify exactly one system name!\n} + => + qq{}, - q{NEW:You need to specify the root-path!\n} - => - qq{}, + q{NEW:You need to specify the root-path!\n} + => + qq{}, ); diff --git a/lib/OpenSLX/Translations/posix.pm b/lib/OpenSLX/Translations/posix.pm index 05e16ed5..61a94c93 100644 --- a/lib/OpenSLX/Translations/posix.pm +++ b/lib/OpenSLX/Translations/posix.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # posix.pm -# - OpenSLX-translations for the posix locale (English language). +# - OpenSLX-translations for the posix locale (English language). # ----------------------------------------------------------------------------- package OpenSLX::Translations::posix; @@ -25,8 +25,8 @@ my %translations; ################################################################################ sub getAllTranslations { - my $class = shift; - return \%translations; + my $class = shift; + return \%translations; } ################################################################################ @@ -34,325 +34,325 @@ sub getAllTranslations ################################################################################ %translations = ( - q{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} - => - qq{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n}, + q{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} + => + qq{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n}, - q{%s has wrong bitwidth (%s instead of %s)} - => - qq{%s has wrong bitwidth (%s instead of %s)}, + q{%s has wrong bitwidth (%s instead of %s)} + => + qq{%s has wrong bitwidth (%s instead of %s)}, - q{%s: ignored, as it isn't an executable or a shared library\n} - => - qq{%s: ignored, as it isn't an executable or a shared library\n}, + q{%s: ignored, as it isn't an executable or a shared library\n} + => + qq{%s: ignored, as it isn't an executable or a shared library\n}, - q{'%s' already exists!\n} - => - qq{'%s' already exists!\n}, + q{'%s' already exists!\n} + => + qq{'%s' already exists!\n}, - q{'%s' not found, maybe wrong root-path?\n} - => - qq{'%s' not found, maybe wrong root-path?\n}, + q{'%s' not found, maybe wrong root-path?\n} + => + qq{'%s' not found, maybe wrong root-path?\n}, - q{\trpath='%s'\n} - => - qq{\trpath='%s'\n}, + q{\trpath='%s'\n} + => + qq{\trpath='%s'\n}, - q{\ttrying objdump...\n} - => - qq{\ttrying objdump...\n}, + q{\ttrying objdump...\n} + => + qq{\ttrying objdump...\n}, - q{\ttrying readelf...\n} - => - qq{\ttrying readelf...\n}, + q{\ttrying readelf...\n} + => + qq{\ttrying readelf...\n}, - q{analyzing '%s'...\n} - => - qq{analyzing '%s'...\n}, + q{analyzing '%s'...\n} + => + qq{analyzing '%s'...\n}, - q{Can't add column to table <%s> (%s)} - => - qq{Can't add column to table <%s> (%s)}, + q{Can't add column to table <%s> (%s)} + => + qq{Can't add column to table <%s> (%s)}, - q{Can't add columns to table <%s> (%s)} - => - qq{Can't add columns to table <%s> (%s)}, + q{Can't add columns to table <%s> (%s)} + => + qq{Can't add columns to table <%s> (%s)}, - q{Can't change columns in table <%s> (%s)} - => - qq{Can't change columns in table <%s> (%s)}, + q{Can't change columns in table <%s> (%s)} + => + qq{Can't change columns in table <%s> (%s)}, - q{Can't create table <%s> (%s)} - => - qq{Can't create table <%s> (%s)}, + q{Can't create table <%s> (%s)} + => + qq{Can't create table <%s> (%s)}, - q{Can't delete from table <%s> (%s)} - => - qq{Can't delete from table <%s> (%s)}, + q{Can't delete from table <%s> (%s)} + => + qq{Can't delete from table <%s> (%s)}, - q{Can't drop columns from table <%s> (%s)} - => - qq{Can't drop columns from table <%s> (%s)}, + q{Can't drop columns from table <%s> (%s)} + => + qq{Can't drop columns from table <%s> (%s)}, - q{Can't drop table <%s> (%s)} - => - qq{Can't drop table <%s> (%s)}, + q{Can't drop table <%s> (%s)} + => + qq{Can't drop table <%s> (%s)}, - q{Can't execute SQL-statement <%s> (%s)} - => - qq{Can't execute SQL-statement <%s> (%s)}, + q{Can't execute SQL-statement <%s> (%s)} + => + qq{Can't execute SQL-statement <%s> (%s)}, - q{Can't insert into table <%s> (%s)} - => - qq{Can't insert into table <%s> (%s)}, + q{Can't insert into table <%s> (%s)} + => + qq{Can't insert into table <%s> (%s)}, - q{Can't lock ID-file <%s> (%s)} - => - qq{Can't lock ID-file <%s> (%s)}, + q{Can't lock ID-file <%s> (%s)} + => + qq{Can't lock ID-file <%s> (%s)}, - q{Can't open ID-file <%s> (%s)} - => - qq{Can't open ID-file <%s> (%s)}, + q{Can't open ID-file <%s> (%s)} + => + qq{Can't open ID-file <%s> (%s)}, - q{Can't prepare SQL-statement <%s> (%s)} - => - qq{Can't prepare SQL-statement <%s> (%s)}, + q{Can't prepare SQL-statement <%s> (%s)} + => + qq{Can't prepare SQL-statement <%s> (%s)}, - q{Can't rename table <%s> (%s)} - => - qq{Can't rename table <%s> (%s)}, + q{Can't rename table <%s> (%s)} + => + qq{Can't rename table <%s> (%s)}, - q{Can't to seek ID-file <%s> (%s)} - => - qq{Can't to seek ID-file <%s> (%s)}, + q{Can't to seek ID-file <%s> (%s)} + => + qq{Can't to seek ID-file <%s> (%s)}, - q{Can't truncate ID-file <%s> (%s)} - => - qq{Can't truncate ID-file <%s> (%s)}, + q{Can't truncate ID-file <%s> (%s)} + => + qq{Can't truncate ID-file <%s> (%s)}, - q{Can't update ID-file <%s> (%s)} - => - qq{Can't update ID-file <%s> (%s)}, + q{Can't update ID-file <%s> (%s)} + => + qq{Can't update ID-file <%s> (%s)}, - q{Can't update table <%s> (%s)} - => - qq{Can't update table <%s> (%s)}, + q{Can't update table <%s> (%s)} + => + qq{Can't update table <%s> (%s)}, - q{Cannot connect to database <%s> (%s)} - => - qq{Cannot connect to database <%s> (%s)}, + q{Cannot connect to database <%s> (%s)} + => + qq{Cannot connect to database <%s> (%s)}, - q{config-file <%s> has incorrect syntax here:\n\t%s\n} - => - qq{config-file <%s> has incorrect syntax here:\n\t%s\n}, + q{config-file <%s> has incorrect syntax here:\n\t%s\n} + => + qq{config-file <%s> has incorrect syntax here:\n\t%s\n}, - q{copying kernel %s to %s/kernel} - => - qq{copying kernel %s to %s/kernel}, + q{copying kernel %s to %s/kernel} + => + qq{copying kernel %s to %s/kernel}, - q{Could not determine schema version of database} - => - qq{Could not determine schema version of database}, + q{Could not determine schema version of database} + => + qq{Could not determine schema version of database}, - q{Could not load module <%s> (Version <%s> required, but <%s> found)} - => - qq{Could not load module <%s> (Version <%s> required, but <%s> found)}, + q{Could not load module <%s> (Version <%s> required, but <%s> found)} + => + qq{Could not load module <%s> (Version <%s> required, but <%s> found)}, - q{creating tar %s} - => - qq{creating tar %s}, + q{creating tar %s} + => + qq{creating tar %s}, - q{DB matches current schema version %s} - => - qq{DB matches current schema version %s}, + q{DB matches current schema version %s} + => + qq{DB matches current schema version %s}, - q{executing %s} - => - qq{executing %s}, + q{executing %s} + => + qq{executing %s}, - q{exporting client %d:%s} - => - qq{exporting client %d:%s}, + q{exporting client %d:%s} + => + qq{exporting client %d:%s}, - q{exporting system %d:%s} - => - qq{exporting system %d:%s}, + q{exporting system %d:%s} + => + qq{exporting system %d:%s}, - q{generating initialramfs %s/initramfs} - => - qq{generating initialramfs %s/initramfs}, + q{generating initialramfs %s/initramfs} + => + qq{generating initialramfs %s/initramfs}, - q{ignoring unknown key <%s>} - => - qq{ignoring unknown key <%s>}, + q{ignoring unknown key <%s>} + => + qq{ignoring unknown key <%s>}, - q{List of supported systems:\n\t} - => - qq{List of supported systems:\n\t}, + q{List of supported systems:\n\t} + => + qq{List of supported systems:\n\t}, - q{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} - => - qq{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n}, + q{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} + => + qq{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n}, - q{merging %s (val=%s)} - => - qq{merging %s (val=%s)}, + q{merging %s (val=%s)} + => + qq{merging %s (val=%s)}, - q{merging from default client...} - => - qq{merging from default client...}, + q{merging from default client...} + => + qq{merging from default client...}, - q{merging from group %d:%s...} - => - qq{merging from group %d:%s...}, + q{merging from group %d:%s...} + => + qq{merging from group %d:%s...}, - q{neither objdump nor readelf seems to be installed, giving up!\n} - => - qq{neither objdump nor readelf seems to be installed, giving up!\n}, + q{neither objdump nor readelf seems to be installed, giving up!\n} + => + qq{neither objdump nor readelf seems to be installed, giving up!\n}, - q{no} - => - qq{no}, + q{no} + => + qq{no}, - q{Our schema-version is %s, DB is %s, upgrading DB...} - => - qq{Our schema-version is %s, DB is %s, upgrading DB...}, + q{Our schema-version is %s, DB is %s, upgrading DB...} + => + qq{Our schema-version is %s, DB is %s, upgrading DB...}, - q{PXE-system %s already exists!} - => - qq{PXE-system %s already exists!}, + q{PXE-system %s already exists!} + => + qq{PXE-system %s already exists!}, - q{removing %s} - => - qq{removing %s}, + q{removing %s} + => + qq{removing %s}, - q{setting %s to <%s>} - => - qq{setting %s to <%s>}, + q{setting %s to <%s>} + => + qq{setting %s to <%s>}, - q{slxldd: unable to find file '%s', skipping it\n} - => - qq{slxldd: unable to find file '%s', skipping it\n}, + q{slxldd: unable to find file '%s', skipping it\n} + => + qq{slxldd: unable to find file '%s', skipping it\n}, - q{Sorry, system '%s' is unsupported.\n} - => - qq{Sorry, system '%s' is unsupported.\n}, + q{Sorry, system '%s' is unsupported.\n} + => + qq{Sorry, system '%s' is unsupported.\n}, - q{system-error: illegal target-path <%s>!} - => - qq{system-error: illegal target-path <%s>!}, + q{system-error: illegal target-path <%s>!} + => + qq{system-error: illegal target-path <%s>!}, - q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } - => - qq{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? }, + q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } + => + qq{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? }, - q{translations module %s loaded successfully} - => - qq{translations module %s loaded successfully}, + q{translations module %s loaded successfully} + => + qq{translations module %s loaded successfully}, - q{Unable to access client-config-path '%s'!} - => - qq{Unable to access client-config-path '%s'!}, + q{Unable to access client-config-path '%s'!} + => + qq{Unable to access client-config-path '%s'!}, - q{unable to create db-datadir %s! (%s)\n} - => - qq{unable to create db-datadir %s! (%s)\n}, + q{unable to create db-datadir %s! (%s)\n} + => + qq{unable to create db-datadir %s! (%s)\n}, - q{Unable to create lock-file <%s>, exiting!\n} - => - qq{Unable to create lock-file <%s>, exiting!\n}, + q{Unable to create lock-file <%s>, exiting!\n} + => + qq{Unable to create lock-file <%s>, exiting!\n}, - q{Unable to create or access temp-path '%s'!} - => - qq{Unable to create or access temp-path '%s'!}, + q{Unable to create or access temp-path '%s'!} + => + qq{Unable to create or access temp-path '%s'!}, - q{Unable to create or access tftpboot-path '%s'!} - => - qq{Unable to create or access tftpboot-path '%s'!}, + q{Unable to create or access tftpboot-path '%s'!} + => + qq{Unable to create or access tftpboot-path '%s'!}, - q{unable to execute shell-command:\n\t%s \n\t(%s)} - => - qq{unable to execute shell-command:\n\t%s \n\t(%s)}, + q{unable to execute shell-command:\n\t%s \n\t(%s)} + => + qq{unable to execute shell-command:\n\t%s \n\t(%s)}, - q{unable to fetch file info for '%s', giving up!\n} - => - qq{unable to fetch file info for '%s', giving up!\n}, + q{unable to fetch file info for '%s', giving up!\n} + => + qq{unable to fetch file info for '%s', giving up!\n}, - q{Unable to load DB-module <%s> (%s)\n} - => - qq{Unable to load DB-module <%s> (%s)\n}, + q{Unable to load DB-module <%s> (%s)\n} + => + qq{Unable to load DB-module <%s> (%s)\n}, - q{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} - => - qq{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n}, + q{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} + => + qq{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n}, - q{unable to load DHCP-Export backend '%s'! (%s)\n} - => - qq{unable to load DHCP-Export backend '%s'! (%s)\n}, + q{unable to load DHCP-Export backend '%s'! (%s)\n} + => + qq{unable to load DHCP-Export backend '%s'! (%s)\n}, - q{Unable to load module <%s> (Version <%s> required)} - => - qq{Unable to load module <%s> (Version <%s> required)}, + q{Unable to load module <%s> (Version <%s> required)} + => + qq{Unable to load module <%s> (Version <%s> required)}, - q{Unable to load module <%s> (Version <%s> required, but <%s> found)} - => - qq{Unable to load module <%s> (Version <%s> required, but <%s> found)}, + q{Unable to load module <%s> (Version <%s> required, but <%s> found)} + => + qq{Unable to load module <%s> (Version <%s> required, but <%s> found)}, - q{Unable to load system-module <%s> (%s)\n} - => - qq{Unable to load system-module <%s> (%s)\n}, + q{Unable to load system-module <%s> (%s)\n} + => + qq{Unable to load system-module <%s> (%s)\n}, - q{Unable to load system-module <%s>!\n} - => - qq{Unable to load system-module <%s>!\n}, + q{Unable to load system-module <%s>!\n} + => + qq{Unable to load system-module <%s>!\n}, - q{Unable to write local settings file <%s> (%s)} - => - qq{Unable to write local settings file <%s> (%s)}, + q{Unable to write local settings file <%s> (%s)} + => + qq{Unable to write local settings file <%s> (%s)}, - q{unknown settings key <%s>!\n} - => - qq{unknown settings key <%s>!\n}, + q{unknown settings key <%s>!\n} + => + qq{unknown settings key <%s>!\n}, - q{UnknownDbSchemaColumnDescr} - => - qq{UnknownDbSchemaColumnDescr}, + q{UnknownDbSchemaColumnDescr} + => + qq{UnknownDbSchemaColumnDescr}, - q{UnknownDbSchemaCommand} - => - qq{UnknownDbSchemaCommand}, + q{UnknownDbSchemaCommand} + => + qq{UnknownDbSchemaCommand}, - q{UnknownDbSchemaTypeDescr} - => - qq{UnknownDbSchemaTypeDescr}, + q{UnknownDbSchemaTypeDescr} + => + qq{UnknownDbSchemaTypeDescr}, - q{upgrade done} - => - qq{upgrade done}, + q{upgrade done} + => + qq{upgrade done}, - q{writing dhcp-config for %s clients} - => - qq{writing dhcp-config for %s clients}, + q{writing dhcp-config for %s clients} + => + qq{writing dhcp-config for %s clients}, - q{writing PXE-file %s} - => - qq{writing PXE-file %s}, + q{writing PXE-file %s} + => + qq{writing PXE-file %s}, - q{yes} - => - qq{yes}, + q{yes} + => + qq{yes}, - q{You need to specify at least one file!\n} - => - qq{You need to specify at least one file!\n}, + q{You need to specify at least one file!\n} + => + qq{You need to specify at least one file!\n}, - q{You need to specify exactly one system name!\n} - => - qq{You need to specify exactly one system name!\n}, + q{You need to specify exactly one system name!\n} + => + qq{You need to specify exactly one system name!\n}, - q{You need to specify the root-path!\n} - => - qq{You need to specify the root-path!\n}, + q{You need to specify the root-path!\n} + => + qq{You need to specify the root-path!\n}, ); diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm index 9d8b4599..130a3a01 100644 --- a/lib/OpenSLX/Utils.pm +++ b/lib/OpenSLX/Utils.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Utils.pm -# - provides utility functions for OpenSLX +# - provides utility functions for OpenSLX # ----------------------------------------------------------------------------- package OpenSLX::Utils; @@ -49,280 +49,280 @@ use OpenSLX::Basics; sub copyFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $targetDir = shift || croak 'need to pass in target dir!'; - my $targetFileName = shift || ''; - - mkpath($targetDir) unless -d $targetDir; - my $target = "$targetDir/$targetFileName"; - vlog(2, _tr("copying '%s' to '%s'", $fileName, $target)); - if (system("cp -p $fileName $target")) { - croak( - _tr( - "unable to copy file '%s' to dir '%s' (%s)", - $fileName, $target, $! - ) - ); - } - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $targetDir = shift || croak 'need to pass in target dir!'; + my $targetFileName = shift || ''; + + mkpath($targetDir) unless -d $targetDir; + my $target = "$targetDir/$targetFileName"; + vlog(2, _tr("copying '%s' to '%s'", $fileName, $target)); + if (system("cp -p $fileName $target")) { + croak( + _tr( + "unable to copy file '%s' to dir '%s' (%s)", + $fileName, $target, $! + ) + ); + } + return; } sub fakeFile { - my $fullPath = shift || croak 'need to pass in full path!'; - - my $targetDir = dirname($fullPath); - mkpath($targetDir) unless -d $targetDir; - if (system("touch", $fullPath)) { - croak(_tr("unable to create file '%s' (%s)", $fullPath, $!)); - } - return; + my $fullPath = shift || croak 'need to pass in full path!'; + + my $targetDir = dirname($fullPath); + mkpath($targetDir) unless -d $targetDir; + if (system("touch", $fullPath)) { + croak(_tr("unable to create file '%s' (%s)", $fullPath, $!)); + } + return; } sub linkFile { - my $linkTarget = shift || croak 'need to pass in link target!'; - my $linkName = shift || croak 'need to pass in link name!'; - - my $targetDir = dirname($linkName); - mkpath($targetDir) unless -d $targetDir; - if (system("ln -sfn $linkTarget $linkName")) { - croak( - _tr( - "unable to create link '%s' to '%s' (%s)", - $linkName, $linkTarget, $! - ) - ); - } - return; + my $linkTarget = shift || croak 'need to pass in link target!'; + my $linkName = shift || croak 'need to pass in link name!'; + + my $targetDir = dirname($linkName); + mkpath($targetDir) unless -d $targetDir; + if (system("ln -sfn $linkTarget $linkName")) { + croak( + _tr( + "unable to create link '%s' to '%s' (%s)", + $linkName, $linkTarget, $! + ) + ); + } + return; } sub slurpFile { - my $fileName = shift || confess 'need to pass in fileName!'; - my $flags = shift || {}; - - checkParams($flags, { - 'failIfMissing' => '?', - 'io-layer' => '?', - }); - my $failIfMissing - = exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1; - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - if (!open($fh, "<:$ioLayer", $fileName)) { - return '' unless $failIfMissing; - croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!); - } - if (wantarray()) { - my @content = <$fh>; - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return @content; - } - else { - local $/; - my $content = <$fh>; - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return $content; - } + my $fileName = shift || confess 'need to pass in fileName!'; + my $flags = shift || {}; + + checkParams($flags, { + 'failIfMissing' => '?', + 'io-layer' => '?', + }); + my $failIfMissing + = exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1; + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + if (!open($fh, "<:$ioLayer", $fileName)) { + return '' unless $failIfMissing; + croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!); + } + if (wantarray()) { + my @content = <$fh>; + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return @content; + } + else { + local $/; + my $content = <$fh>; + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return $content; + } } sub spitFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $content = shift || ''; - my $flags = shift || {}; - - checkParams($flags, { - 'io-layer' => '?', - 'mode' => '?', - }); - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - open($fh, ">:$ioLayer", $fileName) - or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); - print $fh $content - or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - if (defined $flags->{mode}) { - chmod $flags->{mode}, $fileName; - } - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $content = shift || ''; + my $flags = shift || {}; + + checkParams($flags, { + 'io-layer' => '?', + 'mode' => '?', + }); + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + open($fh, ">:$ioLayer", $fileName) + or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); + print $fh $content + or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + if (defined $flags->{mode}) { + chmod $flags->{mode}, $fileName; + } + return; } sub appendFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $content = shift; - my $flags = shift || {}; - - checkParams($flags, { - 'io-layer' => '?', - }); - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - open($fh, ">>:$ioLayer", $fileName) - or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); - print $fh $content - or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $content = shift; + my $flags = shift || {}; + + checkParams($flags, { + 'io-layer' => '?', + }); + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + open($fh, ">>:$ioLayer", $fileName) + or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); + print $fh $content + or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return; } sub followLink { - my $path = shift || croak 'need to pass in a path!'; - my $prefixedPath = shift || ''; - - my $target; - while (-l "$path") { - $target = readlink "$path"; - if (substr($target, 0, 1) eq '/') { - $path = "$prefixedPath$target"; - } - else { - $path = $prefixedPath . dirname($path) . '/' . $target; - } - } - return $path; + my $path = shift || croak 'need to pass in a path!'; + my $prefixedPath = shift || ''; + + my $target; + while (-l "$path") { + $target = readlink "$path"; + if (substr($target, 0, 1) eq '/') { + $path = "$prefixedPath$target"; + } + else { + $path = $prefixedPath . dirname($path) . '/' . $target; + } + } + return $path; } sub copyBinaryWithRequiredLibs { - my $params = shift; - - checkParams($params, { - 'binary' => '!', # file to copy - 'targetFolder' => '!', # where file shall be copied to - 'libTargetFolder' => '!', # base target folder for libs - 'targetName' => '?', # name of binary in target folder - }); - copyFile($params->{binary}, $params->{targetFolder}, $params->{targetName}); - - # determine all required libraries and copy those, too: - vlog(1, _tr("calling slxldd for $params->{binary}")); - my $slxlddCmd = "slxldd $params->{binary}"; - vlog(2, "executing: $slxlddCmd"); - my $requiredLibsStr = qx{$slxlddCmd}; - if ($?) { - die _tr( - "slxldd couldn't determine the libs required by '%s'! (%s)", - $params->{binary}, $? - ); - } - chomp $requiredLibsStr; - vlog(2, "slxldd results:\n$requiredLibsStr"); - - foreach my $lib (split "\n", $requiredLibsStr) { - my $libDir = dirname($lib); - my $targetLib = "$params->{libTargetFolder}$libDir"; - next if -e "$targetLib/$lib"; - vlog(3, "copying lib '$lib'"); - copyFile($lib, $targetLib); - } - return $requiredLibsStr; + my $params = shift; + + checkParams($params, { + 'binary' => '!', # file to copy + 'targetFolder' => '!', # where file shall be copied to + 'libTargetFolder' => '!', # base target folder for libs + 'targetName' => '?', # name of binary in target folder + }); + copyFile($params->{binary}, $params->{targetFolder}, $params->{targetName}); + + # determine all required libraries and copy those, too: + vlog(1, _tr("calling slxldd for $params->{binary}")); + my $slxlddCmd = "slxldd $params->{binary}"; + vlog(2, "executing: $slxlddCmd"); + my $requiredLibsStr = qx{$slxlddCmd}; + if ($?) { + die _tr( + "slxldd couldn't determine the libs required by '%s'! (%s)", + $params->{binary}, $? + ); + } + chomp $requiredLibsStr; + vlog(2, "slxldd results:\n$requiredLibsStr"); + + foreach my $lib (split "\n", $requiredLibsStr) { + my $libDir = dirname($lib); + my $targetLib = "$params->{libTargetFolder}$libDir"; + next if -e "$targetLib/$lib"; + vlog(3, "copying lib '$lib'"); + copyFile($lib, $targetLib); + } + return $requiredLibsStr; } sub unshiftHereDoc { - my $content = shift; - return $content unless $content =~ m{^(\s+)}; - my $shiftStr = $1; - $content =~ s[^$shiftStr][]gms; - return $content; + my $content = shift; + return $content unless $content =~ m{^(\s+)}; + my $shiftStr = $1; + $content =~ s[^$shiftStr][]gms; + return $content; } sub string2Array { - my $string = shift || ''; + my $string = shift || ''; - my @lines = split m[\n], $string; - for my $line (@lines) { - # remove leading and trailing whitespace: - $line =~ s{^\s*(.*?)\s*$}{$1}; - } + my @lines = split m[\n], $string; + for my $line (@lines) { + # remove leading and trailing whitespace: + $line =~ s{^\s*(.*?)\s*$}{$1}; + } - # drop empty lines and comments: - return grep { length($_) > 0 && $_ !~ m[^\s*#]; } @lines; + # drop empty lines and comments: + return grep { length($_) > 0 && $_ !~ m[^\s*#]; } @lines; } sub chrootInto { - my $osDir = shift; + my $osDir = shift; - vlog(2, "chrooting into $osDir..."); - chdir $osDir - or die _tr("unable to chdir into '%s' (%s)\n", $osDir, $!); + vlog(2, "chrooting into $osDir..."); + chdir $osDir + or die _tr("unable to chdir into '%s' (%s)\n", $osDir, $!); - # ...do chroot - chroot "." - or die _tr("unable to chroot into '%s' (%s)\n", $osDir, $!); - return; + # ...do chroot + chroot "." + or die _tr("unable to chroot into '%s' (%s)\n", $osDir, $!); + return; } sub mergeHash { - my $targetHash = shift; - my $sourceHash = shift; - my $fillOnly = shift || 0; - - foreach my $key (keys %{$sourceHash}) { - my $sourceVal = $sourceHash->{$key}; - if (ref($sourceVal) eq 'HASH') { - if (!exists $targetHash->{$key}) { - $targetHash->{$key} = {}; - } - mergeHash($targetHash->{$key}, $sourceVal); - } - elsif (ref($sourceVal) eq 'ARRAY') { - if (!exists $targetHash->{$key}) { - $targetHash->{$key} = []; - } - foreach my $val (@{$sourceHash->{$key}}) { - my $targetVal = {}; - push @{$targetHash->{$key}}, $targetVal; - mergeHash($targetVal, $sourceVal); - } - } - else { - next if $fillOnly && exists $targetHash->{$key}; - $targetHash->{$key} = $sourceVal; - } - } + my $targetHash = shift; + my $sourceHash = shift; + my $fillOnly = shift || 0; + + foreach my $key (keys %{$sourceHash}) { + my $sourceVal = $sourceHash->{$key}; + if (ref($sourceVal) eq 'HASH') { + if (!exists $targetHash->{$key}) { + $targetHash->{$key} = {}; + } + mergeHash($targetHash->{$key}, $sourceVal); + } + elsif (ref($sourceVal) eq 'ARRAY') { + if (!exists $targetHash->{$key}) { + $targetHash->{$key} = []; + } + foreach my $val (@{$sourceHash->{$key}}) { + my $targetVal = {}; + push @{$targetHash->{$key}}, $targetVal; + mergeHash($targetVal, $sourceVal); + } + } + else { + next if $fillOnly && exists $targetHash->{$key}; + $targetHash->{$key} = $sourceVal; + } + } } sub getFQDN { - my $hostName = hostname(); - - my $hostAddr = gethostbyname($hostName) - or die(_tr("unable to get address of host '%s'", $hostName)); - my $FQDN = gethostbyaddr($hostAddr, AF_INET) - or die(_tr("unable to get dns-name of address '%s'", $hostAddr)); - return $FQDN; + my $hostName = hostname(); + + my $hostAddr = gethostbyname($hostName) + or die(_tr("unable to get address of host '%s'", $hostName)); + my $FQDN = gethostbyaddr($hostAddr, AF_INET) + or die(_tr("unable to get dns-name of address '%s'", $hostAddr)); + return $FQDN; } sub readPassword { - my $prompt = shift; - - my $term = Term::ReadLine->new('slx'); - my $attribs = $term->Attribs; - $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; + my $prompt = shift; + + my $term = Term::ReadLine->new('slx'); + my $attribs = $term->Attribs; + $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; return $term->readline($prompt); } sub hostIs64Bit { - my $arch = qx{uname -m}; - return $arch =~ m[64]; + my $arch = qx{uname -m}; + return $arch =~ m[64]; } 1; -- cgit v1.2.3-55-g7522