# 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 devnull : string () {
return "/dev/null";
}
method rootdir : string () {
return "/";
}
method curdir : string () {
return ".";
}
method updir : string () {
return "..";
}
method canonpath : string ($path : string) {
unless ($path) {
die "The \$path must be defined";
}
my $path_ref = [$path];
# xx////xx -> xx/xx
Re->s($path_ref, ["/{2,}", "g"], "/");
# xx/././xx -> xx/xx
Re->s($path_ref, ["(?:/\.)+(?:/|\z)", "g"], "/");
# ./xx -> xx
unless ($path_ref->[0] eq "./") {
Re->s($path_ref, ["^(?:\./)+", "sg"], "");
}
# /../../xx -> xx
Re->s($path_ref, "^/(?:\.\./)+", "/");
# /.. -> /
Re->s($path_ref, "^/\.\.$", "/");
# xx/ -> xx
unless ($path_ref->[0] eq "/") {
Re->s($path_ref, "/\z", "");
}
$path = $path_ref->[0];
return $path;
}
method catdir : string ($dir_parts : string[]) {
unless ($dir_parts) {
die "The \$dir_parts must be defined";
}
my $dir_parts_list = StringList->new($dir_parts);
$dir_parts_list->push("");
$dir_parts = $dir_parts_list->to_array;
my $path = Fn->join("/", $dir_parts);
my $canonpath = $self->canonpath($path);
return $canonpath;
}
method catfile : string ($dir_parts : string[], $file_base_name : string) {
unless ($dir_parts) {
die "The \$dir_parts must be defined";
}
unless ($file_base_name) {
die "The \$file_base_name must be defined";
}
$file_base_name = $self->canonpath($file_base_name);
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 no_upwards : string[] ($dir_parts : string[]) {
my $no_upwards_list = StringList->new;
for my $dir_part (@$dir_parts) {
unless (Re->m($dir_part, ["^\.{1,2}\z", "s"])) {
$no_upwards_list->push($dir_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 file_name_is_root : int ($path : string) {
my $is_root = 0;
if (Re->m($path, ["^/\z", "s"])) {
$is_root = 1;
}
return $is_root;
}
method join : string ($dir_parts : string[], $file_base_name : string) {
return $self->catfile($dir_parts, $file_base_name);
}
method catpath : string ($volume : string, $directory : string, $file : string) {
unless ($directory) {
$directory = "";
}
unless ($file) {
$file = "";
}
my $directory_length = length $directory;
my $file_length = length $file;
if ( $directory ne "" &&
$file ne "" &&
$directory->[$directory_length - 1] != '/' &&
$file->[0] != '/')
{
$directory .= "/$file" ;
}
else {
$directory .= $file ;
}
return $directory;
}
method splitpath : string[] ($path : string, $no_file : int = 0) {
my $volume = "";
my $directory = "";
my $file = "";
if ( $no_file ) {
$directory = $path;
}
else {
if (my $match = Re->m($path, ["^((?:.*/(?:\.\.?\z)?)?)([^/]*)", "s"])) {
$directory = $match->cap1;
$file = $match->cap2;
}
}
return [$volume, $directory, $file];
}
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;
}
method splitdir : string[] ($path : string) {
my $dirs = Fn->split("/", $path, -1);
return $dirs;
}
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_dirs = $self->catdir($pathchunks);
return $self->canonpath( $self->catpath("", $result_dirs, "") );
return undef;
}
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;
}
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 tmpdir : string () {
my $env_tmpdir = Sys->env("TMPDIR");
my $dirlist = [$env_tmpdir, "/tmp"];
my $tmpdir = $self->_tmpdir($dirlist);
return $tmpdir;
}
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;
}
}