mirror of
https://github.com/ddnet/ddnet.git
synced 2024-11-14 03:58:18 +00:00
522 lines
15 KiB
Perl
522 lines
15 KiB
Perl
###############################################################################
|
|
#
|
|
# Package: NaturalDocs::File
|
|
#
|
|
###############################################################################
|
|
#
|
|
# A package to manage file access across platforms. Incorporates functions from various standard File:: packages, but more
|
|
# importantly, works around the glorious suckage present in File::Spec, at least in version 0.82 and earlier. Read the "Why oh
|
|
# why?" sections for why this package was necessary.
|
|
#
|
|
# Usage and Dependencies:
|
|
#
|
|
# - The package doesn't depend on any other Natural Docs packages and is ready to use immediately.
|
|
#
|
|
# - All functions except <CanonizePath()> assume that all parameters are canonized.
|
|
#
|
|
###############################################################################
|
|
|
|
# This file is part of Natural Docs, which is Copyright (C) 2003-2005 Greg Valure
|
|
# Natural Docs is licensed under the GPL
|
|
|
|
use File::Spec ();
|
|
use File::Path ();
|
|
use File::Copy ();
|
|
|
|
use strict;
|
|
use integer;
|
|
|
|
package NaturalDocs::File;
|
|
|
|
|
|
#
|
|
# Function: CheckCompatibility
|
|
#
|
|
# Checks if the standard packages required by this one are up to snuff and dies if they aren't. This is done because I can't
|
|
# tell which versions of File::Spec have splitpath just by the version numbers.
|
|
#
|
|
sub CheckCompatibility
|
|
{
|
|
my ($self) = @_;
|
|
|
|
eval {
|
|
File::Spec->splitpath('');
|
|
};
|
|
|
|
if ($@)
|
|
{
|
|
NaturalDocs::Error->SoftDeath("Natural Docs requires a newer version of File::Spec than you have. "
|
|
. "You must either upgrade it or upgrade Perl.");
|
|
};
|
|
};
|
|
|
|
|
|
###############################################################################
|
|
# Group: Path String Functions
|
|
|
|
|
|
#
|
|
# Function: CanonizePath
|
|
#
|
|
# Takes a path and returns a logically simplified version of it.
|
|
#
|
|
# Why oh why?:
|
|
#
|
|
# Because File::Spec->canonpath doesn't strip quotes on Windows. So if you pass in "a b\c" or "a b"\c, they still end up as
|
|
# different strings even though they're logically the same.
|
|
#
|
|
# It also doesn't remove things like "..", so "a/b/../c" doesn't simplify to "a/c" like it should.
|
|
#
|
|
sub CanonizePath #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
|
|
if ($::OSNAME eq 'MSWin32')
|
|
{
|
|
# We don't have to use a smarter algorithm for dropping quotes because they're invalid characters for actual file and
|
|
# directory names.
|
|
$path =~ s/\"//g;
|
|
};
|
|
|
|
$path = File::Spec->canonpath($path);
|
|
|
|
# Condense a/b/../c into a/c.
|
|
|
|
my $upDir = File::Spec->updir();
|
|
if (index($path, $upDir) != -1)
|
|
{
|
|
my ($volume, $directoryString, $file) = $self->SplitPath($path);
|
|
my @directories = $self->SplitDirectories($directoryString);
|
|
|
|
my $i = 1;
|
|
while ($i < scalar @directories)
|
|
{
|
|
if ($i > 0 && $directories[$i] eq $upDir)
|
|
{
|
|
splice(@directories, $i - 1, 2);
|
|
$i--;
|
|
}
|
|
else
|
|
{ $i++; };
|
|
};
|
|
|
|
$directoryString = $self->JoinDirectories(@directories);
|
|
$path = $self->JoinPath($volume, $directoryString, $file);
|
|
};
|
|
|
|
return $path;
|
|
};
|
|
|
|
|
|
#
|
|
# Function: PathIsAbsolute
|
|
#
|
|
# Returns whether the passed path is absolute.
|
|
#
|
|
sub PathIsAbsolute #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
return File::Spec->file_name_is_absolute($path);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: JoinPath
|
|
#
|
|
# Creates a path from its elements.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# volume - The volume, such as the drive letter on Windows. Undef if none.
|
|
# dirString - The directory string. Create with <JoinDirectories()> if necessary.
|
|
# file - The file name, or undef if none.
|
|
#
|
|
# Returns:
|
|
#
|
|
# The joined path.
|
|
#
|
|
sub JoinPath #(volume, dirString, $file)
|
|
{
|
|
my ($self, $volume, $dirString, $file) = @_;
|
|
return File::Spec->catpath($volume, $dirString, $file);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: JoinPaths
|
|
#
|
|
# Joins two paths.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# basePath - May be a relative path, an absolute path, or undef.
|
|
# extraPath - May be a relative path, a file, a relative path and file together, or undef.
|
|
# noFileInExtra - Set this to true if extraPath is a relative path only, and doesn't have a file.
|
|
#
|
|
# Returns:
|
|
#
|
|
# The joined path.
|
|
#
|
|
# Why oh why?:
|
|
#
|
|
# Because nothing in File::Spec will simply slap two paths together. They have to be split up for catpath/file, and rel2abs
|
|
# requires the base to be absolute.
|
|
#
|
|
sub JoinPaths #(basePath, extraPath, noFileInExtra)
|
|
{
|
|
my ($self, $basePath, $extraPath, $noFileInExtra) = @_;
|
|
|
|
# If both are undef, it will return undef, which is what we want.
|
|
if (!defined $basePath)
|
|
{ return $extraPath; }
|
|
elsif (!defined $extraPath)
|
|
{ return $basePath; };
|
|
|
|
my ($baseVolume, $baseDirString, $baseFile) = File::Spec->splitpath($basePath, 1);
|
|
my ($extraVolume, $extraDirString, $extraFile) = File::Spec->splitpath($extraPath, $noFileInExtra);
|
|
|
|
my @baseDirectories = $self->SplitDirectories($baseDirString);
|
|
my @extraDirectories = $self->SplitDirectories($extraDirString);
|
|
|
|
my $fullDirString = $self->JoinDirectories(@baseDirectories, @extraDirectories);
|
|
|
|
my $fullPath = File::Spec->catpath($baseVolume, $fullDirString, $extraFile);
|
|
|
|
return $self->CanonizePath($fullPath);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: SplitPath
|
|
#
|
|
# Takes a path and returns its elements.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# path - The path to split.
|
|
# noFile - Set to true if the path doesn't have a file at the end.
|
|
#
|
|
# Returns:
|
|
#
|
|
# The array ( volume, directoryString, file ). If any don't apply, they will be undef. Use <SplitDirectories()> to split the
|
|
# directory string if desired.
|
|
#
|
|
# Why oh Why?:
|
|
#
|
|
# Because File::Spec->splitpath may leave a trailing slash/backslash/whatever on the directory string, which makes
|
|
# it a bit hard to match it with results from File::Spec->catdir.
|
|
#
|
|
sub SplitPath #(path, noFile)
|
|
{
|
|
my ($self, $path, $noFile) = @_;
|
|
|
|
my @segments = File::Spec->splitpath($path, $noFile);
|
|
|
|
if (!length $segments[0])
|
|
{ $segments[0] = undef; };
|
|
if (!length $segments[2])
|
|
{ $segments[2] = undef; };
|
|
|
|
$segments[1] = File::Spec->catdir( File::Spec->splitdir($segments[1]) );
|
|
|
|
return @segments;
|
|
};
|
|
|
|
|
|
#
|
|
# Function: JoinDirectories
|
|
#
|
|
# Creates a directory string from an array of directory names.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# directory - A directory name. There may be as many of these as desired.
|
|
#
|
|
sub JoinDirectories #(directory, directory, ...)
|
|
{
|
|
my ($self, @directories) = @_;
|
|
return File::Spec->catdir(@directories);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: SplitDirectories
|
|
#
|
|
# Takes a string of directories and returns an array of its elements.
|
|
#
|
|
# Why oh why?:
|
|
#
|
|
# Because File::Spec->splitdir might leave an empty element at the end of the array, which screws up both joining in
|
|
# <ConvertToURL> and navigation in <MakeRelativePath>. Morons.
|
|
#
|
|
sub SplitDirectories #(directoryString)
|
|
{
|
|
my ($self, $directoryString) = @_;
|
|
|
|
my @directories = File::Spec->splitdir($directoryString);
|
|
|
|
if (!length $directories[-1])
|
|
{ pop @directories; };
|
|
|
|
return @directories;
|
|
};
|
|
|
|
|
|
#
|
|
# Function: MakeRelativePath
|
|
#
|
|
# Takes two paths and returns a relative path between them.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# basePath - The starting path. May be relative or absolute, so long as the target path is as well.
|
|
# targetPath - The target path. May be relative or absolute, so long as the base path is as well.
|
|
#
|
|
# If both paths are relative, they are assumed to be relative to the same base.
|
|
#
|
|
# Returns:
|
|
#
|
|
# The target path relative to base.
|
|
#
|
|
# Why oh why?:
|
|
#
|
|
# Wow, where to begin? First of all, there's nothing that gives a relative path between two relative paths.
|
|
#
|
|
# Second of all, if target and base are absolute but on different volumes, File::Spec->abs2rel creates a totally non-functional
|
|
# relative path. It should return the target as is, since there is no relative path.
|
|
#
|
|
# Third of all, File::Spec->abs2rel between absolute paths on the same volume, at least on Windows, leaves the drive letter
|
|
# on. So abs2rel('a:\b\c\d', 'a:\b') returns 'a:c\d' instead of the expected 'c\d'. That makes no fucking sense whatsoever. It's
|
|
# not like it was designed to handle only directory names, either; the documentation says 'path' and the code seems to
|
|
# explicitly handle it. There's just an 'unless' in there that tacks on the volume, defeating the purpose of a *relative* path and
|
|
# making the function worthless. Morons.
|
|
#
|
|
# Update: This last one appears to be fixed in File::Spec 0.83, but that version isn't even listed on CPAN. Lovely. Apparently
|
|
# it just comes with ActivePerl. Somehow I don't think most Linux users are using that.
|
|
#
|
|
sub MakeRelativePath #(basePath, targetPath)
|
|
{
|
|
my ($self, $basePath, $targetPath) = @_;
|
|
|
|
my ($baseVolume, $baseDirString, $baseFile) = $self->SplitPath($basePath, 1);
|
|
my ($targetVolume, $targetDirString, $targetFile) = $self->SplitPath($targetPath);
|
|
|
|
# If the volumes are different, there is no possible relative path.
|
|
if ($targetVolume ne $baseVolume)
|
|
{ return $targetPath; };
|
|
|
|
my @baseDirectories = $self->SplitDirectories($baseDirString);
|
|
my @targetDirectories = $self->SplitDirectories($targetDirString);
|
|
|
|
# Skip the parts of the path that are the same.
|
|
while (scalar @baseDirectories && @targetDirectories && $baseDirectories[0] eq $targetDirectories[0])
|
|
{
|
|
shift @baseDirectories;
|
|
shift @targetDirectories;
|
|
};
|
|
|
|
# Back out of the base path until it reaches where they were similar.
|
|
for (my $i = 0; $i < scalar @baseDirectories; $i++)
|
|
{
|
|
unshift @targetDirectories, File::Spec->updir();
|
|
};
|
|
|
|
$targetDirString = $self->JoinDirectories(@targetDirectories);
|
|
|
|
return File::Spec->catpath(undef, $targetDirString, $targetFile);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: IsSubPathOf
|
|
#
|
|
# Returns whether the path is a descendant of another path.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# base - The base path to test against.
|
|
# path - The possible subpath to test.
|
|
#
|
|
# Returns:
|
|
#
|
|
# Whether path is a descendant of base.
|
|
#
|
|
sub IsSubPathOf #(base, path)
|
|
{
|
|
my ($self, $base, $path) = @_;
|
|
|
|
# This is a quick test that should find a false quickly.
|
|
if ($base eq substr($path, 0, length($base)))
|
|
{
|
|
# This doesn't guarantee true, because it could be "C:\A B" and "C:\A B C\File". So we test for it by seeing if the last
|
|
# directory in base is the same as the equivalent directory in path.
|
|
|
|
my ($baseVolume, $baseDirString, $baseFile) = NaturalDocs::File->SplitPath($base, 1);
|
|
my @baseDirectories = NaturalDocs::File->SplitDirectories($baseDirString);
|
|
|
|
my ($pathVolume, $pathDirString, $pathFile) = NaturalDocs::File->SplitPath($path);
|
|
my @pathDirectories = NaturalDocs::File->SplitDirectories($pathDirString);
|
|
|
|
return ( $baseDirectories[-1] eq $pathDirectories[ scalar @baseDirectories - 1 ] );
|
|
}
|
|
else
|
|
{ return undef; };
|
|
};
|
|
|
|
|
|
#
|
|
# Function: ConvertToURL
|
|
#
|
|
# Takes a relative path and converts it from the native format to a relative URL. Note that it _doesn't_ convert special characters
|
|
# to amp chars.
|
|
#
|
|
sub ConvertToURL #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
|
|
my ($pathVolume, $pathDirString, $pathFile) = $self->SplitPath($path);
|
|
my @pathDirectories = $self->SplitDirectories($pathDirString);
|
|
|
|
my $i = 0;
|
|
while ($i < scalar @pathDirectories && $pathDirectories[$i] eq File::Spec->updir())
|
|
{
|
|
$pathDirectories[$i] = '..';
|
|
$i++;
|
|
};
|
|
|
|
return join('/', @pathDirectories, $pathFile);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: NoUpwards
|
|
#
|
|
# Takes an array of directory entries and returns one without all the entries that refer to the parent directory, such as '.' and '..'.
|
|
#
|
|
sub NoUpwards #(array)
|
|
{
|
|
my ($self, @array) = @_;
|
|
return File::Spec->no_upwards(@array);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: NoFileName
|
|
#
|
|
# Takes a path and returns a version without the file name. Useful for sending paths to <CreatePath()>.
|
|
#
|
|
sub NoFileName #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
|
|
my ($pathVolume, $pathDirString, $pathFile) = File::Spec->splitpath($path);
|
|
|
|
return File::Spec->catpath($pathVolume, $pathDirString, undef);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: ExtensionOf
|
|
#
|
|
# Returns the extension of the passed path, or undef if none.
|
|
#
|
|
sub ExtensionOf #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
|
|
my ($pathVolume, $pathDirString, $pathFile) = File::Spec->splitpath($path);
|
|
|
|
# We need the leading dot in the regex so files that start with a dot but don't have an extension count as extensionless files.
|
|
if ($pathFile =~ /.\.([^\.]+)$/)
|
|
{ return $1; }
|
|
else
|
|
{ return undef; };
|
|
};
|
|
|
|
|
|
#
|
|
# Function: IsCaseSensitive
|
|
#
|
|
# Returns whether the current platform has case-sensitive paths.
|
|
#
|
|
sub IsCaseSensitive
|
|
{
|
|
return !(File::Spec->case_tolerant());
|
|
};
|
|
|
|
|
|
|
|
###############################################################################
|
|
# Group: Disk Functions
|
|
|
|
|
|
#
|
|
# Function: CreatePath
|
|
#
|
|
# Creates a directory tree corresponding to the passed path, regardless of how many directories do or do not already exist.
|
|
# Do _not_ include a file name in the path. Use <NoFileName()> first if you need to.
|
|
#
|
|
sub CreatePath #(path)
|
|
{
|
|
my ($self, $path) = @_;
|
|
File::Path::mkpath($path);
|
|
};
|
|
|
|
|
|
#
|
|
# Function: RemoveEmptyTree
|
|
#
|
|
# Removes an empty directory tree. The passed directory will be removed if it's empty, and it will keep removing its parents
|
|
# until it reaches one that's not empty or a set limit.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# path - The path to start from. It will try to remove this directory and work it's way down.
|
|
# limit - The path to stop at if it doesn't find any non-empty directories first. This path will *not* be removed.
|
|
#
|
|
sub RemoveEmptyTree #(path, limit)
|
|
{
|
|
my ($self, $path, $limit) = @_;
|
|
|
|
my ($volume, $directoryString) = $self->SplitPath($path, 1);
|
|
my @directories = $self->SplitDirectories($directoryString);
|
|
|
|
my $directory = $path;
|
|
|
|
while (-d $directory && $directory ne $limit)
|
|
{
|
|
opendir FH_ND_FILE, $directory;
|
|
my @entries = readdir FH_ND_FILE;
|
|
closedir FH_ND_FILE;
|
|
|
|
@entries = $self->NoUpwards(@entries);
|
|
|
|
if (scalar @entries || !rmdir($directory))
|
|
{ last; };
|
|
|
|
pop @directories;
|
|
$directoryString = $self->JoinDirectories(@directories);
|
|
$directory = $self->JoinPath($volume, $directoryString);
|
|
};
|
|
};
|
|
|
|
|
|
#
|
|
# Function: Copy
|
|
#
|
|
# Copies a file from one path to another. If the destination file exists, it is overwritten.
|
|
#
|
|
# Parameters:
|
|
#
|
|
# source - The file to copy.
|
|
# destination - The destination to copy to.
|
|
#
|
|
sub Copy #(source, destination)
|
|
{
|
|
my ($self, $source, $destination) = @_;
|
|
File::Copy::copy($source, $destination);
|
|
};
|
|
|
|
|
|
1;
|