load_file_as_stream Function

private function load_file_as_stream(filename, delimiter_start, delimiter_end, fast_read, iostat, iomsg) result(stream)

Load file contents and store as single characters stream.

Arguments

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

File name.

character(len=*), intent(in), optional :: delimiter_start

Delimiter from which start the stream.

character(len=*), intent(in), optional :: delimiter_end

Delimiter to which end the stream.

logical, intent(in), optional :: fast_read

Flag for activating efficient reading with one single read.

integer(kind=I4P), intent(out), optional :: iostat

IO error.

character(len=*), intent(out), optional :: iomsg

IO error message.

Return Value character(len=:), allocatable

Output string containing the file data as a single stream.


Called by

proc~~load_file_as_stream~~CalledByGraph proc~load_file_as_stream load_file_as_stream proc~parse~2 xml_file%parse proc~parse~2->proc~load_file_as_stream 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

   function load_file_as_stream(filename, delimiter_start, delimiter_end, fast_read, iostat, iomsg) result(stream)
   !< Load file contents and store as single characters stream.
   character(*),           intent(in)  :: filename        !< File name.
   character(*), optional, intent(in)  :: delimiter_start !< Delimiter from which start the stream.
   character(*), optional, intent(in)  :: delimiter_end   !< Delimiter to which end the stream.
   logical,      optional, intent(in)  :: fast_read       !< Flag for activating efficient reading with one single read.
   integer(I4P), optional, intent(out) :: iostat          !< IO error.
   character(*), optional, intent(out) :: iomsg           !< IO error message.
   character(len=:), allocatable       :: stream          !< Output string containing the file data as a single stream.
   logical                             :: is_file         !< Flag for inquiring the presence of the file.
   integer(I4P)                        :: unit            !< Unit file.
   integer(I4P)                        :: iostatd         !< IO error.
   character(500)                      :: iomsgd          !< IO error message.
   character(1)                        :: c1              !< Single character.
   character(len=:), allocatable       :: string          !< Dummy string.
   logical                             :: cstart          !< Flag for stream capturing trigging.
   logical                             :: cend            !< Flag for stream capturing trigging.
   logical                             :: fast            !< Flag for activating efficient reading with one single read.
   integer(I4P)                        :: filesize        !< Size of the file for fast reading.

   fast = .false. ; if (present(fast_read)) fast = fast_read
   ! inquire file existance
   inquire(file=adjustl(trim(filename)), exist=is_file, iostat=iostatd, iomsg=iomsgd)
   if (.not.is_file) then
      if (present(iostat)) iostat = iostatd
      if (present(iomsg )) iomsg  = iomsgd
      return
   endif
   ! open file
   open(newunit=unit, file=adjustl(trim(filename)), access='STREAM', form='UNFORMATTED', iostat=iostatd, iomsg=iomsgd)
   if (iostatd/=0) then
      if (present(iostat)) iostat = iostatd
      if (present(iomsg )) iomsg  = iomsgd
      return
   endif
   ! loadg data
   stream = ''
   if (present(delimiter_start).and.present(delimiter_end)) then
      ! load only data inside delimiter_start and delimiter_end
      string = ''
      Main_Read_Loop: do
         read(unit=unit, iostat=iostatd, iomsg=iomsgd, end=10)c1
         if (c1==delimiter_start(1:1)) then
            cstart = .true.
            string = c1
            Start_Read_Loop: do while(len(string)<len(delimiter_start))
               read(unit=unit, iostat=iostatd, iomsg=iomsgd, end=10)c1
               string = string//c1
               if (.not.(index(string=delimiter_start, substring=string)>0)) then
                  cstart = .false.
                  exit Start_Read_Loop
               endif
            enddo Start_Read_Loop
            if (cstart) then
               cend = .false.
               stream = string
               do while(.not.cend)
                  read(unit=unit, iostat=iostatd, iomsg=iomsgd, end=10)c1
                  if (c1==delimiter_end(1:1)) then ! maybe the end
                     string = c1
                     End_Read_Loop: do while(len(string)<len(delimiter_end))
                        read(unit=unit, iostat=iostatd, iomsg=iomsgd, end=10)c1
                        string = string//c1
                        if (.not.(index(string=delimiter_end, substring=string)>0)) then
                           stream = stream//string
                           exit End_Read_Loop
                        elseif (len(string)==len(delimiter_end)) then
                           cend = .true.
                           stream = stream//string
                           exit Main_Read_Loop
                        endif
                     enddo End_Read_Loop
                  else
                     stream = stream//c1
                  endif
               enddo
            endif
         endif
      enddo Main_Read_Loop
   else
      ! load all data
      if (fast) then
         ! load fast
         inquire(file=adjustl(trim(filename)), size=filesize, iostat=iostatd, iomsg=iomsgd)
         if (iostatd==0) then
            if (allocated(stream)) deallocate(stream)
            allocate(character(len=filesize):: stream)
            read(unit=unit, iostat=iostatd, iomsg=iomsgd, end=10)stream
         endif
      else
         ! load slow, one character loop
         Read_Loop: do
            read(unit=unit,iostat=iostatd,iomsg=iomsgd,end=10)c1
            stream = stream//c1
         enddo Read_Loop
      endif
   endif
   10 close(unit)
   if (present(iostat)) iostat = iostatd
   if (present(iomsg))  iomsg  = iomsgd
   endfunction load_file_as_stream