ddnet/docs/tool/Modules/NaturalDocs/File.pm

541 lines
15 KiB
Perl
Raw Normal View History

2008-08-02 08:21:29 +00:00
###############################################################################
#
# 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-2008 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 && $directories[$i - 1] ne $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>.
#
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?:
#
# First, there's nothing that gives a relative path between two relative paths.
#
# Second, 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, 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 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.
#
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: NoExtension
#
# Returns the path without an extension.
#
sub NoExtension #(path)
{
my ($self, $path) = @_;
my $extension = $self->ExtensionOf($path);
if ($extension)
{ $path = substr($path, 0, length($path) - length($extension) - 1); };
return $path;
};
#
# 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.
#
# Returns:
#
# Whether it succeeded
#
sub Copy #(source, destination) => bool
{
my ($self, $source, $destination) = @_;
return File::Copy::copy($source, $destination);
};
1;