| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in), | optional | :: | version | identifies the version of UUID to be used (see section 4.1.3 of the RFC). Only versions 0, 1, and 4 are supported. Version 0 generates a nil UUID; version 1 a time-based UUID, and version 4 a pseudo-randomly-generated UUID. Version 1 is the default, and is recommended. |
function generate_uuid(version) result(uuid)
integer, intent(in), optional :: version !! identifies the version of UUID to be
!! used (see section 4.1.3 of the RFC).
!! Only versions 0, 1, and 4 are supported.
!! Version 0 generates a nil UUID; version 1 a
!! time-based UUID, and version 4 a
!! pseudo-randomly-generated UUID.
!!
!! Version 1 is the default, and is recommended.
character(len=36) :: uuid
integer(kind=INT64) :: timestamp, node
integer(kind=INT32) :: clock_sequence
integer(kind=INT32) :: time_low, time_mid, time_hi_and_version
integer(kind=INT32) :: clk_seq_hi_res, clk_seq_low
integer,dimension(8) :: values !! must be default for `date_and_time`
integer(kind=INT32) :: variant, v
if (.not.initialized) then
! Use the current date and time to init mtprng
! but this gives limited varaibility, so mix
! the result up. Can we do better? In any
! case, this gets passed through a quick
! generator inside mtprng_init.
call date_and_time(values=values)
values(7) = values(7)*1000+values(5)*100+values(3)*10+values(1)
values(8) = values(2)*1000+values(4)*100+values(6)*10+values(8)
call mtprng_init(int(values(7)*10000+values(8), INT32), rng_state)
clock_seq = int(mtprng_rand64(rng_state), INT32)
initialized = .true.
endif
variant = 1
if (present(version)) then
v = version
else
v = 4
endif
select case (v)
case (0)
! Nil UUID - S 4.1.7
uuid = repeat('0',8)//'-'//repeat('0',4)//'-'//repeat('0',4)// &
'-'//repeat('0',4)//'-'//repeat('0',12)
return
case(1)
call date_and_time(values=values)
! In case of too-frequent requests, we will replace time_low
! with the count below ...
if (all(values==values_save)) then
hires_count = hires_count + 1
else
hires_count = 0
endif
case(2:3)
!Unimplemented
uuid = ''
return
case(4)
continue
case(5)
!Unimplemented
uuid = ''
return
case default
!Unspecified
uuid = ''
return
end select
!4.1.4 Timestamp
select case(v)
case(1)
timestamp = get_utc_since_1582(values)
case(4)
timestamp = ior(mtprng_rand64(rng_state), ishft(mtprng_rand64(rng_state), 28))
end select
!4.1.5 Clock Sequence
! 14 bits
select case(v)
case(1)
clock_sequence = clock_seq
case(4)
clock_sequence = int(mtprng_rand64(rng_state), INT32)
end select
!4.1.6 Node
! 48 bits
select case(v)
case(1)
node = ior(mtprng_rand64(rng_state), ishft(mtprng_rand64(rng_state), 16))
! No MAC address accessible - see section 4.5 !FIXME
case(4)
node = ior(mtprng_rand64(rng_state), ishft(mtprng_rand64(rng_state), 16))
end select
time_low = ibits(timestamp, 0, 32)
time_mid = ibits(timestamp, 32, 16)
if (hires_count==0) then
time_hi_and_version = ior(int(ibits(timestamp, 48, 12), INT32), ishft(v, 12))
else
time_hi_and_version = ior(hires_count, ishft(v, 12))
endif
clk_seq_low = ibits(clock_sequence, 0, 8)
clk_seq_hi_res = ior(ibits(clock_sequence, 8, 6), ishft(variant, 6))
uuid = int32ToHexOctets(time_low, 4)//"-"// &
int32ToHexOctets(time_mid, 2)//"-"// &
int32ToHexOctets(time_hi_and_version, 2)//"-"// &
int32ToHexOctets(clk_seq_hi_res, 1)// &
int32ToHexOctets(clk_seq_low, 1)//"-"// &
int64ToHexOctets(node, 6)
contains
function int32ToHexOctets(b, n) result(s)
integer(INT32), intent(in) :: b
integer, intent(in) :: n ! number of octets to print
character(len=2*n) :: s
integer :: i
do i = 0, 2*n-1
s(2*n-i:2*n-i) = hexdigits(ibits(b, i*4, 4))
enddo
end function int32ToHexOctets
function int64ToHexOctets(b, n) result(s)
integer(INT64), intent(in) :: b
integer, intent(in) :: n ! number of octets to print
character(len=2*n) :: s
integer :: i
do i = 0, 2*n-1
s(2*n-i:2*n-i) = hexdigits(ibits(b, i*4, 4))
enddo
end function int64ToHexOctets
end function generate_uuid