! xmlparse.f90 - Simple, limited XML parser in Fortran ! ! $Id: xmlparse.f90,v 1.14 2007/12/07 10:10:19 arjenmarkus Exp $ ! ! Arjen Markus ! ! General information: ! The module reads XML files by: ! - Identifying the tag and all attributes and data belonging ! to the tag. ! - Returning to the calling subprogram to let it take care of ! the tag, attributes and data. ! - If the tag is actually an ending tag, then this is flagged ! too. ! - Handling all the data is left to the calling subprogram, ! the module merely facilitates in the parsing. ! ! Note: ! The module in its current version has a number of limitations: ! - It does not handle escape sequences (like >. to signify ! a ">" sign) ! - It does not handle tags with attributes that are spread ! over more than one line ! - The maximum length of a line is 1000 characters ! - It may report too many lines of data (empty lines) ! - No DOM support nor support for an object tree ! - It is probably not very robust in detecting malformed XML files ! ! Some questions: ! - What to do with leading blanks? ! ! Update - several ideas: ! - Introduce at least two options (via xml_options): ! - ignore_whitespace - remove leading blanks and leading and trailing ! empty lines from the PCDATA ! - no_data_truncation - consider truncation of data (more ! attributes or lines of character data than ! can be stored) a read error ! - Introduce convenience functions and subroutines: ! - xml_ok() - all is well, reading can continue ! - xml_data_trunc() - was there truncation of the data? ! - xml_find_attrib() - find an attribute by name ! ! Further ideas: ! - simple checking via a table: parent, tag, id, min, max ! module xmlf_parse implicit none integer, parameter :: XML_BUFFER_LENGTH = 1000 ! ! Define the data type that holds the parser information ! type XML_PARSE integer :: lun ! LU-number of the XML-file integer :: level ! Indentation level (output) integer :: lineno ! Line in file logical :: ignore_whitespace ! Ignore leading blanks etc. logical :: no_data_truncation ! Do not allow data truncation logical :: too_many_attribs ! More attributes than could be stored? logical :: too_many_data ! More lines of data than could be stored? logical :: eof ! End of file? logical :: error ! Invalid XML file or other error? character(len=XML_BUFFER_LENGTH) :: line ! Buffer end type XML_PARSE ! ! Global options ! integer, parameter :: XML_STDOUT = -1 integer, private :: report_lun_ = XML_STDOUT logical, private :: report_errors_ = .false. logical, private :: report_details_ = .false. ! ! Global data (the ampersand must come first) ! character(len=10), dimension(2,3), save, private :: entities = & reshape( (/ '& ', '&', & '> ', '> ', & '< ', '< ' /), (/2,3/) ) ! ! Auxiliary routines - private private :: xml_compress_ private :: xml_put_open_tag_ private :: xml_put_element_ private :: xml_put_close_tag_ private :: xml_replace_entities_ ! ! Interfaces to reporting routines ! private :: xml_report_details_int_ private :: xml_report_details_string_ private :: xml_report_errors_int_ private :: xml_report_errors_string_ interface xml_report_details module procedure xml_report_details_int_ module procedure xml_report_details_string_ end interface interface xml_report_errors module procedure xml_report_errors_int_ module procedure xml_report_errors_string_ module procedure xml_report_errors_extern_ end interface contains ! xml_report_details_int_ -- ! Routine to write a text with an integer value ! Arguments: ! text Text to be written ! int Integer value to be added ! subroutine xml_report_details_int_( text, int ) character(len=*), intent(in) :: text integer, intent(in) :: int if ( report_details_ ) then if ( report_lun_ .eq. XML_STDOUT ) then write (*,*) 'XMLF - ERROR - ', trim(text), int else write (report_lun_,*) 'XMLF - ERROR - ', trim(text), int endif endif end subroutine xml_report_details_int_ ! xml_report_details_string_ -- ! Routine to write a text with a string value ! Arguments: ! text Text to be written ! string String to be added ! subroutine xml_report_details_string_( text, string ) character(len=*), intent(in) :: text character(len=*), intent(in) :: string if ( report_details_ ) then if ( report_lun_ .eq. XML_STDOUT ) then write (*,*) 'XMLF - ERROR - ', trim(text), ' ', trim(string) else write (report_lun_,*) 'XMLF - ERROR - ', trim(text), ' ', trim(string) endif endif end subroutine xml_report_details_string_ ! xml_report_errors_string_ -- ! Routine to write an error message text with an integer value ! Arguments: ! text Text to be written ! int Integer value to be added ! lineno Line number in the file ! subroutine xml_report_errors_int_( text, int, lineno ) character(len=*), intent(in) :: text integer, intent(in) :: int integer, optional, intent(in) :: lineno if ( report_errors_ .or. report_details_ ) then if ( report_lun_ .eq. XML_STDOUT ) then write (*,*) 'XMLF - ERROR - ', trim(text), int if ( present(lineno) ) then write(*,*) ' At or near line', lineno endif else write (report_lun_,*) 'XMLF - ERROR - ', trim(text), int if ( present(lineno) ) then write(report_lun_,*) ' At or near line', lineno endif endif endif end subroutine xml_report_errors_int_ ! xml_report_errors_string_ -- ! Routine to write an error message text with a string value ! Arguments: ! text Text to be written ! string String to be added ! lineno Line number in the file ! subroutine xml_report_errors_string_( text, string, lineno ) character(len=*), intent(in) :: text character(len=*), intent(in) :: string integer, optional, intent(in) :: lineno if ( report_errors_ .or. report_details_ ) then if ( report_lun_ .eq. XML_STDOUT ) then write (*,*) 'XMLF - ERROR - ', trim(text), ' ', trim(string) if ( present(lineno) ) then write(*,*) ' At or near line', lineno endif else write (report_lun_,*) 'XMLF - ERROR - ', trim(text), ' ', trim(string) if ( present(lineno) ) then write(report_lun_,*) ' At or near line', lineno endif endif endif end subroutine xml_report_errors_string_ ! xml_report_errors_extern_ -- ! Routine to write an error message text with a string value ! Arguments: ! info Structure holding information on the XML-file ! text Text to be written ! Note: ! This routine is meant for use by routines outside ! this module ! subroutine xml_report_errors_extern_( info, text ) type(XML_PARSE), intent(in) :: info character(len=*), intent(in) :: text if ( report_lun_ .eq. XML_STDOUT ) then write (*,*) 'XMLF - ERROR - ', trim(text), ' - at or near line', info%lineno else write (report_lun_,*) 'XMLF - ERROR - ', trim(text), ' - at or near line', info%lineno endif end subroutine xml_report_errors_extern_ ! xml_open -- ! Routine to open an XML file for reading or writing ! Arguments: ! info Structure holding information on the XML-file ! fname Name of the file ! mustread The file will be read (.true.) or written (.false.) ! subroutine xml_open( info, fname, mustread ) character(len=*), intent(in) :: fname logical, intent(in) :: mustread type(XML_PARSE), intent(out) :: info integer :: i integer :: k integer :: kend integer :: ierr logical :: opend logical :: exists info%lun = 10 info%ignore_whitespace = .false. info%no_data_truncation = .false. info%too_many_attribs = .false. info%too_many_data = .false. info%eof = .false. info%error = .false. info%level = -1 info%lineno = 0 do i = 10,99 inquire( unit = i, opened = opend ) if ( .not. opend ) then info%lun = i inquire( file = fname, exist = exists ) if ( .not. exists .and. mustread ) then call xml_report_errors( 'XML_OPEN: file does not exist:', trim(fname)) info%lun = -1 info%error = .true. else open( unit = info%lun, file = fname ) call xml_report_details( 'XML_OPEN: opened file ', trim(fname) ) call xml_report_details( 'at LU-number: ', info%lun ) endif exit endif enddo if ( .not. info%error .and. mustread ) then k = 1 do while ( k .ge. 1 ) read( info%lun, '(a)', iostat = ierr ) info%line if ( ierr .eq. 0 ) then info%line = adjustl( info%line ) k = index( info%line, ' appears on a single line! ! if ( k .ge. 1 ) then kend = index( info%line, '?>' ) if ( kend .le. 0 ) then call xml_report_errors( 'XML_OPEN: error reading file with LU-number: ', info%lun ) call xml_report_errors( 'Line starting with ""', ' ' ) info%error = .true. exit endif endif else call xml_report_errors( 'XML_OPEN: error reading file with LU-number: ', info%lun ) call xml_report_errors( 'Possibly no line starting with "' endif end subroutine xml_open ! xml_close -- ! Routine to close an XML file ! Arguments: ! info Structure holding information on the XML-file ! subroutine xml_close( info ) type(XML_PARSE), intent(inout) :: info close( info%lun ) ! ! Only clean up the LU-number, so that the calling program ! can examine the last condition ! call xml_report_details( 'XML_CLOSE: Closing file with LU-number ', info%lun ) info%lun = -1 end subroutine xml_close ! xml_get -- ! Routine to get the next bit of information from an XML file ! Arguments: ! info Structure holding information on the XML-file ! tag Tag that was encountered ! endtag Whether the end of the element was encountered ! attribs List of attribute-value pairs ! no_attribs Number of pairs in the list ! data Lines of character data found ! no_data Number of lines of character data ! subroutine xml_get( info, tag, endtag, attribs, no_attribs, & data, no_data ) type(XML_PARSE), intent(inout) :: info character(len=*), intent(out) :: tag logical, intent(out) :: endtag character(len=*), intent(out), dimension(:,:) :: attribs integer, intent(out) :: no_attribs character(len=*), intent(out), dimension(:) :: data integer, intent(out) :: no_data integer :: kspace integer :: kend integer :: keq integer :: kfirst integer :: ksecond integer :: idxat integer :: idxdat integer :: ierr logical :: close_bracket logical :: comment_tag character(len=XML_BUFFER_LENGTH) :: nextline ! ! Initialise the output ! endtag = .false. no_attribs = 0 no_data = 0 info%too_many_attribs = .false. info%too_many_data = .false. if ( info%lun .lt. 0 ) then call xml_report_details( 'XML_GET on closed file ', ' ' ) return endif ! ! From the previous call or the call to xmlopen we have ! the line that we need to parse already in memory: ! ! comment_tag = .false. close_bracket = .false. kspace = index( info%line, ' ' ) kend = index( info%line, '>' ) do while ( kend .le. 0 ) read( info%lun, '(a)', iostat = ierr ) nextline info%lineno = info%lineno + 1 if ( ierr .eq. 0 ) then info%line = trim(info%line) // ' ' // adjustl(nextline) else info%error = .true. call xml_report_errors( 'XML_GET - end of tag not found ', & '(buffer too small?)', info%lineno ) call xml_close( info ) return endif kend = index( info%line, '>' ) enddo if ( kend .gt. kspace ) then kend = kspace else close_bracket = .true. endif ! ! Check for the end of an ordianry tag and of ! a comment tag ! if ( info%line(1:3) .eq. '-->' ) then endtag = .true. tag = info%line(4:kend-1) else if ( info%line(1:2) .eq. '' ) if ( keq .gt. kend ) keq = 0 ! Guard against multiple tags ! with attributes on one line ! ! No attributes any more? ! if ( keq .lt. 1 ) then kend = index( info%line, '/>' ) if ( kend .ge. 1 ) then kend = kend + 1 ! To go beyond the ">" character endtag = .true. else kend = index( info%line, '>' ) if ( kend .lt. 1 ) then call xml_report_errors( 'XML_GET - wrong ending of tag ', & trim(info%line), info%lineno ) info%error = .true. ! Wrong ending of line! call xml_close( info ) return else close_bracket = .true. endif endif if ( kend .ge. 1 ) then info%line = adjustl( info%line(kend+1:) ) endif exit endif idxat = idxat + 1 if ( idxat .le. size(attribs,2) ) then no_attribs = idxat attribs(1,idxat) = adjustl(info%line(1:keq-1)) ! Use adjustl() to avoid ! multiple spaces, etc info%line = adjustl( info%line(keq+1:) ) ! ! We have almost found the start of the attribute's value ! kfirst = index( info%line, '"' ) if ( kfirst .lt. 1 ) then call xml_report_errors( 'XML_GET - malformed attribute-value pair: ', & trim(info%line), info%lineno ) info%error = .true. ! Wrong form of attribute-value pair call xml_close( info ) return endif ksecond = index( info%line(kfirst+1:), '"' ) + kfirst if ( ksecond .lt. 1 ) then call xml_report_errors( 'XML_GET - malformed attribute-value pair: ', & trim(info%line), info%lineno ) info%error = .true. ! Wrong form of attribute-value pair call xml_close( info ) return endif attribs(2,idxat) = info%line(kfirst+1:ksecond-1) info%line = adjustl( info%line(ksecond+1:) ) endif if ( idxat .gt. size(attribs,2) ) then call xml_report_errors( 'XML_GET - more attributes than could be stored: ', & trim(info%line), info%lineno ) info%too_many_attribs = .true. info%line = ' ' exit endif enddo ! ! Now read the data associated with the current tag ! - all the way to the next "<" character ! ! To do: reduce the number of data lines - empty ones ! at the end should not count. ! do if ( comment_tag ) then kend = index( info%line, '-->' ) else kend = index( info%line, '<' ) endif idxdat = idxdat + 1 if ( idxdat .le. size(data) ) then no_data = idxdat if ( kend .ge. 1 ) then data(idxdat) = info%line(1:kend-1) info%line = info%line(kend:) else data(idxdat) = info%line endif else call xml_report_errors( 'XML_GET - more data lines than could be stored: ', & trim(info%line), info%lineno ) info%too_many_data = .true. exit endif ! ! No more data? Otherwise, read on ! if ( kend .ge. 1 ) then exit else read( info%lun, '(a)', iostat = ierr ) info%line info%lineno = info%lineno + 1 if ( ierr .lt. 0 ) then call xml_report_details( 'XML_GET - end of file found - LU-number: ', & info%lun ) info%eof = .true. elseif ( ierr .gt. 0 ) then call xml_report_errors( 'XML_GET - error reading file with LU-number ', & info%lun, info%lineno ) info%error = .true. endif if ( ierr .ne. 0 ) then exit endif endif enddo ! ! Compress the data? ! if ( info%ignore_whitespace ) then call xml_compress_( data, no_data ) endif ! ! Replace the entities, if any ! call xml_replace_entities_( data, no_data ) call xml_report_details( 'XML_GET - number of attributes: ', no_attribs ) call xml_report_details( 'XML_GET - number of data lines: ', no_data ) end subroutine xml_get ! xml_put -- ! Routine to write a tag with the associated data to an XML file ! Arguments: ! info Structure holding information on the XML-file ! tag Tag that was encountered ! endtag Whether the end of the element was encountered ! attribs List of attribute-value pairs ! no_attribs Number of pairs in the list ! data Lines of character data found ! no_data Number of lines of character data ! type Type of action: ! open - just the opening tag with attributes ! elem - complete element ! close - just the closing tag ! subroutine xml_put(info, tag, attribs, no_attribs, & data, no_data, type) type(XML_PARSE), intent(inout) :: info character(len=*), intent(in) :: tag character(len=*), intent(in), dimension(:,:) :: attribs integer, intent(in) :: no_attribs character(len=*), intent(in), dimension(:) :: data integer, intent(in) :: no_data character(len=*) :: type integer :: i character(len=300), parameter :: indent = ' ' select case(type) case('open') call xml_put_open_tag_(info, tag, attribs, no_attribs, & data, no_data) case('elem') call xml_put_element_(info, tag, attribs, no_attribs, & data, no_data) case('close') call xml_put_close_tag_(info, tag, attribs, no_attribs, & data, no_data) end select end subroutine xml_put ! xml_put_open_tag_ -- ! Routine to write the opening tag with the attributes ! Arguments: ! info Structure holding information on the XML-file ! tag Tag that was encountered ! endtag Whether the end of the element was encountered ! attribs List of attribute-value pairs ! no_attribs Number of pairs in the list ! data Lines of character data found ! no_data Number of lines of character data ! subroutine xml_put_open_tag_(info, tag, attribs, no_attribs, & data, no_data) type(XML_PARSE), intent(inout) :: info character(len=*), intent(in) :: tag character(len=*), intent(in), dimension(:,:) :: attribs integer, intent(in) :: no_attribs character(len=*), intent(in), dimension(:) :: data integer, intent(in) :: no_data character(len=1) :: aa integer :: i character(len=300), parameter :: indent = ' ' write( info%lun, '(3a)', advance = 'no' ) & indent(1:3*info%level), '<', adjustl(tag) do i=1,no_attribs if (attribs(2,i).ne.'') then write( info%lun, '(5a)', advance = 'no' ) & ' ',trim(attribs(1,i)),'="', trim(attribs(2,i)),'"' endif enddo write( info%lun, '(a)' ) '>' info%level = info%level + 1 end subroutine xml_put_open_tag_ ! xml_put_element_ -- ! Routine to write the complete element ! Arguments: ! info Structure holding information on the XML-file ! tag Tag that was encountered ! endtag Whether the end of the element was encountered ! attribs List of attribute-value pairs ! no_attribs Number of pairs in the list ! data Lines of character data found ! no_data Number of lines of character data ! subroutine xml_put_element_(info, tag, attribs, no_attribs, & data, no_data) type(XML_PARSE), intent(inout) :: info character(len=*), intent(in) :: tag character(len=*), intent(in), dimension(:,:) :: attribs integer, intent(in) :: no_attribs character(len=*), intent(in), dimension(:) :: data integer, intent(in) :: no_data logical :: logic character(len=1) :: aa integer :: i, ii character(len=300), parameter :: indent = ' ' if ( (no_attribs.eq.0 .and. no_data.eq.0) ) then return else logic = .true. do ii = 1,no_attribs logic = logic .and. (attribs(2,ii).eq.'') enddo do ii = 1,no_data logic = logic .and. (data(ii).eq.'') enddo if ( logic ) then return else write( info%lun, '(3a)', advance = 'no' ) & indent(1:3*info%level), '<', adjustl(tag) do i = 1,no_attribs if (attribs(2,i).ne.'') then write( info%lun, '(5a)', advance = 'no' ) & ' ',trim(attribs(1,i)),'="', trim(attribs(2,i)),'"' endif enddo if ( no_attribs.gt.0 .and. no_data.eq.0 ) then aa='a' elseif ( (no_attribs.gt.0 .and. no_data.gt.0) .or. & (no_attribs.eq.0 .and. no_data.gt.0) ) then aa='b' else write(*,*) no_attribs, no_data endif endif endif select case(aa) case('a') write( info%lun, '(a)' ) '/>' case('b') write( info%lun, '(a)',advance='no' ) '>' write( info%lun, '(2a)', advance='no') & ( ' ', trim(data(i)), i=1,no_data ) write( info%lun, '(4a)' ) ' ','' end select end subroutine xml_put_element_ ! xml_put_close_tag_ -- ! Routine to write the closing tag ! Arguments: ! info Structure holding information on the XML-file ! tag Tag that was encountered ! endtag Whether the end of the element was encountered ! attribs List of attribute-value pairs ! no_attribs Number of pairs in the list ! data Lines of character data found ! no_data Number of lines of character data ! subroutine xml_put_close_tag_(info, tag, attribs, no_attribs, & data, no_data) type(XML_PARSE), intent(inout) :: info character(len=*), intent(in) :: tag character(len=*), intent(in), dimension(:,:) :: attribs integer, intent(in) :: no_attribs character(len=*), intent(in), dimension(:) :: data integer, intent(in) :: no_data integer :: i character(len=300), parameter :: indent = ' ' info%level=info%level-1 write( info%lun, '(4a)' ) & indent(1:3*info%level), '' end subroutine xml_put_close_tag_ ! xml_compress_ -- ! Routine to remove empty lines from the character data ! Arguments: ! data Lines of character data found ! no_data (Nett) number of lines of character data ! subroutine xml_compress_( data, no_data ) character(len=*), intent(inout), dimension(:) :: data integer, intent(inout) :: no_data integer :: i integer :: j logical :: empty j = 0 empty = .true. do i = 1,no_data if ( len_trim(data(i)) .ne. 0 .or. .not. empty ) then j = j + 1 data(j) = adjustl(data(i)) empty = .false. endif enddo no_data = j do i = no_data,1,-1 if ( len_trim(data(i)) .ne. 0 ) then exit else no_data = no_data - 1 endif enddo end subroutine xml_compress_ ! xml_replace_entities_ -- ! Routine to replace entities such as > by their ! proper character representation ! Arguments: ! data Lines of character data found ! no_data (Nett) number of lines of character data ! subroutine xml_replace_entities_( data, no_data ) character(len=*), intent(inout), dimension(:) :: data integer, intent(inout) :: no_data integer :: i integer :: j integer :: j2 integer :: k integer :: pos logical :: found do i = 1,no_data j = 1 do do k = 1,size(entities,2) found = .false. pos = index( data(i)(j:), trim(entities(2,k)) ) if ( pos .gt. 0 ) then found = .true. j = j + pos - 1 j2 = j + len_trim(entities(2,k)) data(i)(j:) = trim(entities(1,k)) // data(i)(j2:) j = j2 endif enddo if ( .not. found ) exit enddo enddo end subroutine xml_replace_entities_ ! xml_options -- ! Routine to handle the parser options ! Arguments: ! info Structure holding information on the XML-file ! ignore_whitespace Ignore whitespace (leading blanks, empty lines) or not ! no_data_truncation Consider truncation of strings an error or not ! report_lun LU-number for reporting information ! report_errors Write messages about errors or not ! report_details Write messages about all kinds of actions or not ! subroutine xml_options( info, ignore_whitespace, no_data_truncation, & report_lun, report_errors, & report_details ) type(XML_PARSE), intent(inout) :: info logical, intent(in), optional :: ignore_whitespace logical, intent(in), optional :: no_data_truncation integer, intent(in), optional :: report_lun logical, intent(in), optional :: report_errors logical, intent(in), optional :: report_details if ( present(ignore_whitespace) ) then info%ignore_whitespace = ignore_whitespace endif if ( present(no_data_truncation) ) then info%no_data_truncation = no_data_truncation endif if ( present(report_lun) ) then report_lun_ = report_lun endif if ( present(report_errors) ) then report_errors_ = report_errors endif if ( present(report_details) ) then report_details_ = report_details endif end subroutine xml_options ! xml_ok -- ! Function that returns whether all was okay or not ! Arguments: ! info Structure holding information on the XML-file ! Returns: ! .true. if there was no error, .false. otherwise ! logical function xml_ok( info ) type(XML_PARSE), intent(in) :: info xml_ok = info%eof .or. info%error .or. & ( info%no_data_truncation .and. & ( info%too_many_attribs .or. info%too_many_data ) ) xml_ok = .not. xml_ok end function xml_ok ! xml_error -- ! Function that returns whether there was an error ! Arguments: ! info Structure holding information on the XML-file ! Returns: ! .true. if there was an error, .false. if there was none ! logical function xml_error( info ) type(XML_PARSE), intent(in) :: info xml_error = info%error .or. & ( info%no_data_truncation .and. & ( info%too_many_attribs .or. info%too_many_data ) ) end function xml_error ! xml_data_trunc -- ! Function that returns whether data were truncated or not ! Arguments: ! info Structure holding information on the XML-file ! Returns: ! .true. if data were truncated, .false. otherwise ! logical function xml_data_trunc( info ) type(XML_PARSE), intent(in) :: info xml_data_trunc = info%too_many_attribs .or. info%too_many_data end function xml_data_trunc integer function xml_find_attrib( attribs, no_attribs, name, value ) character(len=*), dimension(:,:) :: attribs integer :: no_attribs character(len=*) :: name character(len=*) :: value integer :: i xml_find_attrib = -1 do i = 1,no_attribs if ( name .eq. attribs(1,i) ) then value = attribs(2,i) xml_find_attrib = i exit endif enddo end function xml_find_attrib ! xml_process -- ! Routine to read the XML file as a whole and distribute processing ! the contents over three user-defined subroutines ! Arguments: ! filename Name of the file to process ! attribs Array for holding the attributes ! data Array for holding the character data ! startfunc Subroutine to handle the start of elements ! datafunc Subroutine to handle the character data ! endfunc Subroutine to handle the end of elements ! error Indicates if there was an error or not ! Note: ! The routine is declared recursive to allow inclusion of XML files ! (common with XSD schemas). This extends to the auxiliary routines. ! recursive & subroutine xml_process( filename, attribs, data, startfunc, datafunc, endfunc, lunrep, error ) character(len=*) :: filename character(len=*), dimension(:,:) :: attribs character(len=*), dimension(:) :: data integer :: lunrep logical :: error interface recursive subroutine startfunc( tag, attribs, error ) character(len=*) :: tag character(len=*), dimension(:,:) :: attribs logical :: error end subroutine end interface interface recursive subroutine datafunc( tag, data, error ) character(len=*) :: tag character(len=*), dimension(:) :: data logical :: error end subroutine end interface interface recursive subroutine endfunc( tag, error ) character(len=*) :: tag logical :: error end subroutine end interface type(XML_PARSE) :: info character(len=80) :: tag logical :: endtag integer :: noattribs integer :: nodata call xml_options( info, report_lun = lunrep, report_details = .false. ) call xml_open( info, filename, .true. ) error = .false. do call xml_get( info, tag, endtag, attribs, noattribs, data, nodata ) if ( .not. xml_ok(info) ) then exit endif if ( xml_error(info) ) then write(lunrep,*) 'Error reading XML file!' error = .true. exit endif if ( .not. endtag .or. noattribs .ne. 0 ) then call startfunc( tag, attribs(:,1:noattribs), error ) if ( error ) exit call datafunc( tag, data(1:nodata), error ) if ( error ) exit endif if ( endtag ) then call endfunc( tag, error ) if ( error ) exit endif enddo call xml_close( info ) end subroutine xml_process end module xmlf_parse