# Copyright (c) 2023 Yuki Kimoto
# MIT License
class File::Spec::Instance::Unix extends File::Spec::Instance {
version_from File::Spec;
use Re;
use StringList;
use Cwd;
use Sys;
# Class Methods
static method new : File::Spec::Instance::Unix () {
my $self = new File::Spec::Instance::Unix;
return $self;
}
# Instance Methods
method canonpath : string ($path : string) {
unless ($path) {
die "The \$path must be defined";
}
$path = copy $path;
# xx////xx -> xx/xx
Re->s((mutable string)$path, ["/{2,}", "g"], "/");
# xx/././xx -> xx/xx
Re->s((mutable string)$path, ["(?:/\.)+(?:/|\z)", "g"], "/");
# ./xx -> xx
unless ($path eq "./") {
Re->s((mutable string)$path, ["^(?:\./)+", "sg"], "");
}
# /../../xx -> xx
Re->s((mutable string)$path, "^/(?:\.\./)+", "/");
# /.. -> /
Re->s((mutable string)$path, "^/\.\.$", "/");
# xx/ -> xx
unless ($path eq "/") {
Re->s((mutable string)$path, "/\z", "");
}
return $path;
}
method catdir : string ($parts : string[]) {
unless ($parts) {
die "The \$parts must be defined";
}
my $parts_list = StringList->new($parts);
$parts_list->push("");
$parts = $parts_list->to_array;
my $path = Fn->join("/", $parts);
my $canonpath = $self->canonpath($path);
return $canonpath;
}
method catfile : string ($parts : string[]) {
unless ($parts) {
die "The \$parts must be defined";
}
my $parts_length = @$parts;
unless ($parts_length > 0) {
die "The parts \$parts must have elements.";
}
my $file_base_name = $parts->[$parts_length - 1];
$file_base_name = $self->canonpath($file_base_name);
my $dir_parts = Array->copy_string_address($parts, 0, $parts_length - 1);
unless (@$dir_parts) {
return $file_base_name;
}
my $dir = $self->catdir($dir_parts);
my $dir_length = length $dir;
unless ($dir_length >= 1 && $dir->[$dir_length - 1] == '/') {
$dir .= "/";
}
my $file = "$dir$file_base_name";
return $file;
}
method curdir : string () {
return ".";
}
method devnull : string () {
return "/dev/null";
}
method rootdir : string () {
return "/";
}
method tmpdir : string () {
my $env_tmpdir = Sys->env("TMPDIR");
my $dirlist = [$env_tmpdir, "/tmp"];
my $tmpdir = $self->_tmpdir($dirlist);
return $tmpdir;
}
method updir : string () {
return "..";
}
method no_upwards : string[] ($parts : string[]) {
my $no_upwards_list = StringList->new;
for my $part (@$parts) {
unless (Re->m($part, ["^\.{1,2}\z", "s"])) {
$no_upwards_list->push($part);
}
}
my $no_upwards = $no_upwards_list->to_array;
return $no_upwards;
}
method file_name_is_absolute : int ($path : string) {
my $is_abs = 0;
if (Re->m($path, ["^/", "s"])) {
$is_abs = 1;
}
return $is_abs;
}
method path : string[] () {
my $env_path = Sys->env("PATH");
unless ($env_path) {
return new string[0];
}
my $pathes = &_compatible_split(":", $env_path);
for (my $i = 0; $i < @$pathes; $i++) {
if ($pathes->[$i] eq "") {
$pathes->[$i] = ".";
}
}
return $pathes;
}
method join : string ($parts : string[]) {
return $self->catfile($parts);
}
method splitpath : string[] ($path : string, $no_file : int = 0) {
my $volume = "";
my $dir = "";
my $file = "";
if ( $no_file ) {
$dir = $path;
}
else {
if (my $match = Re->m($path, ["^((?:.*/(?:\.\.?\z)?)?)([^/]*)", "s"])) {
$dir = $match->cap1;
$file = $match->cap2;
}
}
return [$volume, $dir, $file];
}
method splitdir : string[] ($path : string) {
my $parts = Fn->split("/", $path, -1);
return $parts;
}
method catpath : string ($volume : string, $dir : string, $file : string) {
unless ($dir) {
$dir = "";
}
unless ($file) {
$file = "";
}
my $dir_length = length $dir;
my $file_length = length $file;
if ( $dir ne "" &&
$file ne "" &&
$dir->[$dir_length - 1] != '/' &&
$file->[0] != '/')
{
$dir .= "/$file" ;
}
else {
$dir .= $file ;
}
return $dir;
}
method abs2rel : string ($path : string, $base : string = undef) {
unless ($base && length $base) {
$base = Cwd->getcwd();
}
$path = $self->canonpath($path);
$base = $self->canonpath($base);
my $path_directories = (string)undef;
my $base_directories = (string)undef;
my $pash_is_abs = $self->file_name_is_absolute($path);
my $base_is_abs = $self->file_name_is_absolute($base);
if ($pash_is_abs || $base_is_abs) {
$path = $self->rel2abs($path);
$base = $self->rel2abs($base);
my $path_volume = $self->splitpath($path, 1)->[0];
my $base_volume = $self->splitpath($base, 1)->[0];
# Can't relativize across volumes
unless ($path_volume eq $base_volume) {
return $path ;
}
$path_directories = $self->splitpath($path, 1)->[1];
$base_directories = $self->splitpath($base, 1)->[1];
# For UNC paths, the user might give a volume like //foo/bar that
# strictly speaking has no directory portion. Treat it as if it
# had the root directory for that volume.
if (!length($base_directories) && $self->file_name_is_absolute($base)) {
$base_directories = $self->rootdir;
}
}
else {
my $wd= $self->splitpath(Cwd->getcwd(), 1)->[1];
$path_directories = $self->catdir([$wd, $path]);
$base_directories = $self->catdir([$wd, $base]);
}
# Now, remove all leading components that are the same
my $pathchunks = $self->splitdir( $path_directories );
my $basechunks = $self->splitdir( $base_directories );
if ($base_directories eq $self->rootdir) {
if ($path_directories eq $self->rootdir) {
return $self->curdir;
}
my $pathchunks_list = StringList->new($pathchunks);
$pathchunks_list->shift;
$pathchunks = $pathchunks_list->to_array;
return $self->canonpath( $self->catpath("", $self->catdir($pathchunks ), "") );
}
my $common_list = StringList->new;
my $pathchunks_list = StringList->new($pathchunks);
my $basechunks_list = StringList->new($basechunks);
while ($pathchunks_list->length > 0 && $basechunks_list->length > 0 && $pathchunks_list->get(0) eq $basechunks_list->get(0)) {
$common_list->push($pathchunks_list->shift);
$basechunks_list->shift;
}
unless ($pathchunks_list->length > 0 || $basechunks_list->length > 0) {
return $self->curdir;
}
# @basechunks now contains the directories the resulting relative path
# must ascend out of before it can descend to $path_directory. If there
# are updir components, we must descend into the corresponding directories
# (this only works if they are no symlinks).
my $reverse_base_list = StringList->new;
while ($basechunks_list->length > 0) {
my $dir = $basechunks_list->shift;
if( $dir ne $self->updir ) {
$reverse_base_list->unshift($self->updir);
$common_list->push($dir);
}
elsif($common_list->length > 0) {
if( $reverse_base_list->length > 0 && $reverse_base_list->get(0) eq $self->updir ) {
$reverse_base_list->shift;
$common_list->pop;
}
else {
$reverse_base_list->unshift($common_list->pop);
}
}
}
my $reverse_base = $reverse_base_list->to_array;
for my $reserve_base_part (@$reverse_base) {
$pathchunks_list->unshift($reserve_base_part);
}
$pathchunks = $pathchunks_list->to_array;
my $result_parts = $self->catdir($pathchunks);
return $self->canonpath( $self->catpath("", $result_parts, "") );
return undef;
}
method rel2abs : string ($path : string, $base : string = undef) {
# Clean up $path
if (!$self->file_name_is_absolute($path)) {
# Figure out the effective $base and clean it up.
if (!$base || $base eq "") {
$base = Cwd->getcwd;
}
elsif (!$self->file_name_is_absolute($base)) {
$base = $self->rel2abs($base) ;
}
else {
$base = $self->canonpath($base);
}
# Glom them together
$path = $self->catdir([$base, $path]);
}
my $rel2abs = $self->canonpath($path);
return $rel2abs;
}
protected method _tmpdir : string ($dirlist : string[]) {
my $tmpdir = (string)undef;
for my $dir (@$dirlist) {
if ($dir && Sys->d($dir) && Sys->w($dir)){
$tmpdir = $dir;
last;
}
}
unless ($tmpdir) {
$tmpdir = $self->curdir;
}
$tmpdir = $self->canonpath($tmpdir);
if (!$self->file_name_is_absolute($tmpdir)) {
$tmpdir = $self->rel2abs($tmpdir);
if (!$self->file_name_is_absolute($tmpdir)) {
die "A temporary directory must be converted to an absolute path";
}
}
return $tmpdir;
}
private static method _compatible_split : string[] ($separator : string, $string : string, $limit : int = 0) {
unless ($separator) {
die "The \$separator must be defined";
}
unless ($string) {
die "The \$string must be defined";
}
my $string_length = length $string;
my $separator_length = length $separator;
unless ($separator_length > 0) {
die "The length of the \$separator must be greater than 0";
}
my $separated_strings_list = StringList->new_len(0);
my $match_start = 0;
my $string_base = 0;
my $match_count = 0;
for (my $i = 0; $i < $string_length; $i++) {
if ($limit > 0 && $match_count >= $limit - 1) {
last;
}
if ($string->[$i] == $separator->[0]) {
$match_start = 1;
}
if ($match_start) {
my $match = 1;
for (my $separator_index = 0; $separator_index < $separator_length; $separator_index++) {
if ($i + $separator_index > $string_length - 1) {
$match = 0;
last;
}
else {
unless ($string->[$i + $separator_index] == $separator->[$separator_index]) {
$match = 0;
last;
}
}
}
if ($match) {
$match_count++;
my $separated_string = Fn->substr($string, $string_base, $i - $string_base);
$separated_strings_list->push($separated_string);
$string_base = $i + $separator_length;
$i += $separator_length - 1;
}
}
}
if ($string_base == $string_length) {
$separated_strings_list->push("");
}
else {
my $separated_string = Fn->substr($string, $string_base, $string_length - $string_base);
$separated_strings_list->push($separated_string);
}
if ($limit == 0) {
while ($separated_strings_list->length > 0) {
if ($separated_strings_list->get($separated_strings_list->length - 1) eq "") {
$separated_strings_list->pop;
}
else {
last;
}
}
}
my $separated_strings = $separated_strings_list->to_array;
return $separated_strings;
}
}