attributes Function

private pure function attributes(self) result(att_)

Return attributes name/value pairs as string.

Type Bound

xml_tag

Arguments

Type IntentOptional Attributes Name
class(xml_tag), intent(in) :: self

XML tag.

Return Value character(len=:), allocatable

The attributes string.


Source Code

   pure function create_tag_flat(name, attribute, attributes, attributes_stream, sanitize_attributes_value, pos, content,     &
                                 indent, is_content_indented, is_self_closing, id, level, parent_id, attributes_stream_alloc, &
                                 content_alloc) result(tag)
   !< Return an instance of xml tag.
   character(*),              intent(in)           :: name                      !< Tag name.
   character(*),              intent(in), optional :: attribute(1:)             !< Attribute name/value pair [1:2].
   character(*),              intent(in), optional :: attributes(1:,1:)         !< Attributes list of name/value pairs [1:2,1:].
   character(*),              intent(in), optional :: attributes_stream         !< Attributes list as single stream.
   logical,                   intent(in), optional :: sanitize_attributes_value !< Sanitize attributes value.
   integer(I4P),              intent(in), optional :: pos(1:)                   !< Characters position (in source) indexes.
   character(*),              intent(in), optional :: content                   !< Tag value.
   integer(I4P),              intent(in), optional :: indent                    !< Number of indent-white-spaces.
   logical,                   intent(in), optional :: is_content_indented       !< Activate content indentation.
   logical,                   intent(in), optional :: is_self_closing           !< The tag is self closing.
   integer(I4P),              intent(in), optional :: id                        !< Uniq ID.
   integer(I4P),              intent(in), optional :: level                     !< Tag hierarchy level.
   integer(I4P),              intent(in), optional :: parent_id                 !< Parent uniq ID.
   character(:), allocatable, intent(in), optional :: attributes_stream_alloc   !< Attributes list stream, allocatable input.
   character(:), allocatable, intent(in), optional :: content_alloc             !< Tag value, allocatable input.
   type(xml_tag)                                   :: tag                       !< XML tag.

   call tag%set(name=name,                                           &
                attribute=attribute,                                 &
                attributes=attributes,                               &
                attributes_stream=attributes_stream,                 &
                sanitize_attributes_value=sanitize_attributes_value, &
                content=content,                                     &
                pos=pos,                                             &
                indent=indent,                                       &
                is_content_indented=is_content_indented,             &
                is_self_closing=is_self_closing,                     &
                id=id,                                               &
                level=level,                                         &
                parent_id=parent_id,                                 &
                attributes_stream_alloc=attributes_stream_alloc,     &
                content_alloc=content_alloc)
   endfunction create_tag_flat

   pure function create_tag_nested(name, content, attribute, attributes, attributes_stream, sanitize_attributes_value, pos, indent,&
                                   is_content_indented, id, level, parent_id, attributes_stream_alloc, content_alloc) result(tag)
   !< Return an instance of xml tag with value being a nested tag.
   character(*),              intent(in)           :: name                      !< Tag name.
   type(xml_tag),             intent(in)           :: content                   !< Tag value as nested tag..
   character(*),              intent(in), optional :: attribute(1:)             !< Attribute name/value pair [1:2].
   character(*),              intent(in), optional :: attributes(1:,1:)         !< Attributes list of name/value pairs [1:2,1:].
   character(*),              intent(in), optional :: attributes_stream         !< Attributes list as single stream.
   logical,                   intent(in), optional :: sanitize_attributes_value !< Sanitize attributes value.
   integer(I4P),              intent(in), optional :: pos(1:)                   !< Characters position (in source) indexes.
   integer(I4P),              intent(in), optional :: indent                    !< Number of indent-white-spaces.
   logical,                   intent(in), optional :: is_content_indented       !< Activate value indentation.
   integer(I4P),              intent(in), optional :: id                        !< Uniq ID.
   integer(I4P),              intent(in), optional :: level                     !< Tag hierarchy level.
   integer(I4P),              intent(in), optional :: parent_id                 !< Parent uniq ID.
   character(:), allocatable, intent(in), optional :: attributes_stream_alloc   !< Attributes list stream, allocatable input.
   character(:), allocatable, intent(in), optional :: content_alloc             !< Tag value, allocatable input.
   type(xml_tag)                                   :: tag                       !< XML tag.

   call tag%set(name=name,                                           &
                attribute=attribute,                                 &
                attributes=attributes,                               &
                content=content%stringify(),                         &
                sanitize_attributes_value=sanitize_attributes_value, &
                attributes_stream=attributes_stream,                 &
                pos=pos,                                             &
                indent=indent,                                       &
                is_content_indented=is_content_indented,             &
                id=id,                                               &
                level=level,                                         &
                parent_id=parent_id,                                 &
                attributes_stream_alloc=attributes_stream_alloc,     &
                content_alloc=content_alloc)
   endfunction create_tag_nested

   ! public methods
   pure subroutine add_child_id(self, child_id)
   !< Add child ID to children IDs list.
   class(xml_tag), intent(inout) :: self     !< XML tag.
   integer(I4P),   intent(in)    :: child_id !< Child ID.

   if (allocated(self%child_id)) then
      self%child_id = [self%child_id, child_id]
   else
      self%child_id = [child_id]
   endif
   self%children_number = size(self%child_id)
   endsubroutine add_child_id

   pure function attributes(self) result(att_)
   !< Return attributes name/value pairs as string.
   class(xml_tag), intent(in)    :: self !< XML tag.
   character(len=:), allocatable :: att_ !< The attributes string.
   integer(I4P)                  :: a    !< Counter.

   if (self%attributes_number>0) then
      att_ = ''
      do a=1, self%attributes_number
         att_ = att_//' '//self%attribute(1, a)//'="'//self%attribute(2, a)//'"'
      enddo
      att_ = trim(adjustl(att_))
   endif
   endfunction attributes