/tools/doc/Modules/NaturalDocs/File.pm
Perl | 541 lines | 486 code | 13 blank | 42 comment | 2 complexity | 3d438710a0e3dc91fc6dcd36db2903e1 MD5 | raw file
Possible License(s): BSD-3-Clause
- ###############################################################################
- #
- # 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 2003-2010 Greg Valure
- # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
- # Refer to License.txt for the complete details
- 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;