Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : !> This module contains classes and procedures for manipulating system file/folder paths.
44 : !> \author Amir Shahmoradi
45 :
46 : module Path_mod
47 :
48 : use Constants_mod, only: IK ! LCOV_EXCL_LINE
49 : use Err_mod, only: Err_type
50 : implicit none
51 :
52 : character(*), parameter :: MODULE_NAME = "@Path_mod"
53 :
54 : integer(IK), parameter :: MAX_FILE_PATH_LEN = 2047
55 :
56 : !> Windows reserved characters (not allowed in filenames):
57 : character(*), parameter :: WINDOWS_RESERVED_CHAR = "<>:" // '"' // "|?*" ! /\
58 :
59 : #if defined INTEL_COMPILER_ENABLED
60 :
61 : character(*), parameter :: SHELL_ESCAPE_CHAR = &
62 : " " // & ! space character
63 : "!" // & ! history expansion.
64 : '"' // & ! shell syntax.
65 : "#" // & ! comment start when preceded by whitespace; zsh wildcards.
66 : "$" // & ! shell syntax.
67 : "&" // & ! shell syntax.
68 : "'" // & ! shell syntax.
69 : "(" // & ! even in the middle of a word: ksh extended globs (also available in bash and zsh); zsh wildcards.
70 : ")" // & ! even in the middle of a word: ksh extended globs (also available in bash and zsh); zsh wildcards.
71 : "*" // & ! sh wildcard.
72 : "," // & ! only inside brace expansion.
73 : ";" // & ! shell syntax.
74 : "<" // & ! shell syntax.
75 : "=" // & ! in zsh, when it is at the beginning of a file name (filename expansion with PATH lookup).
76 : ">" // & ! shell syntax.
77 : "?" // & ! sh wildcard.
78 : "[" // & ! sh wildcard.
79 : "\" // & ! shell syntax.
80 : "]" // & ! you may get away with leaving it unquoted.
81 : "^" // & ! history expansion; zsh wildcard.
82 : "`" // & ! shell syntax.
83 : "{" // & ! brace expansion.
84 : "|" // & ! shell syntax.
85 : "}" // & ! needs to be escaped in zsh, other shells are more lenient when there is no matching opening brace.
86 : "~" ! home directory expansion when at the beginning of a filename; zsh wildcard; safe when it is the last character.
87 :
88 : #else
89 :
90 : ! stupid gfortran (possibly version 8.3) gives error on the above syntax
91 : character(*), parameter :: SHELL_ESCAPE_CHAR = " !"//'"#$&'//"'()*,;<=>?[\]^`{|}~"
92 :
93 : #endif
94 :
95 : ! The `Path_type` class.
96 : type :: Path_type
97 : character(:), allocatable :: original !< The original path.
98 : character(:), allocatable :: modified !< The modified path based on the OS/platform type.
99 : character(:), allocatable :: dir !< The directory segment of the path.
100 : character(:), allocatable :: name !< The name of the file, if any exists in the path.
101 : character(:), allocatable :: base !< The base of the file name, if any exists in the path.
102 : character(:), allocatable :: ext !< The file extension, if any exists in the path (including the dot separator).
103 : character(1) :: shellSlash !< The type of the separator (forward/backward slash) with which the original path is *modified*.
104 : type(Err_type) :: Err !< An object of class [Err_type](@ref err_mod::err_type) containing error handling tools.
105 : contains
106 : procedure, pass :: query
107 : procedure, nopass :: modify
108 : procedure, nopass :: getDirNameExt, getDirFullName, getNameExt
109 : procedure, nopass :: winify, linify
110 : procedure, nopass :: mkdir
111 : procedure, nopass :: isdir
112 : end type Path_type
113 :
114 : interface Path_type
115 : module procedure :: constructPath
116 : end interface Path_type
117 :
118 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
119 :
120 : contains
121 :
122 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
123 :
124 : !> \brief
125 : !> This is the constructor of the class [Path_type](@ref path_type).\n
126 : !> Return an object of class [Path_type](@ref path_type) given the input specifications.
127 : !>
128 : !> \param[in] inputPath : The input path.
129 : !> \param[in] OS : An object of class [OS_type](@ref system_mod::os_type) containing information about the operating system (**optional**).
130 : !>
131 : !> \return
132 : !> `Path` : An object of class [Path_type](@ref path_type) containing the path properties and methods.
133 1985 : function constructPath(inputPath,OS) result(Path)
134 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
135 : !DEC$ ATTRIBUTES DLLEXPORT :: constructPath
136 : #endif
137 : use System_mod, only: OS_type
138 : implicit none
139 : type(Path_type) :: Path
140 : character(*), intent(in) :: inputPath
141 : type(OS_type), intent(in), optional :: OS
142 1985 : call Path%query(inputPath,OS)
143 1985 : end function constructPath
144 :
145 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
146 :
147 : !> \brief
148 : !> This procedure is a method of the class [Path_type](@ref path_type).\n
149 : !> Construct an object of class [Path_type](@ref path_type) as output.
150 : !>
151 : !> \param[inout] Path : An object of class [Path_type](@ref path_type) containing the path properties and methods.
152 : !> \param[in] inputPath : The input path (**optional**). If provided, it will overwrite `Path%original`.
153 : !> \param[in] OS : An object of class [OS_type](@ref system_mod::os_type) containing information about the operating system (**optional**).
154 : !>
155 : !> \warning
156 : !> On output, do not forget to check the value `Path%%Err%%occurred` before using the output `Path`.
157 2336 : subroutine query(Path,inputPath,OS)
158 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
159 : !DEC$ ATTRIBUTES DLLEXPORT :: query
160 : #endif
161 1985 : use Err_mod, only: Err_type
162 : use Constants_mod, only: IK
163 : use System_mod, only: OS_type
164 : use String_mod, only: replaceStr
165 : implicit none
166 : class(Path_type), intent(inout) :: Path
167 : character(*), intent(in), optional :: inputPath
168 : type(OS_type), intent(in), optional :: OS
169 : logical :: isUnixShell
170 :
171 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME//"@query()"
172 :
173 2336 : Path%Err%occurred = .false.
174 2336 : Path%Err%msg = ""
175 :
176 2336 : if (present(inputPath)) then
177 1985 : Path%original = trim(adjustl(inputPath))
178 351 : elseif (.not.allocated(Path%original)) then
179 1 : Path%Err%occurred = .true.
180 1 : Path%Err%msg = PROCEDURE_NAME//": Error occurred. Neither inputPath argument is given as input, nor Path%original is allocated to construct the Path object."
181 1 : return
182 : else
183 350 : if ( len(trim(adjustl(Path%original)))==0 ) then
184 3 : Path%Err%occurred = .true.
185 3 : Path%Err%msg = PROCEDURE_NAME//": Error occurred. Neither inputPath argument is given as input, nor Path%original has a non-blank length > 0 to construct the Path object."
186 3 : return
187 : end if
188 : end if
189 :
190 2332 : if (present(OS)) then
191 2251 : Path%shellSlash = OS%Shell%slash
192 2251 : isUnixShell = OS%Shell%isUnix
193 : else
194 486 : block
195 81 : type(OS_type) :: OS
196 81 : call OS%query()
197 81 : if (OS%Err%occurred) then
198 : ! LCOV_EXCL_START
199 : Path%Err%stat = OS%Err%stat
200 : Path%Err%occurred = OS%Err%occurred
201 : Path%Err%msg = PROCEDURE_NAME // ": Error occurred while querying OS type.\n" // Path%Err%msg
202 : end if
203 : ! LCOV_EXCL_STOP
204 81 : Path%shellSlash = OS%Shell%slash
205 567 : isUnixShell = OS%Shell%isUnix
206 : end block
207 81 : if (Path%Err%occurred) return
208 : end if
209 :
210 2332 : if (isUnixShell) then
211 : ! if the path contains both / and \, then assume that it is already in linux style
212 2332 : if (index(Path%original,"/")==0) then ! path is given in Windows style
213 14 : Path%modified = linify(Path%original)
214 : else
215 2318 : Path%modified = Path%original
216 : end if
217 : #if defined OS_IS_WINDOWS
218 : else
219 : Path%modified = winify(Path%original)
220 : #endif
221 : end if
222 :
223 2332 : call Path%getDirNameExt( Path%modified, Path%shellSlash, Path%dir, Path%name, Path%ext )
224 2332 : Path%base = Path%dir // Path%name
225 :
226 2336 : end subroutine query
227 :
228 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
229 :
230 : !> \brief
231 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
232 : !> Convert the the input path to the modified path according to the rules of the Windows operating system.
233 : !>
234 : !> \param[in] inputPath : The input path. If provided, it will overwrite `Path%original`.
235 : !>
236 : !> \return
237 : !> `outputPath` : The output modified path which conforms to the rules of the Windows OS.
238 : !>
239 : !> \warning
240 : !> This code assumes that the input path is a Linux path. Windows paths like `.\(paramonte)\paramonte.nml` will be horribly
241 : !> treated by this routine as `\(` also represents a Linux escape character. The result will be `.(paramonte)\paramonte.nml`.
242 : !>
243 : !> \warning
244 : !> This routine strictly assumes that there is no dangling `\` in the input Linux path, and if there is,
245 : !> then either it is used to escape the special shell characters, or otherwise, the path is a Windows path.
246 3 : pure function winify(inputPath) result(outputPath) !,Err)!,ignoreWindowsReservedChars)
247 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
248 : !DEC$ ATTRIBUTES DLLEXPORT :: winify
249 : #endif
250 : !use Err_mod, only: Err_type
251 2336 : use Constants_mod, only: IK
252 : use String_mod, only: replaceStr
253 : implicit none
254 : character(len=*), intent(in) :: inputPath
255 : character(:), allocatable :: outputPath
256 : !type(Err_type), intent(out) :: Err
257 : !logical, intent(in), optional :: ignoreWindowsReservedChars
258 : !logical :: reservedCharInspectionNeeded
259 : !character(*), parameter :: PROCEDURE_NAME = MODULE_NAME//"@winify()"
260 3 : character(:), allocatable :: outputPathDummy
261 : integer(IK) :: i, j, outputPathLen
262 :
263 : !Err%occurred = .false.
264 : !Err%msg = ""
265 :
266 : ! check if any character in the input path is Windows Reserved Character:
267 :
268 : !reservedCharInspectionNeeded = .true.
269 : !if (present(ignoreWindowsReservedChars)) reservedCharInspectionNeeded = .not. ignoreReservedChars
270 : !if (reservedCharInspectionNeeded) then
271 : ! do i = 1, len(WINDOWS_RESERVED_CHAR)
272 : ! if ( index(inputPath,WINDOWS_RESERVED_CHAR(i:i)) /= 0 ) then
273 : ! Err%occurred = .true.
274 : ! Err%msg = PROCEDURE_NAME // ": Error occurred. Invalid Windows character '" // &
275 : ! WINDOWS_RESERVED_CHAR(i:i) // "' detected in the input file path='" // inputPath // "'."
276 : ! return
277 : ! end if
278 : ! end do
279 : !end if
280 :
281 : !if ( index(inputPath,"\\") /= 0 ) then
282 : ! Err%occurred = .true.
283 : ! Err%msg = PROCEDURE_NAME // ": Error occurred. Invalid Windows character '\' corresponding to '\\' detected &
284 : ! & in the input file path='" // inputPath // "'."
285 : ! return
286 : !end if
287 :
288 : ! note that multiple \ character in sequence is meaningless in Linux (basically \\ reduces to \),
289 : ! and in Windows means the same as a single \. Therefore, reduce all sequential \ characters to a single \.
290 :
291 3 : outputPath = trim(adjustl(inputPath))
292 2 : loopRemoveMultipleSlash: do
293 5 : outputPathDummy = replaceStr(outputPath,"\\","\")
294 5 : if (outputPathDummy==outputPath) exit loopRemoveMultipleSlash
295 2 : outputPath = outputPathDummy
296 : end do loopRemoveMultipleSlash
297 3 : outputPathLen = len(outputPath)
298 :
299 : ! Now check for the presence of any Linux Shell Escape Character in the input path without a preceding \.
300 : ! If there is any, this would imply that the input path is a Windows path,
301 : ! otherwise a escape character without preceding \ would be invalid in Linux.
302 :
303 3 : if (outputPathLen==1_IK) then
304 2 : if (outputPath=="/") outputPath = "\"
305 2 : return
306 : else
307 26 : do i = 1, len(SHELL_ESCAPE_CHAR)
308 26 : if (SHELL_ESCAPE_CHAR(i:i)/="\") then
309 624 : do j = 2, outputPathLen
310 624 : if (outputPath(j:j)==SHELL_ESCAPE_CHAR(i:i)) then
311 3 : if (outputPath(j-1:j-1)/="\") return ! no escaping has occurred. Therefore, it is a windows path, there is no need for further winifying.
312 : end if
313 : end do
314 : end if
315 : end do
316 : end if
317 :
318 : ! By now, there is no way but to assume that the path is indeed a Linux path
319 : ! Thus, correct for any Linux Shell Escape Character in the input path:
320 :
321 26 : do i = 1, len(SHELL_ESCAPE_CHAR)
322 26 : outputPath = replaceStr(outputPath,"\"//SHELL_ESCAPE_CHAR(i:i),SHELL_ESCAPE_CHAR(i:i))
323 : end do
324 :
325 : ! Now remove any remaining backslash in the input path:
326 : ! commented out: it is assumed that there are no dangling \ in the Linux path
327 : !outputPath = replaceStr(outputPath,"\","")
328 :
329 : ! check if the file name contains white space. if so, put the entire name in quotations
330 :
331 1 : if ( index(outputPath," ") /= 0 ) then
332 1 : outputPath = '"' // outputPath // '"'
333 : end if
334 1 : outputPath = replaceStr(outputPath,"/","\")
335 :
336 3 : end function winify
337 :
338 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
339 :
340 : !> \brief
341 : !> This `pure` procedure is a static method of the class [Path_type](@ref path_type).\n
342 : !> Convert the the input path to the modified path according to the rules of the Unix operating systems.
343 : !>
344 : !> \param[in] inputPath : The input path. If provided, it will overwrite `Path%original`.
345 : !>
346 : !> \return
347 : !> `outputPath` : The output modified path which conforms to the rules of the Unix OS.
348 17 : pure function linify(inputPath) result(outputPath)
349 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
350 : !DEC$ ATTRIBUTES DLLEXPORT :: linify
351 : #endif
352 3 : use Constants_mod, only: IK
353 : use String_mod, only: replaceStr
354 : implicit none
355 : character(*), intent(in) :: inputPath
356 : character(:), allocatable :: outputPath
357 17 : character(:), allocatable :: outputPathDummy
358 : integer(IK) :: i
359 :
360 : ! check if the path is sandwiched between quotation marks. If so, remove them:
361 17 : outputPath = trim(adjustl(inputPath))
362 17 : i = len(outputPath)
363 17 : if (i==0) return
364 12 : if ( i>1 ) then
365 12 : if ( (outputPath(1:1)=='"' .and. outputPath(i:i)=='"') .or. (outputPath(1:1)=="'" .and. outputPath(i:i)=="'") )then
366 2 : outputPathDummy = outputPath(2:i-1)
367 : else
368 10 : outputPathDummy = outputPath
369 : end if
370 : end if
371 :
372 : ! First change all backslashes to forward slash:
373 12 : outputPath = replaceStr(outputPathDummy,"\","/")
374 :
375 : ! Now correct for any Linux Shell Escape Character in the input path:
376 312 : do i = 1, len(SHELL_ESCAPE_CHAR)
377 312 : if (SHELL_ESCAPE_CHAR(i:i)/="\") then
378 288 : outputPathDummy = replaceStr(outputPath,SHELL_ESCAPE_CHAR(i:i),"\"//SHELL_ESCAPE_CHAR(i:i))
379 288 : outputPath = outputPathDummy
380 : end if
381 : end do
382 :
383 : !! Now correct for any white spaces in outputPath:
384 : !outputPath = replaceStr(outputPath," ","\ ")
385 :
386 17 : end function linify
387 :
388 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
389 :
390 : !> \brief
391 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
392 : !> Modify the input path to conform to the rules of the current inferred operating system.
393 : !>
394 : !> \param[in] inputPath : The input path. If provided, it will overwrite `Path%original`.
395 : !> \param[out] outputPath : The output modified path which conforms to the rules of the current OS.
396 : !> \param[out] Err : An object of class [Err_type](@ref err_mod::err_type) containing error handling tools.
397 1 : subroutine modify(inputPath,outputPath,Err)
398 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
399 : !DEC$ ATTRIBUTES DLLEXPORT :: modify
400 : #endif
401 17 : use Err_mod, only: Err_type
402 : use Constants_mod, only: IK
403 : use System_mod, only: OS_type
404 : use String_mod, only: replaceStr
405 : implicit none
406 : character(len=*), intent(in) :: inputPath
407 : character(:), allocatable, intent(out) :: outputPath
408 : type(Err_type), intent(out) :: Err
409 :
410 1 : type(OS_type) :: OS
411 :
412 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME//"@modify()"
413 :
414 1 : outputPath = trim(adjustl(inputPath))
415 :
416 1 : Err%occurred = .false.
417 1 : Err%msg = ""
418 :
419 1 : call OS%query()
420 :
421 1 : if (OS%Err%occurred) then
422 : ! LCOV_EXCL_START
423 : Err = OS%Err
424 : Err%msg = PROCEDURE_NAME // ": Error occurred while modifying inputPath='" // outputPath // "'.\n" // Err%msg
425 : return
426 : end if
427 : ! LCOV_EXCL_STOP
428 :
429 1 : if (OS%Shell%isUnix) then
430 1 : outputPath = linify(inputPath)
431 : #if defined OS_IS_WINDOWS
432 : else
433 : outputPath = winify(inputPath)
434 : #endif
435 : end if
436 :
437 1 : end subroutine modify
438 :
439 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
440 :
441 : !> \brief
442 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
443 : !> Split the input path to directory, base file name, and the file extension, based on the input OS slash.
444 : !>
445 : !> \param[in] path : The input path.
446 : !> \param[in] slash : The separator used by the operating system to delimit segments of a path.
447 : !> \param[out] dir : The directory segment of the path.
448 : !> \param[out] name : The base file name segment of the path.
449 : !> \param[out] ext : The file extension segment of the path.
450 2334 : subroutine getDirNameExt(path,slash,dir,name,ext)
451 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
452 : !DEC$ ATTRIBUTES DLLEXPORT :: getDirNameExt
453 : #endif
454 : implicit none
455 : character(*) , intent(in) :: path
456 : character(1) , intent(in) :: slash
457 : character(:), allocatable, intent(out) :: dir, name, ext
458 2334 : character(:), allocatable :: fullName
459 2334 : call getDirFullName(path,slash,dir,fullName)
460 2334 : call getNameExt(fullName,name,ext)
461 2335 : end subroutine getDirNameExt
462 :
463 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
464 :
465 : !> \brief
466 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
467 : !> Return the directory and full filename (including the file extension) of the input path.
468 : !>
469 : !> \param[in] path : The input path.
470 : !> \param[in] slash : The separator used by the operating system to delimit segments of a path.
471 : !> \param[out] dir : The directory segment of the path.
472 : !> \param[out] fullName : The full file name and extension segment of the path.
473 2336 : subroutine getDirFullName(path,slash,dir,fullName)
474 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
475 : !DEC$ ATTRIBUTES DLLEXPORT :: getDirFullName
476 : #endif
477 2334 : use Constants_mod, only: IK
478 : implicit none
479 : character(*) , intent(in) :: path
480 : character(1) , intent(in) :: slash
481 : character(:), allocatable, intent(out) :: dir, fullName
482 :
483 : integer(IK) :: pathLen, slashPos
484 :
485 2336 : pathLen = len(path)
486 :
487 2336 : if ( pathLen==0 ) then
488 5 : dir=""; fullName=""
489 5 : return
490 : end if
491 :
492 2331 : slashPos = index(path,slash,back=.true.)
493 :
494 2331 : if (slashPos==0) then ! it is all filename
495 10 : dir = ""
496 10 : fullName = path
497 2321 : elseif (slashPos==pathLen) then ! it is all directory
498 161 : dir = path
499 161 : fullName = ""
500 161 : return
501 : else
502 2160 : dir = path(1:slashPos)
503 2160 : fullName = path(slashPos+1:pathLen)
504 : end if
505 :
506 2336 : end subroutine getDirFullName
507 :
508 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
509 :
510 : !> \brief
511 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
512 : !> Return the name and file extension of the input full file name.
513 : !>
514 : !> \param[in] fullName : The full file name and extension of the path.
515 : !> \param[out] name : The name segment of the file.
516 : !> \param[out] ext : The extension segment of the file (including the dot separator).
517 2336 : subroutine getNameExt(fullName,name,ext)
518 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
519 : !DEC$ ATTRIBUTES DLLEXPORT :: getNameExt
520 : #endif
521 2336 : use Constants_mod, only: IK
522 : implicit none
523 : character(*), intent(in) :: fullName
524 : character(:), allocatable, intent(out) :: name,ext
525 : integer(IK) :: dotPos, lenFilename
526 2336 : lenFilename = len(fullName)
527 2336 : if (lenFilename==0) then
528 166 : name = ""; ext = ""
529 166 : return
530 : else
531 2170 : dotPos = index(fullName,".",back=.true.)
532 2170 : if ( dotPos==0 .or. dotPos==lenFilename ) then ! there is no extension
533 413 : name = fullName
534 413 : ext = ""
535 : else
536 1757 : name = fullName(1:dotPos-1)
537 1757 : ext = fullName(dotPos:)
538 : end if
539 : end if
540 2336 : end subroutine getNameExt
541 :
542 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
543 :
544 : !> \brief
545 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
546 : !> Make the requested (nested) directory (recursively, if needed).
547 : !>
548 : !> \param[in] dirPath : The full directory path.
549 : !> \param[in] isUnixShell : The logical flag indicating whether the OS is Windows (**optional**).
550 : !> If not present, the runtime shell type will be inferred by the procedure.
551 : !> \param[in] wait : The logical flag indicating whether the procedure should wait for the system
552 : !> operation to complete and return (**optional**, default = `.true.`).
553 : !>
554 : !> \return
555 : !> `Err` : An object of class [Err_type](@ref err_mod::err_type), indicating whether an error has occurred while creating the directory.
556 : !>
557 : !> \author
558 : !> Last updated by Amir Shahmoradi, Tuesday 3:09 AM, Dec 8, 2020, Dallas, TX
559 383 : function mkdir(dirPath,isUnixShell,wait) result(Err)
560 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
561 : !DEC$ ATTRIBUTES DLLEXPORT :: mkdir
562 : #endif
563 2336 : use Constants_mod, only: IK, NLC
564 : use System_mod, only: SysCmd_type, OS_type
565 : use String_mod, only: num2str
566 : use Err_mod, only: Err_type
567 : implicit none
568 : character(*), parameter :: PROCEDURE_NAME = MODULE_NAME//"@mkdir()"
569 : character(*), intent(in) :: dirPath
570 : logical, intent(in), optional :: isUnixShell, wait
571 : type(Err_type) :: Err
572 383 : type(SysCmd_type) :: SysCmd
573 383 : type(OS_type) :: OS
574 : logical :: isUnixShellDefault
575 383 : character(:), allocatable :: command
576 : integer(IK) :: itry
577 :
578 :
579 :
580 383 : Err%occurred = .false.
581 :
582 383 : if (present(isUnixShell)) then
583 349 : isUnixShellDefault = isUnixShell
584 : else
585 34 : OS%Err%occurred = .false.
586 34 : call OS%query()
587 34 : if (OS%Err%occurred) then
588 : ! LCOV_EXCL_START
589 : command = 'mkdir "'//dirPath//'"'
590 : ! LCOV_EXCL_STOP
591 : else
592 34 : isUnixShellDefault = OS%Shell%isUnix
593 : end if
594 : end if
595 :
596 383 : if (.not. allocated(command)) then
597 383 : if (isUnixShellDefault) then
598 383 : command = 'mkdir -p "'//dirPath//'" > /dev/null 2>&1' ! -p enables nested mkdir
599 : #if defined OS_IS_WINDOWS
600 : else
601 : command = 'mkdir "'//dirPath//'" >nul 2>&1' ! WARNING: path has to be enclosed with "" to allow nested mkdir
602 : #endif
603 : end if
604 : end if
605 :
606 : ! Try to create the folder for 10 times, and fail if all attempts fail.
607 :
608 383 : loopTry: do itry = 1, 10
609 383 : SysCmd = SysCmd_type(command, wait)
610 383 : if (SysCmd%Err%occurred .and. .not. isdir(dirPath)) cycle loopTry
611 383 : deallocate(command)
612 383 : return
613 : end do loopTry
614 :
615 : ! LCOV_EXCL_START
616 : Err%occurred = .true.
617 : Err%stat = SysCmd%Err%stat
618 : Err%msg = PROCEDURE_NAME // SysCmd%Err%msg //NLC//"execute_command_line() exitstat: " // num2str(SysCmd%exitstat)
619 : ! LCOV_EXCL_STOP
620 :
621 383 : end function mkdir
622 :
623 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
624 :
625 : !> \brief
626 : !> This procedure is a static method of the class [Path_type](@ref path_type).\n
627 : !> Return `.true.` if the input path is a directory, otherwise, return `.false.`.
628 : !>
629 : !> \param[in] path : The full directory path.
630 : !>
631 : !> \return
632 : !> `pathIsDir` : A logical output variable indicating whether the input path is a directory.
633 : !>
634 : !> \author
635 : !> Amir Shahmoradi, Tuesday 3:09 AM, Dec 8, 2020, Dallas, TX
636 384 : function isdir(path) result(pathIsDir)
637 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
638 : !DEC$ ATTRIBUTES DLLEXPORT :: isdir
639 : #endif
640 : implicit none
641 : character(*), intent(in) :: path
642 : logical :: pathIsDir
643 : #if defined INTEL_COMPILER_ENABLED
644 : inquire(directory = path, exist = pathIsDir)
645 : #elif defined GNU_COMPILER_ENABLED
646 384 : inquire(file = path, exist = pathIsDir)
647 : #else
648 : #error "This procedure does not currently support compilers other than Intel ifort and GNU gfortran."
649 : #endif
650 767 : end function isdir
651 :
652 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
653 :
654 : end module Path_mod ! LCOV_EXCL_LINE
|
