Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | local_path |
Local path to checkout in |
||
character(len=:), | intent(out), | allocatable | :: | object |
Git object reference |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=*), | public, | parameter | :: | hexdigits | = | '0123456789abcdef' | |
integer, | public | :: | iend | ||||
character(len=:), | public, | allocatable | :: | iomsg | |||
integer, | public | :: | istart | ||||
character(len=:), | public, | allocatable | :: | line | |||
integer, | public | :: | stat | ||||
character(len=:), | public, | allocatable | :: | temp_file | |||
integer, | public | :: | unit | ||||
character(len=:), | public, | allocatable | :: | workdir |
subroutine git_revision(local_path, object, error)
!> Local path to checkout in
character(*), intent(in) :: local_path
!> Git object reference
character(len=:), allocatable, intent(out) :: object
!> Error
type(error_t), allocatable, intent(out) :: error
integer :: stat, unit, istart, iend
character(len=:), allocatable :: temp_file, line, iomsg, workdir
character(len=*), parameter :: hexdigits = '0123456789abcdef'
workdir = "--work-tree="//local_path//" --git-dir="//join_path(local_path, ".git")
allocate(temp_file, source=get_temp_filename())
line = "git "//workdir//" log -n 1 > "//temp_file
call execute_command_line(line, exitstat=stat)
if (stat /= 0) then
call fatal_error(error, "Error while retrieving commit information")
return
end if
open(file=temp_file, newunit=unit)
call getline(unit, line, stat, iomsg)
if (stat /= 0) then
call fatal_error(error, iomsg)
return
end if
close(unit, status="delete")
! Tokenize:
! commit 0123456789abcdef (HEAD, ...)
istart = scan(line, ' ') + 1
iend = verify(line(istart:), hexdigits) + istart - 1
if (iend < istart) iend = len(line)
object = line(istart:iend)
end subroutine git_revision