Line data    Source code

       1              : !> Common utilities for hsd-data: format constants and detection.
       2              : module hsd_data_common
       3              :   implicit none(type, external)
       4              :   private
       5              : 
       6              :   !> Format identifier constants
       7              :   integer, parameter, public :: DATA_FMT_AUTO = 0  !< Detect from file extension
       8              :   integer, parameter, public :: DATA_FMT_HSD  = 1  !< HSD format
       9              :   integer, parameter, public :: DATA_FMT_XML  = 2  !< XML format
      10              :   integer, parameter, public :: DATA_FMT_JSON = 3  !< JSON format
      11              :   integer, parameter, public :: DATA_FMT_TOML = 4  !< TOML format
      12              :   integer, parameter, public :: DATA_FMT_HDF5 = 5  !< HDF5 format
      13              :   integer, parameter, public :: DATA_FMT_YAML = 6  !< YAML format
      14              : 
      15              :   public :: data_detect_format, data_format_available
      16              : 
      17              : contains
      18              : 
      19              :   !> Detect format from file extension.
      20              :   !>
      21              :   !> @param filename  Path to the file (only the extension is examined).
      22              :   !> @return DATA_FMT_* constant, or -1 if the extension is unrecognized.
      23           91 :   function data_detect_format(filename) result(fmt)
      24              :     character(len=*), intent(in) :: filename
      25              :     integer :: fmt
      26              : 
      27           91 :     character(len=:), allocatable :: ext
      28           91 :     integer :: dot_pos
      29              : 
      30           91 :     dot_pos = index(filename, ".", back=.true.)
      31           91 :     if (dot_pos == 0 .or. dot_pos == len(filename)) then
      32            2 :       fmt = -1
      33            2 :       return
      34              :     end if
      35              : 
      36           89 :     ext = to_lower(filename(dot_pos + 1:))
      37              : 
      38           36 :     select case (ext)
      39              :     case ("hsd")
      40           36 :       fmt = DATA_FMT_HSD
      41              :     case ("xml")
      42           12 :       fmt = DATA_FMT_XML
      43              :     case ("json")
      44           19 :       fmt = DATA_FMT_JSON
      45              :     case ("toml")
      46            4 :       fmt = DATA_FMT_TOML
      47              :     case ("h5", "hdf5")
      48            4 :       fmt = DATA_FMT_HDF5
      49              :     case ("yaml", "yml")
      50           12 :       fmt = DATA_FMT_YAML
      51              :     case default
      52           89 :       fmt = -1
      53              :     end select
      54              : 
      55           91 :   end function data_detect_format
      56              : 
      57              :   !> Check whether a format backend is available at runtime.
      58              :   !>
      59              :   !> TOML and HDF5 backends may be compiled out; this function lets callers
      60              :   !> verify availability before attempting to load or dump.
      61              :   !>
      62              :   !> @param fmt  Format constant (DATA_FMT_*).
      63              :   !> @return .true. if the backend is linked and ready.
      64            7 :   function data_format_available(fmt) result(available)
      65              :     integer, intent(in) :: fmt
      66              :     logical :: available
      67              : 
      68            8 :     select case (fmt)
      69              :     case (DATA_FMT_HSD)
      70            1 :       available = .true.
      71              :     case (DATA_FMT_XML)
      72            1 :       available = .true.
      73              :     case (DATA_FMT_JSON)
      74            1 :       available = .true.
      75              :     case (DATA_FMT_TOML)
      76              : #ifdef WITH_TOML
      77            1 :       available = .true.
      78              : #else
      79              :       available = .false.
      80              : #endif
      81              :     case (DATA_FMT_HDF5)
      82              : #ifdef WITH_HDF5
      83            2 :       available = .true.
      84              : #else
      85              :       available = .false.
      86              : #endif
      87              :     case (DATA_FMT_YAML)
      88            0 :       available = .true.
      89              :     case default
      90            1 :       available = .false.
      91              :     end select
      92              : 
      93           98 :   end function data_format_available
      94              : 
      95              :   !> Convert a string to lowercase (ASCII only).
      96           89 :   pure function to_lower(str) result(lower)
      97              :     character(len=*), intent(in) :: str
      98              :     character(len=:), allocatable :: lower
      99              : 
     100           89 :     integer :: ii, ic
     101              : 
     102           89 :     allocate(character(len=len(str)) :: lower)
     103          391 :     do ii = 1, len(str)
     104          302 :       ic = iachar(str(ii:ii))
     105          391 :       if (ic >= iachar("A") .and. ic <= iachar("Z")) then
     106           12 :         lower(ii:ii) = achar(ic + 32)
     107              :       else
     108          290 :         lower(ii:ii) = str(ii:ii)
     109              :       end if
     110              :     end do
     111              : 
     112           96 :   end function to_lower
     113              : 
     114              : end module hsd_data_common