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/Utils.pm | 428 +++++++++++++++++++++++++-------------------------- 1 file changed, 214 insertions(+), 214 deletions(-) (limited to 'lib/OpenSLX/Utils.pm') 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