find_matching_end_tag Subroutine

private pure subroutine find_matching_end_tag(source, start_pos, tag_name, end_pos)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: source

Source containing tag content.
integer(kind=I4P), intent(in) :: start_pos

Start tag content position.
character(len=*), intent(in) :: tag_name

Tag name.
integer(kind=I4P), intent(out) :: end_pos

End tag position.

Called by

proc~~find_matching_end_tag~~CalledByGraph proc~find_matching_end_tag find_matching_end_tag proc~get_tag_content get_tag_content proc~get_tag_content->proc~find_matching_end_tag proc~parse_from_string xml_file%parse_from_string proc~parse_from_string->proc~get_tag_content proc~parse~2 xml_file%parse proc~parse~2->proc~parse_from_string program~foxy_test_delete_tag foxy_test_delete_tag program~foxy_test_delete_tag->proc~parse~2 program~foxy_test_parse_file_simple foxy_test_parse_file_simple program~foxy_test_parse_file_simple->proc~parse~2 program~foxy_test_parse_string_nested_tags foxy_test_parse_string_nested_tags program~foxy_test_parse_string_nested_tags->proc~parse~2 program~foxy_test_parse_string_simple foxy_test_parse_string_simple program~foxy_test_parse_string_simple->proc~parse~2 program~foxy_test_write_tag foxy_test_write_tag program~foxy_test_write_tag->proc~parse~2

Source Code

   pure subroutine find_matching_end_tag(source, start_pos, tag_name, end_pos)
   character(*),              intent(in)  :: source          !< Source containing tag content.
   character(*),              intent(in)  :: tag_name        !< Tag name.
   integer(I4P),              intent(in)  :: start_pos       !< Start tag content position.
   integer(I4P),              intent(out) :: end_pos         !< End tag position.
   character(:), allocatable              :: open_tag        !< Open tag.
   character(:), allocatable              :: end_tag         !< End tag.
   integer(I4P)                           :: pos, pos_tmp(2) !< Position counter.
   integer(I4P)                           :: tag_count       !< Tags counter.

   open_tag = '<'//trim(tag_name)
   end_tag = '</'//trim(tag_name)//'>'
   tag_count = 1
   pos = start_pos
   end_pos = 0

   ! search for next open tag with the same name
   pos_tmp(1) = index(source(pos:), trim(open_tag)) ! relative position
   pos_tmp(2) = index(source(pos:), trim(end_tag))  ! relative position
   if (pos_tmp(1)<pos_tmp(2)) then
      ! there are nested tags with the same name
      do while (pos <= len_trim(source) .and. tag_count > 0)
         ! search next tag with the same name
         pos_tmp(1) = index(source(pos:), trim(open_tag)) ! relative position
         if (pos_tmp(1) > 0) then
            pos_tmp(1) = pos + pos_tmp(1) - 1 ! absolute position
            ! check if it is open tag
            if (pos_tmp(1) + len_trim(open_tag) <= len_trim(source)) then
               if (source(pos_tmp(1)+len_trim(open_tag):pos_tmp(1)+len_trim(open_tag)) == '>' .or. &
                   source(pos_tmp(1)+len_trim(open_tag):pos_tmp(1)+len_trim(open_tag)) == ' ') then
                  ! open tag
                  tag_count = tag_count + 1           ! update tags counter
                  pos = pos_tmp(1) + len_trim(open_tag) ! update position after tag
                  cycle
               endif
            endif
         endif

         ! search next end tag
         pos_tmp(1) = index(source(pos:), trim(end_tag)) ! relative position
         if (pos_tmp(1) > 0) then
            pos_tmp(1) = pos + pos_tmp(1) - 1 ! absolute position
            tag_count = tag_count - 1     ! update tags counter
            if (tag_count == 0) then
               ! found matching end tag
               end_pos = pos_tmp(1)
               return
            endif
            pos = pos_tmp(1) + len_trim(end_tag) ! update position after tag
         else
            exit
         endif
      enddo
   elseif (pos_tmp(2)<0) then
      ! there is a problem
   else
      end_pos = pos + pos_tmp(2) - 1 ! absolute position
   endif
   endsubroutine find_matching_end_tag