diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-02-25 17:22:43 -0500 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-02-25 17:22:43 -0500 |
commit | 452ceb636e37fab2927c688e7b495841879ea29a (patch) | |
tree | dee91a09e774c998f6b978f1ef4fa780e18029b1 /fsutil.F90 | |
download | fpoint-452ceb636e37fab2927c688e7b495841879ea29a.tar.gz fpoint-452ceb636e37fab2927c688e7b495841879ea29a.zip |
Initial code commit
Diffstat (limited to 'fsutil.F90')
-rw-r--r-- | fsutil.F90 | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/fsutil.F90 b/fsutil.F90 new file mode 100644 index 0000000..3dcf20c --- /dev/null +++ b/fsutil.F90 @@ -0,0 +1,88 @@ +! Copyright (c) 2022 Approximatrix, LLC <support@approximatrix.com> +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! The Software shall be used for Good, not Evil. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +! SOFTWARE. + +module fpoint_fsutil +implicit none + +#ifdef __WIN32__ + character, parameter::pathsep = '\' +#else + character, parameter::pathsep = '/' +#endif + +contains + + subroutine append_to_path(path, additive) + implicit none + + character(len=*), intent(inout)::path + character(len=*), intent(in)::additive + integer::istart + + if(path(len_trim(path):len_trim(path)) /= pathsep) then + path = trim(path)//pathsep + end if + + istart = 1 + if(additive(1:1) == pathsep) then + istart = 2 + end if + + path = trim(path)//additive(istart:len_trim(additive)) + + end subroutine append_to_path + + subroutine get_temporary_directory(dir) + implicit none + + character(len=*), intent(out)::dir + + call get_environment_variable("TEMP", dir) + + end subroutine get_temporary_directory + + subroutine make_directory(dir) + use iso_c_binding + implicit none + + character(len=*), intent(in)::dir + +#ifdef __WIN32__ + character(len=:, kind=c_char), pointer::cdir + interface + subroutine make_dir(str) bind(c, name="make_directory_on_windows") + use iso_c_binding + type(c_ptr), value::str + end subroutine make_dir + end interface + + allocate(character(len=(len_trim(dir)+1))::cdir) + cdir = trim(dir)//c_null_char + call make_dir(c_loc(cdir)) + deallocate(cdir) +#else + call execute_command_line('mkdir "'//trim(dir)//'"', wait=.true.) +#endif + + end subroutine make_directory + +end module fpoint_fsutil
\ No newline at end of file |