# Copyright (c) 2006, 2007 - OpenSLX GmbH # # This program is free software distributed under the GPL version 2. # See http://openslx.org/COPYING # # If you have any feedback please consult http://openslx.org/feedback and # send your suggestions, praise, or complaints to feedback@openslx.org # # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Utils.pm # - provides utility functions for OpenSLX # ----------------------------------------------------------------------------- package OpenSLX::Utils; use strict; use warnings; use vars qw(@ISA @EXPORT $VERSION); use Exporter; $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = qw( copyFile fakeFile linkFile slurpFile spitFile followLink unshiftHereDoc ); ################################################################################ ### Module implementation ################################################################################ use File::Basename; 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 || ''; system("mkdir -p $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); system("mkdir", "-p", $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); system("mkdir -p $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 || {}; checkFlags($flags, ['failIfMissing']); my $failIfMissing = exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1; local $/; my $fh; if (!open($fh, '<', $fileName)) { return '' unless $failIfMissing; croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!); } 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 $fh; open($fh, '>', $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, 1, 1) eq '/') { $path = "$prefixedPath/$target"; } else { $path = $prefixedPath . dirname($path) . '/' . $target; } } return $path; } sub unshiftHereDoc { my $content = shift; return $content unless $content =~ m{^(\s+)}; my $shift = length($1); return join "\n", map { substr($_, $shift); } split m{\n}, $content; } 1;