mirror of
https://github.com/pgbackrest/pgbackrest.git
synced 2024-12-14 10:13:05 +02:00
874 lines
25 KiB
Perl
874 lines
25 KiB
Perl
####################################################################################################################################
|
|
# FILE COMMON MODULE
|
|
####################################################################################################################################
|
|
package pgBackRest::FileCommon;
|
|
|
|
use strict;
|
|
use warnings FATAL => qw(all);
|
|
use Carp qw(confess);
|
|
use English '-no_match_vars';
|
|
|
|
use Digest::SHA;
|
|
use Exporter qw(import);
|
|
our @EXPORT = qw();
|
|
use Fcntl qw(:mode :flock O_RDONLY O_WRONLY O_CREAT O_TRUNC);
|
|
use File::Basename qw(dirname);
|
|
use File::Path qw(make_path);
|
|
use File::stat;
|
|
use IO::Handle;
|
|
|
|
use pgBackRest::Common::Exception;
|
|
use pgBackRest::Common::Log;
|
|
|
|
####################################################################################################################################
|
|
# Default modes
|
|
####################################################################################################################################
|
|
my $strPathModeDefault = '0750';
|
|
my $strFileModeDefault = '0640';
|
|
|
|
####################################################################################################################################
|
|
# fileExists
|
|
#
|
|
# Check if a path or file exists.
|
|
####################################################################################################################################
|
|
sub fileExists
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileExists', \@_,
|
|
{name => 'strFile', required => true, trace => true}
|
|
);
|
|
|
|
# Working variables
|
|
my $bExists = true;
|
|
|
|
# Stat the file/path to determine if it exists
|
|
my $oStat = lstat($strFile);
|
|
|
|
# Evaluate error
|
|
if (!defined($oStat))
|
|
{
|
|
my $strError = $!;
|
|
|
|
# If the error is not entry missing, then throw error
|
|
if (!$!{ENOENT})
|
|
{
|
|
confess &log(ERROR, "unable to read ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
|
|
}
|
|
|
|
$bExists = false;
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'bExists', value => $bExists, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileExists);
|
|
|
|
####################################################################################################################################
|
|
# fileHash
|
|
#
|
|
# Get the file hash and size.
|
|
####################################################################################################################################
|
|
sub fileHash
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile,
|
|
$bCompressed,
|
|
$strHashType
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileHash', \@_,
|
|
{name => 'strFile', trace => true},
|
|
{name => 'bCompressed', default => false, trace => true},
|
|
{name => 'strHashType', default => 'sha1', trace => true}
|
|
);
|
|
|
|
# Working variables
|
|
my ($strHash) = fileHashSize($strFile, $bCompressed, $strHashType);
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'strHash', value => $strHash, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileHash);
|
|
|
|
####################################################################################################################################
|
|
# fileHashSize
|
|
#
|
|
# Get the file hash and size.
|
|
####################################################################################################################################
|
|
sub fileHashSize
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile,
|
|
$bCompressed,
|
|
$strHashType,
|
|
$oProtocol
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileHashSize', \@_,
|
|
{name => 'strFile', trace => true},
|
|
{name => 'bCompressed', default => false, trace => true},
|
|
{name => 'strHashType', default => 'sha1', trace => true},
|
|
{name => 'oProtocol', required => false, trace => true}
|
|
);
|
|
|
|
# Working variables
|
|
my $strHash;
|
|
my $iSize = 0;
|
|
my $hFile;
|
|
|
|
if (!sysopen($hFile, $strFile, O_RDONLY))
|
|
{
|
|
my $strError = $!;
|
|
|
|
# If file exists then throw the error
|
|
if (fileExists($strFile))
|
|
{
|
|
confess &log(ERROR, "unable to open ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
|
|
}
|
|
|
|
confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
|
|
}
|
|
|
|
my $oSHA = Digest::SHA->new($strHashType);
|
|
|
|
if ($bCompressed)
|
|
{
|
|
# ??? Not crazy about pushing the protocol object in here. Probably binaryXfer() should be refactored into a standalone
|
|
# function in this file.
|
|
if (!defined($oProtocol))
|
|
{
|
|
confess &log(ASSERT, "oProtocol must be provided to hash compressed file");
|
|
}
|
|
|
|
($strHash, $iSize) =
|
|
$oProtocol->binaryXfer($hFile, 'none', 'in', true, false, false);
|
|
}
|
|
else
|
|
{
|
|
my $iBlockSize;
|
|
my $tBuffer;
|
|
|
|
do
|
|
{
|
|
# Read a block from the file
|
|
$iBlockSize = sysread($hFile, $tBuffer, 4194304);
|
|
|
|
if (!defined($iBlockSize))
|
|
{
|
|
confess &log(ERROR, "${strFile} could not be read: " . $!, ERROR_FILE_READ);
|
|
}
|
|
|
|
$iSize += $iBlockSize;
|
|
$oSHA->add($tBuffer);
|
|
}
|
|
while ($iBlockSize > 0);
|
|
|
|
$strHash = $oSHA->hexdigest();
|
|
}
|
|
|
|
close($hFile);
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'strHash', value => $strHash, trace => true},
|
|
{name => 'iSize', value => $iSize, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileHashSize);
|
|
|
|
####################################################################################################################################
|
|
# fileList
|
|
#
|
|
# List a directory with filters and ordering.
|
|
####################################################################################################################################
|
|
sub fileList
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strPath,
|
|
$strExpression,
|
|
$strSortOrder,
|
|
$bIgnoreMissing
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileList', \@_,
|
|
{name => 'strPath', trace => true},
|
|
{name => 'strExpression', required => false, trace => true},
|
|
{name => 'strSortOrder', default => 'forward', trace => true},
|
|
{name => 'bIgnoreMissing', default => false, trace => true}
|
|
);
|
|
|
|
# Working variables
|
|
my @stryFileList;
|
|
my $hPath;
|
|
|
|
# Attempt to open the path
|
|
if (opendir($hPath, $strPath))
|
|
{
|
|
@stryFileList = grep(!/^(\.)|(\.\.)$/i, readdir($hPath));
|
|
close($hPath);
|
|
|
|
# Apply expression if defined
|
|
if (defined($strExpression))
|
|
{
|
|
@stryFileList = grep(/$strExpression/i, @stryFileList);
|
|
}
|
|
|
|
# Reverse sort
|
|
if ($strSortOrder eq 'reverse')
|
|
{
|
|
@stryFileList = sort {$b cmp $a} @stryFileList;
|
|
}
|
|
# Normal sort
|
|
else
|
|
{
|
|
@stryFileList = sort @stryFileList;
|
|
}
|
|
}
|
|
# Else process errors
|
|
else
|
|
{
|
|
my $strError = $!;
|
|
|
|
# If path exists then throw the error
|
|
if (fileExists($strPath))
|
|
{
|
|
confess &log(ERROR, "unable to read ${strPath}" . (defined($strError) ? ": $strError" : ''), ERROR_PATH_OPEN);
|
|
}
|
|
# Else throw an error unless missing paths are ignored
|
|
elsif (!$bIgnoreMissing)
|
|
{
|
|
confess &log(ERROR, "${strPath} does not exist", ERROR_PATH_MISSING);
|
|
}
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'stryFileList', value => \@stryFileList, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileList);
|
|
|
|
####################################################################################################################################
|
|
# fileMode
|
|
#
|
|
# Set the file mode.
|
|
####################################################################################################################################
|
|
sub fileMode
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile,
|
|
$strMode,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileMode', \@_,
|
|
{name => 'strFile', trace => true},
|
|
{name => 'strMode', default => $strFileModeDefault, trace => true},
|
|
);
|
|
|
|
# Change mode
|
|
if(!chmod(oct($strMode), $strFile))
|
|
{
|
|
my $strError = $!;
|
|
|
|
# If file exists then throw the error
|
|
if (fileExists($strFile))
|
|
{
|
|
confess &log(ERROR, "unable to chmod ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_MODE);
|
|
}
|
|
|
|
confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(fileMode);
|
|
|
|
####################################################################################################################################
|
|
# fileModeDefaultSet
|
|
#
|
|
# Set the default mode to be used when creating files.
|
|
####################################################################################################################################
|
|
sub fileModeDefaultSet
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strMode,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileModeDefaultSet', \@_,
|
|
{name => 'strMode', trace => true},
|
|
);
|
|
|
|
$strFileModeDefault = $strMode;
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(fileModeDefaultSet);
|
|
|
|
####################################################################################################################################
|
|
# fileMove
|
|
#
|
|
# Move a file.
|
|
####################################################################################################################################
|
|
sub fileMove
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strSourceFile,
|
|
$strDestinationFile,
|
|
$bDestinationPathCreate,
|
|
$bPathSync,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileMove', \@_,
|
|
{name => 'strSourceFile', trace => true},
|
|
{name => 'strDestinationFile', trace => true},
|
|
{name => 'bDestinationPathCreate', default => false, trace => true},
|
|
{name => 'bPathSync', default => false, trace => true},
|
|
);
|
|
|
|
# Get source and destination paths
|
|
my $strSourcePath = dirname($strSourceFile);
|
|
my $strDestinationPath = dirname($strDestinationFile);
|
|
|
|
# Move the file
|
|
if (!rename($strSourceFile, $strDestinationFile))
|
|
{
|
|
my $strError = $!;
|
|
my $bError = true;
|
|
|
|
# If the destination path does not exist and can be created then create it
|
|
if ($bDestinationPathCreate && !fileExists($strDestinationPath))
|
|
{
|
|
$bError = false;
|
|
|
|
filePathCreate(dirname($strDestinationFile), undef, true, true, $bPathSync);
|
|
|
|
# Try the rename again and store the error if it fails
|
|
if (!rename($strSourceFile, $strDestinationFile))
|
|
{
|
|
$strError = $!;
|
|
$bError = true;
|
|
}
|
|
}
|
|
|
|
# If there was an error then raise it
|
|
if ($bError)
|
|
{
|
|
confess &log(ERROR, "unable to move file ${strSourceFile} to ${strDestinationFile}" .
|
|
(defined($strError) ? ": $strError" : ''), ERROR_FILE_MOVE);
|
|
}
|
|
}
|
|
|
|
# Sync path(s) if requested
|
|
if ($bPathSync)
|
|
{
|
|
# Always sync the destination directory
|
|
filePathSync(dirname($strDestinationFile));
|
|
|
|
# If the source and destination directories are not the same then sync the source directory
|
|
if (dirname($strSourceFile) ne dirname($strDestinationFile))
|
|
{
|
|
filePathSync(dirname($strSourceFile));
|
|
}
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(fileMove);
|
|
|
|
####################################################################################################################################
|
|
# fileOpen
|
|
#
|
|
# Open a file.
|
|
####################################################################################################################################
|
|
sub fileOpen
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile,
|
|
$lFlags,
|
|
$strMode,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileOpen', \@_,
|
|
{name => 'strFile', trace => true},
|
|
{name => 'lFlags', trace => true},
|
|
{name => 'strMode', default => $strFileModeDefault, trace => true},
|
|
);
|
|
|
|
my $hFile;
|
|
|
|
if (!sysopen($hFile, $strFile, $lFlags, oct($strMode)))
|
|
{
|
|
my $strError = $!;
|
|
|
|
# If file exists then throw the error
|
|
if (fileExists($strFile))
|
|
{
|
|
confess &log(ERROR, "unable to open ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
|
|
}
|
|
|
|
confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'hFile', value => $hFile, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileOpen);
|
|
|
|
####################################################################################################################################
|
|
# filePathSync
|
|
#
|
|
# Sync a directory.
|
|
####################################################################################################################################
|
|
sub filePathSync
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strPath
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::filePathSync', \@_,
|
|
{name => 'strPath', trace => true}
|
|
);
|
|
|
|
open(my $hPath, "<", $strPath)
|
|
or confess &log(ERROR, "unable to open '${strPath}' for sync", ERROR_PATH_OPEN);
|
|
open(my $hPathDup, ">&", $hPath)
|
|
or confess &log(ERROR, "unable to duplicate '${strPath}' handle for sync", ERROR_PATH_OPEN);
|
|
|
|
$hPathDup->sync
|
|
or confess &log(ERROR, "unable to sync '${strPath}'", ERROR_PATH_SYNC);
|
|
|
|
close($hPathDup);
|
|
close($hPath);
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(filePathSync);
|
|
|
|
####################################################################################################################################
|
|
# fileRemove
|
|
#
|
|
# Remove a file from the file system.
|
|
####################################################################################################################################
|
|
sub fileRemove
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strPath,
|
|
$bIgnoreMissing,
|
|
$bPathSync,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileRemove', \@_,
|
|
{name => 'strPath', trace => true},
|
|
{name => 'bIgnoreMissing', default => false, trace => true},
|
|
{name => 'bPathSync', default => false, trace => true},
|
|
);
|
|
|
|
# Working variables
|
|
my $bRemoved = true;
|
|
|
|
# Remove the file
|
|
if (unlink($strPath) != 1)
|
|
{
|
|
$bRemoved = false;
|
|
my $strError = $!;
|
|
|
|
# If path exists then throw the error
|
|
if (fileExists($strPath))
|
|
{
|
|
confess &log(ERROR, "unable to remove ${strPath}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
|
|
}
|
|
# Else throw an error unless missing paths are ignored
|
|
elsif (!$bIgnoreMissing)
|
|
{
|
|
confess &log(ERROR, "${strPath} does not exist", ERROR_FILE_MISSING);
|
|
}
|
|
}
|
|
|
|
# Sync parent directory if requested
|
|
if ($bRemoved && $bPathSync)
|
|
{
|
|
filePathSync(dirname($strPath));
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'bRemoved', value => $bRemoved, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileRemove);
|
|
|
|
####################################################################################################################################
|
|
# fileStat
|
|
#
|
|
# Stat a file.
|
|
####################################################################################################################################
|
|
sub fileStat
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFile
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileStat', \@_,
|
|
{name => 'strFile', required => true, trace => true}
|
|
);
|
|
|
|
# Stat the file/path to determine if it exists
|
|
my $oStat = lstat($strFile);
|
|
|
|
# Evaluate error
|
|
if (!defined($oStat))
|
|
{
|
|
my $strError = $!;
|
|
confess &log(ERROR, "unable to read ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'oStat', value => $oStat, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileStat);
|
|
|
|
####################################################################################################################################
|
|
# fileStringRead
|
|
#
|
|
# Read the specified file as a string.
|
|
####################################################################################################################################
|
|
sub fileStringRead
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFileName
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileStringRead', \@_,
|
|
{name => 'strFileName', trace => true}
|
|
);
|
|
|
|
# Open the file for writing
|
|
sysopen(my $hFile, $strFileName, O_RDONLY)
|
|
or confess &log(ERROR, "unable to open ${strFileName}");
|
|
|
|
# Read the string
|
|
my $iBytesRead;
|
|
my $iBytesTotal = 0;
|
|
my $strContent;
|
|
|
|
do
|
|
{
|
|
$iBytesRead = sysread($hFile, $strContent, 65536, $iBytesTotal);
|
|
|
|
if (!defined($iBytesRead))
|
|
{
|
|
confess &log(ERROR, "unable to read string from ${strFileName}: $!", ERROR_FILE_READ);
|
|
}
|
|
|
|
$iBytesTotal += $iBytesRead;
|
|
}
|
|
while ($iBytesRead != 0);
|
|
|
|
close($hFile);
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'strContent', value => $strContent, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(fileStringRead);
|
|
|
|
####################################################################################################################################
|
|
# fileStringWrite
|
|
#
|
|
# Write a string to the specified file.
|
|
####################################################################################################################################
|
|
sub fileStringWrite
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strFileName,
|
|
$strContent,
|
|
$bSync
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::fileStringWrite', \@_,
|
|
{name => 'strFileName', trace => true},
|
|
{name => 'strContent', trace => true},
|
|
{name => 'bSync', default => true, trace => true},
|
|
);
|
|
|
|
# Open the file for writing
|
|
sysopen(my $hFile, $strFileName, O_WRONLY | O_CREAT | O_TRUNC, oct(640))
|
|
or confess &log(ERROR, "unable to open ${strFileName}");
|
|
|
|
# Write the string
|
|
syswrite($hFile, $strContent)
|
|
or confess &log(ERROR, "unable to write string to ${strFileName}: $!", ERROR_FILE_WRITE);
|
|
|
|
# Sync file
|
|
$hFile->sync() if $bSync;
|
|
|
|
# Close file
|
|
close($hFile);
|
|
|
|
# Sync directory
|
|
filePathSync(dirname($strFileName)) if $bSync;
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(fileStringWrite);
|
|
|
|
####################################################################################################################################
|
|
# pathAbsolute
|
|
#
|
|
# Generate an absolute path from an absolute base path and a relative path.
|
|
####################################################################################################################################
|
|
sub pathAbsolute
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strBasePath,
|
|
$strPath
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::pathAbsolute', \@_,
|
|
{name => 'strBasePath', trace => true},
|
|
{name => 'strPath', trace => true}
|
|
);
|
|
|
|
# Working variables
|
|
my $strAbsolutePath;
|
|
|
|
# If the path is already absolute
|
|
if (index($strPath, '/') == 0)
|
|
{
|
|
$strAbsolutePath = $strPath;
|
|
}
|
|
# Else make it absolute using the base path
|
|
else
|
|
{
|
|
# Make sure the absolute path is really absolute
|
|
if (index($strBasePath, '/') != 0 || index($strBasePath, '/..') != -1)
|
|
{
|
|
confess &log(ERROR, "${strBasePath} is not an absolute path", ERROR_PATH_TYPE);
|
|
}
|
|
|
|
while (index($strPath, '..') == 0)
|
|
{
|
|
$strBasePath = dirname($strBasePath);
|
|
$strPath = substr($strPath, 2);
|
|
|
|
if (index($strPath, '/') == 0)
|
|
{
|
|
$strPath = substr($strPath, 1);
|
|
}
|
|
}
|
|
|
|
$strAbsolutePath = "${strBasePath}/${strPath}";
|
|
}
|
|
|
|
# Make sure the result is really an absolute path
|
|
if (index($strAbsolutePath, '/') != 0 || index($strAbsolutePath, '/..') != -1)
|
|
{
|
|
confess &log(ERROR, "result ${strAbsolutePath} was not an absolute path", ERROR_PATH_TYPE);
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn
|
|
(
|
|
$strOperation,
|
|
{name => 'strAbsolutePath', value => $strAbsolutePath, trace => true}
|
|
);
|
|
}
|
|
|
|
push @EXPORT, qw(pathAbsolute);
|
|
|
|
####################################################################################################################################
|
|
# pathModeDefaultSet
|
|
#
|
|
# Set the default mode to be used when creating paths.
|
|
####################################################################################################################################
|
|
sub pathModeDefaultSet
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strMode
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::pathModeDefaultSet', \@_,
|
|
{name => 'strMode', trace => true},
|
|
);
|
|
|
|
$strPathModeDefault = $strMode;
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(pathModeDefaultSet);
|
|
|
|
####################################################################################################################################
|
|
# filePathCreate
|
|
#
|
|
# Create a path.
|
|
####################################################################################################################################
|
|
sub filePathCreate
|
|
{
|
|
# Assign function parameters, defaults, and log debug info
|
|
my
|
|
(
|
|
$strOperation,
|
|
$strPath,
|
|
$strMode,
|
|
$bIgnoreExists,
|
|
$bCreateParents,
|
|
$bPathSync,
|
|
) =
|
|
logDebugParam
|
|
(
|
|
__PACKAGE__ . '::filePathCreate', \@_,
|
|
{name => 'strPath', trace => true},
|
|
{name => 'strMode', default => $strPathModeDefault, trace => true},
|
|
{name => 'bIgnoreExists', default => false, trace => true},
|
|
{name => 'bCreateParents', default => false, trace => true},
|
|
{name => 'bPathSync', default => false, trace => true},
|
|
);
|
|
|
|
# Determine if parent directory exists
|
|
my $strParentPath = dirname($strPath);
|
|
|
|
if (!fileExists($strParentPath))
|
|
{
|
|
if (!$bCreateParents)
|
|
{
|
|
confess &log(ERROR, "unable to create ${strPath} because parent path does not exist", ERROR_PATH_CREATE);
|
|
}
|
|
|
|
filePathCreate($strParentPath, $strMode, $bIgnoreExists, $bCreateParents, $bPathSync);
|
|
}
|
|
|
|
# Create the path
|
|
if (!mkdir($strPath, oct($strMode)))
|
|
{
|
|
# Get the error as a string
|
|
my $strError = $OS_ERROR . '';
|
|
|
|
# Error if not ignoring existence of the path
|
|
if (!($bIgnoreExists && fileExists($strPath)))
|
|
{
|
|
confess &log(ERROR, "unable to create ${strPath}: " . $OS_ERROR, ERROR_PATH_CREATE);
|
|
}
|
|
}
|
|
|
|
# Sync path if requested
|
|
if ($bPathSync)
|
|
{
|
|
filePathSync($strParentPath);
|
|
}
|
|
|
|
# Return from function and log return values if any
|
|
return logDebugReturn($strOperation);
|
|
}
|
|
|
|
push @EXPORT, qw(filePathCreate);
|
|
|
|
1;
|