parse_from_string Subroutine

private pure subroutine parse_from_string(self, source_string)

Parse xml data from a chunk of source string (file stringified for IO on device).

Type Bound

xml_file

Arguments

Type IntentOptional Attributes Name
class(xml_file), intent(inout) :: self

XML file handler.
character(len=*), intent(in) :: source_string

String containing xml data.

Calls

proc~~parse_from_string~~CallsGraph proc~parse_from_string xml_file%parse_from_string proc~add_child xml_file%add_child proc~parse_from_string->proc~add_child proc~add_tag xml_file%add_tag proc~parse_from_string->proc~add_tag proc~get_tag_content get_tag_content proc~parse_from_string->proc~get_tag_content proc~parse_tag_name~2 parse_tag_name proc~parse_from_string->proc~parse_tag_name~2 proc~set xml_tag%set proc~parse_from_string->proc~set proc~add_child_id xml_tag%add_child_id proc~add_child->proc~add_child_id proc~find_matching_end_tag find_matching_end_tag proc~get_tag_content->proc~find_matching_end_tag proc~add_multiple_attributes xml_tag%add_multiple_attributes proc~set->proc~add_multiple_attributes proc~add_single_attribute xml_tag%add_single_attribute proc~set->proc~add_single_attribute proc~add_stream_attributes xml_tag%add_stream_attributes proc~set->proc~add_stream_attributes proc~add_multiple_attributes->proc~add_single_attribute proc~alloc_attributes xml_tag%alloc_attributes proc~add_single_attribute->proc~alloc_attributes proc~add_stream_attributes->proc~add_single_attribute fill fill proc~add_stream_attributes->fill partition partition proc~add_stream_attributes->partition slice slice proc~add_stream_attributes->slice

Called by

proc~~parse_from_string~~CalledByGraph proc~parse_from_string xml_file%parse_from_string 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 parse_from_string(self, source_string)
   !< Parse xml data from a chunk of source string (file stringified for IO on device).
   class(xml_file), intent(inout) :: self                                     !< XML file handler.
   character(*),    intent(in)    :: source_string                            !< String containing xml data.
   integer(I4P)                   :: pos, start_pos, end_pos, end_content_pos !< Position indexes.
   character(:), allocatable      :: tag_name                                 !< Tag name buffer.
   character(:), allocatable      :: attributes_str                           !< Tag attributes string buffer.
   character(:), allocatable      :: tag_content                              !< Tag content string buffer.
   integer(I4P)                   :: current_level                            !< Nesting level counter.
   logical                        :: is_closing_tag                           !< Sentinel for closing tag.
   logical                        :: is_self_closing                          !< Sentinel for self closing tag.
   type(xml_tag)                  :: tag                                      !< XML tag handler.
   integer(I4P)                   :: parent_id                                !< Uniq parent tag ID.
   integer(I4P), allocatable      :: parent_stack(:)                          !< Stack of parents ID.

   call self%free
   pos = 1_I4P
   current_level = 0_I4P
   allocate(parent_stack(1))
   parent_stack = 0_I4P
   do while (pos <= len_trim(source_string))
      ! next tag start
      start_pos = index(source_string(pos:), '<')
      if (start_pos == 0) exit
      start_pos = pos + start_pos - 1

      ! skip comment, XML header
      if (start_pos + 3 <= len_trim(source_string)) then
         if (source_string(start_pos:start_pos+3) == '<!--'.or.source_string(start_pos:start_pos+1) == '<?') then
            end_pos = index(source_string(start_pos+1:), '>')
            if (end_pos == 0) exit
            pos = start_pos + end_pos + 1
            cycle
         endif
      endif
      ! close current tag
      end_pos = index(source_string(start_pos:), '>')
      if (end_pos == 0) exit
      end_pos = start_pos + end_pos - 1

      ! parse tag
      call parse_tag_name(tag_str         = source_string(start_pos:end_pos), &
                          tag_name        = tag_name,                         &
                          attributes_str  = attributes_str,                   &
                          is_closing      = is_closing_tag,                   &
                          is_self_closing = is_self_closing)
      if (allocated(tag_name)) then
         if (is_closing_tag) then
            current_level = current_level - 1
         else
            ! add new tag to XML tags list
            call tag%free
            call self%add_tag(tag=tag)
            current_level = current_level + 1
            ! get parent/child id
            if (current_level>1) then
               if (parent_stack(current_level-1)>0)  then
                  parent_id = parent_stack(current_level-1)
                  call self%add_child(parent_id=parent_stack(current_level - 1), child_id=self%nt)
               endif
            elseif (current_level==1) then
               parent_id = 0_I4P
            endif
            ! parent_stack(current_level) = self%nt
            if (current_level==1) then
               parent_stack(1) = self%nt
            else
               if (current_level>1) parent_stack = [parent_stack(1:current_level-1),self%nt]
            endif
            end_content_pos = -1 ! initialize position for self closing tag
            if (.not.is_self_closing) then
               ! get tag content
               call get_tag_content(source=source_string, tag_name=tag_name, start_pos=end_pos + 1, content=tag_content, &
                                    end_pos=end_content_pos)
            endif
            call self%tag(self%nt)%set(name                      = tag_name,                              &
                                       sanitize_attributes_value = .true.,                                &
                                       pos                       = [start_pos, end_pos, end_content_pos], &
                                       indent                    = (current_level-1)*2,                   &
                                       is_self_closing           = is_self_closing,                       &
                                       id                        = self%nt,                               &
                                       level                     = current_level,                         &
                                       parent_id                 = parent_id,                             &
                                       attributes_stream_alloc   = attributes_str,                        &
                                       content_alloc             = tag_content)
            if (is_self_closing) current_level = current_level - 1
         endif
      endif
      pos = end_pos + 1
   enddo
   endsubroutine parse_from_string