construct_ISO8601Duration Function

public function construct_ISO8601Duration(isostring, imin, imax, rc) result(duration)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: isostring
integer, intent(in) :: imin
integer, intent(in) :: imax
integer, intent(out), optional :: rc

Return Value type(ISO8601Duration)


Calls

proc~~construct_iso8601duration~~CallsGraph proc~construct_iso8601duration construct_ISO8601Duration interface~mapl_assert MAPL_Assert proc~construct_iso8601duration->interface~mapl_assert proc~is_digit is_digit proc~construct_iso8601duration->proc~is_digit proc~mapl_return MAPL_Return proc~construct_iso8601duration->proc~mapl_return proc~read_whole_number_indexed read_whole_number_indexed proc~construct_iso8601duration->proc~read_whole_number_indexed at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~get_integer_digit_from_string get_integer_digit_from_string proc~read_whole_number_indexed->proc~get_integer_digit_from_string proc~is_whole_number is_whole_number proc~read_whole_number_indexed->proc~is_whole_number proc~get_integer_digit get_integer_digit proc~get_integer_digit_from_string->proc~get_integer_digit

Called by

proc~~construct_iso8601duration~~CalledByGraph proc~construct_iso8601duration construct_ISO8601Duration interface~iso8601duration ISO8601Duration interface~iso8601duration->proc~construct_iso8601duration

Source Code

   function construct_ISO8601Duration(isostring, imin, imax, rc) result(duration)
      character(len=*), intent(in) :: isostring
      integer, intent(in) :: imin
      integer, intent(in) :: imax
      integer, optional, intent(out) :: rc
      type(ISO8601Duration) :: duration
      integer :: years = -1
      integer :: months = -1
      integer :: days = -1
      integer :: hours = -1
      integer :: minutes = -1
      integer :: seconds = -1
      integer :: istart = -1
      integer :: istop = -1
      logical :: time_found = .FALSE.
      logical :: successful = .FALSE.
      character :: c
      integer :: pos

      ! Check indices and first character is 'P'
      successful = ((imin > 0) .and. (imax <= len(isostring)) .and. &
         (imin <= imax) .and. (isostring(imin:imin) == 'P'))

      pos = imin + 1

      ! This do loop reads a character at a time, digit and nondigit.
      ! A field string consists of digits forming an integer n followed by
      ! a field character. A field character must be preceded by an integer.
      ! A field character indicates that the preceding digit characters
      ! should be processed as values for the corresponding field.
      ! The field characters are:
      !  Y(ear)
      !  M(onth)
      !  D(ay)
      !  H(our)
      !  M(inute)
      !  S(econd)
      ! The date and time portions of the string are delimited by T.
      ! Fields can be omitted, but they must be in order (see above).
      ! Omitted fields are set to 0.  A zero field cannot be specified by a
      ! field character without a preceding integer.
      do while(successful .and. (pos <= imax))
         successful = .FALSE.
         c = isostring(pos:pos)
         if(time_found) then
            ! Once the time is found, M should be processed as M(inute).
            select case(c)
               case('H')
                  ! Verify the field or preceding fields have not been set.
                  ! Then process the preceding digit character as an integer.
                  ! Once processed reset the istart index to start processing
                  ! digits. The same logic applies for each case below.
                  if(hours >= 0 .or. minutes >= 0 .or. &
                     seconds >= 0 .or. istart < 1) cycle
                  hours = read_whole_number_indexed(isostring, istart, istop)
                  if(hours < 0) cycle
                  istart = 0
               case('M')
                  if(minutes >= 0 .or. seconds >= 0 .or. istart < 1) cycle
                  minutes = read_whole_number_indexed(isostring, istart, istop)
                  if(minutes < 0) cycle
                  if(hours < 0) hours = 0
                  istart = 0
               case('S')
                  if(seconds >= 0 .or. istart < 1) cycle
                  seconds = read_whole_number_indexed(isostring, istart, istop)
                  if(seconds < 0) cycle
                  if(hours < 0) hours = 0
                  if(minutes < 0) minutes = 0
                  istart = 0
               case default
                  if(.not. is_digit(c)) cycle
                  if(istart == 0) istart = pos
                  istop = pos
            end select
         else
            ! Until the time is found, M should be processed as M(onth).
            select case(c)
               case('T')
                  time_found = .TRUE.
                  if(years < 0) years = 0
                  if(months < 0) months = 0
                  if(days < 0) days = 0
               case('Y')
                  if(years >= 0 .or. months >= 0 .or. &
                     days >= 0 .or. istart < 1) cycle
                  years = read_whole_number_indexed(isostring, istart, istop)
                  if(years < 0) cycle
                  istart = 0
               case('M')
                  if(months >= 0 .or. days >= 0 .or. istart < 1) cycle
                  months = read_whole_number_indexed(isostring, istart, istop)
                  if(months < 0) cycle
                  if(years < 0) years = 0
                  istart = 0
               case('D')
                  if(days >= 0 .or. istart < 1) cycle
                  days = read_whole_number_indexed(isostring, istart, istop)
                  if(days < 0) cycle
                  if(years < 0) years = 0
                  if(months < 0) months = 0
                  istart = 0
               case default
                  if(.not. is_digit(c)) cycle
                  ! istart == 0 indicates that a new integer is being processed.
                  if(istart == 0) istart = pos
                  ! The istop index should be the current position.
                  istop = pos
            end select
         end if
         successful = .TRUE.
         pos = pos + 1
      end do

      if(successful) then
         duration%years_= years
         duration%months_= months
         duration%days_= days
         duration%hours_= hours
         duration%minutes_= minutes
         duration%seconds_= seconds
         _RETURN(_SUCCESS)
      else
         _FAIL('Invalid ISO 8601 datetime duration string')
      end if
   end function construct_ISO8601Duration