From d28054e9c562e102b89b6fe617fbaf45fd4468b3 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Mon, 12 Mar 2007 18:21:08 +0000 Subject: * added Utils.pm that contains helpful functions used throughout OpenSLX git-svn-id: http://svn.openslx.org/svn/openslx/trunk@758 95ad53e4-c205-0410-b2fa-d234c58c8868 --- lib/OpenSLX/Utils.pm | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 lib/OpenSLX/Utils.pm (limited to 'lib/OpenSLX/Utils.pm') diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm new file mode 100644 index 00000000..3ec46dea --- /dev/null +++ b/lib/OpenSLX/Utils.pm @@ -0,0 +1,78 @@ +# Utils.pm - provides utility functions for OpenSLX +# +# (c) 2006 - OpenSLX.com +# +# Oliver Tappe +# +package OpenSLX::Utils; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); + +use Exporter; +$VERSION = 1.01; +@ISA = qw(Exporter); + +@EXPORT = qw( + ©File &fakeFile &linkFile &slurpFile +); + +################################################################################ +### Module implementation +################################################################################ +use Carp; +use OpenSLX::Basics; + +sub copyFile +{ + my $fileName = shift; + my $dirName = shift; + + my $baseName = basename($fileName); + my $targetName = "$dirName/$baseName"; + if (!-e $targetName) { + my $targetDir = dirname($targetName); + system("mkdir -p $targetDir") unless -d $targetDir; + if (system("cp -p $fileName $targetDir/")) { + die _tr("unable to copy file '%s' to dir '%s' (%s)", + $fileName, $targetDir, $!); + } + } +} + +sub fakeFile +{ + my $fullPath = shift; + + my $targetDir = dirname($fullPath); + system("mkdir", "-p", $targetDir) unless -d $targetDir; + if (system("touch", $fullPath)) { + die _tr("unable to create file '%s' (%s)", + $fullPath, $!); + } +} + +sub linkFile +{ + my $linkTarget = shift; + my $linkName = shift; + + my $targetDir = dirname($linkName); + system("mkdir -p $targetDir") unless -d $targetDir; + if (system("ln -s $linkTarget $linkName")) { + die _tr("unable to create link '%s' to '%s' (%s)", + $linkName, $linkTarget, $!); + } +} + +sub slurpFile +{ + my $file = shift; + open(F, "< $file") + or die _tr("could not open file '%s' for reading! (%s)", $file, $!); + $/ = undef; + my $text = ; + close(F); + return $text; +} +1; \ No newline at end of file -- cgit v1.2.3-55-g7522