1########################################################################### 2# A module with functions to handle paths 3# 4# Copyright (C) 2017-2018 Andrey Ponomarenko's ABI Laboratory 5# 6# Written by Andrey Ponomarenko 7# 8# This library is free software; you can redistribute it and/or 9# modify it under the terms of the GNU Lesser General Public 10# License as published by the Free Software Foundation; either 11# version 2.1 of the License, or (at your option) any later version. 12# 13# This library is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16# Lesser General Public License for more details. 17# 18# You should have received a copy of the GNU Lesser General Public 19# License along with this library; if not, write to the Free Software 20# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 21# MA 02110-1301 USA 22########################################################################### 23use strict; 24use Cwd qw(realpath); 25 26sub pathFmt(@) 27{ 28 my $Path = shift(@_); 29 my $Fmt = $In::Opt{"OS"}; 30 if(@_) { 31 $Fmt = shift(@_); 32 } 33 34 $Path=~s/[\/\\]+\.?\Z//g; 35 if($Fmt eq "windows") 36 { 37 $Path=~s/\//\\/g; 38 $Path = lc($Path); 39 } 40 else 41 { # forward slash to pass into MinGW GCC 42 $Path=~s/\\/\//g; 43 } 44 45 $Path=~s/[\/\\]+\Z//g; 46 47 return $Path; 48} 49 50sub getAbsPath($) 51{ # abs_path() should NOT be called for absolute inputs 52 # because it can change them 53 my $Path = $_[0]; 54 if(not isAbsPath($Path)) { 55 $Path = abs_path($Path); 56 } 57 return pathFmt($Path); 58} 59 60sub realpath_F($) 61{ 62 my $Path = $_[0]; 63 return pathFmt(realpath($Path)); 64} 65 66sub classifyPath($) 67{ 68 my $Path = $_[0]; 69 if($Path=~/[\*\+\(\[\|]/) 70 { # pattern 71 return ($Path, "Pattern"); 72 } 73 elsif($Path=~/[\/\\]/) 74 { # directory or relative path 75 return (pathFmt($Path), "Path"); 76 } 77 else { 78 return ($Path, "Name"); 79 } 80} 81 82sub join_P($$) 83{ 84 my $S = "/"; 85 if($In::Opt{"OS"} eq "windows") { 86 $S = "\\"; 87 } 88 return join($S, @_); 89} 90 91return 1; 92