summaryrefslogtreecommitdiffstats
path: root/lib/OpenSLX
diff options
context:
space:
mode:
authorOliver Tappe2008-03-20 01:04:16 +0100
committerOliver Tappe2008-03-20 01:04:16 +0100
commita0ce0340d0f95514008cfac751fe58748bbadd88 (patch)
tree844bb9e015f2fbcd83de54c3a63dd027b1218211 /lib/OpenSLX
parent* fixed several bugs with respect to the listing of plugins (as part of a system (diff)
downloadcore-a0ce0340d0f95514008cfac751fe58748bbadd88.tar.gz
core-a0ce0340d0f95514008cfac751fe58748bbadd88.tar.xz
core-a0ce0340d0f95514008cfac751fe58748bbadd88.zip
* 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
Diffstat (limited to 'lib/OpenSLX')
-rw-r--r--lib/OpenSLX/Basics.pm704
-rw-r--r--lib/OpenSLX/ConfigFolder.pm116
-rw-r--r--lib/OpenSLX/Translations/de.pm486
-rw-r--r--lib/OpenSLX/Translations/posix.pm486
-rw-r--r--lib/OpenSLX/Utils.pm428
5 files changed, 1110 insertions, 1110 deletions
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;