module utilities

#ifdef WINDOWS
    character, parameter::dir_sep = '\'
#else
    character, parameter::dir_sep = '/'
#endif

contains

    function is_absolute_path(path)
    implicit none
    
        logical::is_absolute_path
        character(len=*), intent(in)::path
        
        is_absolute_path = .false.
        if(path(1:1) == dir_sep) then
            is_absolute_path = .true.
        else
#ifdef WINDOWS
            if(path(2:2) == ":") then
                is_absolute_path = .true.
            end if
#endif
        end if
        
    end function is_absolute_path
        
    subroutine combine_paths(first, second, res)
    implicit none
    
        character(len=*), intent(in)::first, second
        character(len=*), intent(out)::res
    
        integer::i
        
        i = len_trim(first)
    
        if(first(i:i) == dir_sep) then
            res = trim(first)//trim(second)
        else
            res = trim(first)//dir_sep//trim(second)
        end if
        
    end subroutine combine_paths
    
    subroutine write_date_and_time(unit_number, values)
    implicit none
    
        integer, intent(in)::unit_number
        integer, intent(in), dimension(8)::values

        write(unit_number, '(I4, A1, I2, A1, I2, 1X, I2, A1, I2, A1, I2)') &
            values(1), "-", &
            values(2), "-", &
            values(3),  &
            values(5), ":", &
            values(6), ":", &
            values(7)

    end subroutine write_date_and_time
    
    function remove_directory(absolute_dir, and_files)
    implicit none
    
        character(*), intent(in)::absolute_dir
        logical, intent(in), optional::and_files
        logical::remove_directory
        
        character(len=8)::cmd, flags
        integer::retval
        
#ifdef WINDOWS        
        flags = " "
        cmd = "rmdir"
#else
        flags = "-r"
        cmd = "rm"
#endif

        if(present(and_files)) then
            if(and_files) then
#ifdef WINDOWS
                flags = "/S /Q"
#else
                flags = "-rf"
#endif
            end if
        end if
        
        call execute_command_line(trim(cmd)//" "//trim(flags)//" "//trim(absolute_dir), &
                                  wait=.true., exitstat=retval)
            
        remove_directory = (retval == 0)
        
    end function remove_directory
    
    function read_into_buffer(unit_number, buffer)
    implicit none
    
        integer, intent(in)::unit_number
        character, dimension(*), intent(out)::buffer
        integer::read_into_buffer
        
        integer::i, ierr
        
        ierr = 0
        i = 0
        do while(ierr == 0 .and. i < len(buffer))
            i = i + 1
            read(unit_number, iostat=ierr) buffer(i)
        end do
            
        if(ierr /= 0) then
            i = i - 1
        end if
        
        read_into_buffer = i
    
    end function read_into_buffer
    
    function generate_temporary_filename() result(fullpath)
    use iso_c_binding
    implicit none
    
        character(len=:), pointer::fullpath
        type(c_ptr)::tmp_name
        character(kind=c_char), dimension(:), pointer::cfullpath
        integer(kind=c_size_t)::clength
        integer::i
        
        interface
            function c_strlen(p) bind(c, name='strlen')
            use iso_c_binding
            type(c_ptr), value::p
            integer(kind=c_size_t)::strlen
            end function c_strlen
            
            function c_malloc(x) bind(c, name='malloc')
            use iso_c_binding
            type(c_ptr)::c_malloc
            integer(kind=c_size_t), value::x
            end function c_malloc
            
            subroutine c_free(p) bind(c, name='free')
            use iso_c_binding
            type(c_ptr), value::p
            end subroutine c_free
            
        end interface

#ifdef WINDOWS
        interface
            function GetTempPath(n, b) bind(c, name='GetTempPathA')
            use iso_c_binding
            integer(kind=c_int32_t)::GetTempPath
            integer(kind=c_int32_t), value::n
            type(c_ptr), value::b
        
            function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA')
            use iso_c_binding
            integer(kind=c_int)::GetTempFileName
            integer(kind=c_int), value::unique
            type(c_ptr), value::pn, prefix, b
            end function GetTempFileName
        end interface
        
        type(c_ptr)::tmp_path
        integer::res
        
        tmp_path = c_malloc(1024)
        res = GetTempPath(1023, tmp_path)
        
        tmp_name = c_malloc(1024)
        res = GetTempFileName(tmp_path, c_null_ptr(), 0, tmp_name)
        
        c_free(tmp_path)
#else
        interface
            function tmpnam(p) bind(c, name='tmpnam')
            use iso_c_binding
            type(c_ptr), value::p
            type(c_ptr)::tmpnam
            end function tmpnam
        end interface
        
        type(c_ptr)::ignored
        
        tmp_name = c_malloc(int(1024, kind=c_size_t))
        
        ignored = tmpnam(tmp_name)
#endif

        ! Convert the C Ptr to a Fortran object
        clength = c_strlen(tmp_name)
        call c_f_pointer(tmp_name, cfullpath, (/ clength /))
        allocate(character(len=clength)::fullpath)
        do i = 1, clength
            fullpath(i:i) = cfullpath(i)
        end do
        
        cfullpath => null()
        call c_free(tmp_name)
        
    end function generate_temporary_filename
    
end module utilities