Refactoring. Minor updates.

share/dmpack.js

@@ -1,13 +1,12 @@
-/*
- * Additional formatting of ISO 8601 time stamps in the DMPACK web interface.
- */
+/* Additional formatting of ISO 8601 time stamps in the DMPACK web interface. */
 function formatTimeElements()
 {
     var times = document.getElementsByTagName('time');
 
     for (var i = 0; i < times.length; i++)
     {
         var attr = times[i].getAttribute('datetime');
+        if (attr.length != 25) continue;
         var date = attr.substring(0, 10);
         var time = attr.substring(11, 19);
         var zone = attr.substring(19);

src/dm_geocom_api.f90

@@ -455,7 +455,7 @@ pure subroutine dm_geocom_api_request(request, code, arguments, pattern, respons
     end subroutine dm_geocom_api_request
 
     ! **************************************************************************
-    ! GEOCOM REQUEST PREPARATION PROCEDURES.
+    ! PUBLIC GEOCOM REQUEST PREPARATION PROCEDURES.
     ! **************************************************************************
     pure subroutine dm_geocom_api_request_abort_download(request)
         !! Request of `FTR_AbortDownload` procedure. Creates request to abort

src/dm_html.f90

@@ -586,7 +586,8 @@ function dm_html_header(title, subtitle, style, internal_style, brand, nav, mask
         !! style sheet file and internal CSS can be added.
         !!
         !! The first heading will be set to the page title. The heading is
-        !! shown only if no navigation array is passed.
+        !! shown only if no navigation array is passed. The brand title `brand`
+        !! will be placed in a level 3 heading.
         !!
         !! The given title and sub-title are encoded by this function.
         character(len=*),  intent(in)              :: title          !! HTML page title and first heading.

src/dm_mqtt.f90

@@ -1,7 +1,8 @@
 ! Author:  Philipp Engel
 ! Licence: ISC
 module dm_mqtt
-    !! Module for publishing messages via MQTT, using libcurl.
+    !! Module for publishing messages via MQTT, using libcurl. The libcurl
+    !! library must have been built with the MQTT option enabled.
     !!
     !! Limitations of libcurl:
     !!
@@ -29,8 +30,8 @@ module dm_mqtt
     !! # mosquitto_sub -h 127.0.0.1 -t /fortran
     !! ```
     !!
-    !! In Fortran, we can then create the URL of the topic, and publish a
-    !! message to it:
+    !! In Fortran, we then create the URL of the topic `/fortran` on host
+    !! `127.0.0.1`, and publish the message:
     !!
     !! ```fortran
     !! character(len=:), allocatable :: url
@@ -42,8 +43,7 @@ module dm_mqtt
     !! call dm_mqtt_destroy()
     !! ```
     !!
-    !! Any client that has subscribed topic `/fortran` will receive the
-    !! message.
+    !! Any client subscribing topic `/fortran` will receive the message.
     !!
     !! The procedures `dm_mqtt_init()` and `dm_mqtt_destroy()` have to be called
     !! once per process, and only if neither the RPC nor the mail backend is
@@ -69,7 +69,8 @@ integer function dm_mqtt_init() result(rc)
     end function dm_mqtt_init
 
     integer function dm_mqtt_publish(url, message, timeout, error_message, error_curl) result(rc)
-        !! Sends HTTP request by calling libcurl.
+        !! Publishes MQTT message `message` on topic with address `url` by
+        !! calling libcurl.
         character(len=*),              intent(in)            :: url           !! URL to MQTT server/topic.
         character(len=*), target,      intent(in)            :: message       !! Message to publish.
         integer,                       intent(in),  optional :: timeout       !! Connection timeout.
@@ -140,7 +141,7 @@ end function dm_mqtt_publish
     function dm_mqtt_url(host, topic, port) result(url)
         !! Returns allocatable string of URL to MQTT server. Uses the URL API
         !! of libcurl to create the URL. If `port` is `0`, the default port
-        !! will be used. The topic must start with a `/`.
+        !! will be used. The topic must start with a `/` character.
         !!
         !! On error, an empty string is returned.
         character(len=*), intent(in)           :: host  !! IP or FQDN of MQTT server.

src/dm_mqueue.f90

@@ -3,7 +3,6 @@
 module dm_mqueue
     !! Module for inter-process communication (IPC) and message passing through
     !! POSIX message queues. Has to be linked with `-lrt`.
-    use, intrinsic :: iso_c_binding
     use :: unix
     use :: dm_error
     use :: dm_id
@@ -49,7 +48,7 @@ module dm_mqueue
         procedure :: mqueue_write_raw
     end interface
 
-    public :: dm_mqueue_attr
+    public :: dm_mqueue_attributes
     public :: dm_mqueue_close
     public :: dm_mqueue_open
     public :: dm_mqueue_read
@@ -70,7 +69,7 @@ module dm_mqueue
     ! ******************************************************************
     ! PUBLIC PROCEDURES.
     ! ******************************************************************
-    integer function dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs) result(rc)
+    integer function dm_mqueue_attributes(mqueue, flags, max_msg, msg_size, cur_msgs) result(rc)
         !! Returns message queue attributes.
         type(mqueue_type), intent(inout)         :: mqueue   !! Message queue type.
         integer(kind=i8),  intent(out), optional :: flags    !! Flags.
@@ -86,13 +85,13 @@ integer function dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs) resu
         rc = E_MQUEUE
         if (c_mq_getattr(mqueue%mqd, attr) < 0) return
 
-        if (present(flags))    flags    = int(attr%mq_flags,   kind=c_long)
-        if (present(max_msg))  max_msg  = int(attr%mq_maxmsg,  kind=c_long)
-        if (present(msg_size)) msg_size = int(attr%mq_msgsize, kind=c_long)
-        if (present(cur_msgs)) cur_msgs = int(attr%mq_curmsgs, kind=c_long)
+        if (present(flags))    flags    = int(attr%mq_flags,   kind=i8)
+        if (present(max_msg))  max_msg  = int(attr%mq_maxmsg,  kind=i8)
+        if (present(msg_size)) msg_size = int(attr%mq_msgsize, kind=i8)
+        if (present(cur_msgs)) cur_msgs = int(attr%mq_curmsgs, kind=i8)
 
         rc = E_NONE
-    end function dm_mqueue_attr
+    end function dm_mqueue_attributes
 
     integer function dm_mqueue_close(mqueue) result(rc)
         !! Closes message queue.

src/dm_nml.f90

@@ -1,7 +1,7 @@
 ! Author:  Philipp Engel
 ! Licence: ISC
 module dm_nml
-    !! Fortran namelist import/export of DMPACK derived types.
+    !! Fortran 95 Namelist import/export of DMPACK derived types.
     use :: dm_error
     use :: dm_file
     use :: dm_kind
@@ -19,7 +19,7 @@ module dm_nml
     integer, parameter, public :: NML_TARGET_LEN = 296       !! Max. size of `target_type` namelist in bytes.
 
     interface dm_nml_from
-        !! Converts type to static or allocatable string.
+        !! Converts type to static or allocatable namelist string.
         module procedure :: nml_from_beat
         module procedure :: nml_from_log
         module procedure :: nml_from_node
@@ -36,7 +36,7 @@ module dm_nml
     end interface
 
     interface dm_nml_to
-        !! Converts string to type.
+        !! Converts namelist string to type.
         module procedure :: nml_to_beat
         module procedure :: nml_to_log
         module procedure :: nml_to_node
@@ -46,13 +46,13 @@ module dm_nml
     end interface
 
     interface dm_nml_read
-        !! Reads type from file or standard input.
+        !! Reads namelist from file or standard input.
         module procedure :: nml_read_log
         module procedure :: nml_read_observ
     end interface
 
     interface dm_nml_write
-        !! Writes type to file or standard output.
+        !! Writes namelist to file or standard output.
         module procedure :: nml_write_log
         module procedure :: nml_write_observ
     end interface

src/dm_test.f90

@@ -62,10 +62,31 @@ end function dm_test_function
     public :: dm_test_dummy_target
     public :: dm_test_function
     public :: dm_test_run
+    public :: dm_test_skip
 contains
     ! ******************************************************************
     ! PUBLIC PROCEDURES.
     ! ******************************************************************
+    logical function dm_test_skip(env_var) result(skip)
+        !! Returns `.true.` and outputs a debug message if environment variable
+        !! of name `env_var` is set to 1.
+        use :: dm_env, only: dm_env_get, dm_env_has
+        character(len=*), intent(in) :: env_var !! Name of the environment variable.
+
+        integer :: rc
+        logical :: no_color
+
+        rc = dm_env_get(env_var, skip, .false.)
+        no_color = dm_env_has('NO_COLOR')
+
+        if (skip) then
+            call dm_ansi_color(COLOR_YELLOW, no_color)
+            print '("> Environment variable ", a, " is set.")', trim(env_var)
+            print '("> This test will be skipped.")'
+            call dm_ansi_reset(no_color)
+        end if
+    end function dm_test_skip
+
     impure elemental subroutine dm_test_dummy_beat(beat)
         !! Generates dummy beat data type.
         use :: dm_beat
@@ -297,7 +318,7 @@ subroutine dm_test_run(tests, stats, no_color)
         call test_title('TEST SESSION STARTS', TEST_LINE_LEN)
         call dm_ansi_reset(no_color_)
 
-        print '("Time....: ", a)',    dm_time_now()
+        print '("Time....: ", a)',    dm_time_strip_useconds(dm_time_now())
         print '("System..: ", a, 1x, a, " (", a, ")")', &
             trim(uname%system_name), trim(uname%release), trim(uname%machine)
         print '("Compiler: ", a)',    compiler_version()

test/dmtestlogger.f90

@@ -8,31 +8,13 @@ program dmtestlogger
     implicit none (type, external)
     integer, parameter :: NTESTS = 1
 
-    logical         :: no_color
     logical         :: stats(NTESTS)
     type(test_type) :: tests(NTESTS)
 
     call dm_init()
-    no_color = dm_env_has('NO_COLOR')
-
     tests(1) = test_type('dmtestlogger.test01', test01)
-
-    call dm_test_run(tests, stats, no_color)
+    call dm_test_run(tests, stats, dm_env_has('NO_COLOR'))
 contains
-    logical function skip_test() result(skip)
-        integer :: rc
-
-        rc = dm_env_get('DM_MQUEUE_SKIP', skip)
-
-        if (skip) then
-            call dm_ansi_color(COLOR_YELLOW, no_color)
-            print '("dmtestlogger:")'
-            print '("    Environment variable DM_MQUEUE_SKIP is set.")'
-            print '("    This test will be skipped.")'
-            call dm_ansi_reset(no_color)
-        end if
-    end function skip_test
-
     logical function test01() result(stat)
         character(len=*), parameter   :: JSON = &
             '{ "id": "f5ec2dd3870a47b5be3ae397552706fe", "level": 4, "error": 1, "timestamp": ' // &
@@ -48,7 +30,7 @@ logical function test01() result(stat)
         type(observ_type)             :: observ
 
         stat = TEST_PASSED
-        if (skip_test()) return
+        if (dm_test_skip('DM_MQUEUE_SKIP')) return
 
         stat = TEST_FAILED
         observ%id        = '6b0ca75ae594425a8d38adfd709b11cd'

test/dmtestmail.f90

@@ -47,9 +47,8 @@ logical function get_env(from, to, host, username, password) result(has)
             dm_is_error(dm_env_get('DM_MAIL_PASSWORD', password))) then
 
             call dm_ansi_color(COLOR_YELLOW, no_color)
-            print '("dmtestmail:")'
-            print '("    Set environment variables DM_MAIL_FROM, DM_MAIL_TO, DM_MAIL_HOST,")'
-            print '("    DM_MAIL_USERNAME, and DM_MAIL_PASSWORD. This test will be skipped.")'
+            print '("> Set environment variables DM_MAIL_FROM, DM_MAIL_TO, DM_MAIL_HOST,")'
+            print '("> DM_MAIL_USERNAME, and DM_MAIL_PASSWORD. This test will be skipped.")'
             call dm_ansi_reset(no_color)
             return
         end if

test/dmtestmqtt.f90

@@ -38,9 +38,8 @@ logical function get_env(host, port) result(has)
         if (dm_is_error(dm_env_get('DM_MQTT_HOST', host)) .or. &
             dm_is_error(dm_env_get('DM_MQTT_PORT', port))) then
             call dm_ansi_color(COLOR_YELLOW, no_color)
-            print '("dmtestmqtt:")'
-            print '("    Set environment variables DM_MQTT_HOST and DM_MQTT_PORT.")'
-            print '("    This test will be skipped.")'
+            print '("> Set environment variables DM_MQTT_HOST and DM_MQTT_PORT.")'
+            print '("> This test will be skipped.")'
             call dm_ansi_reset(no_color)
             return
         end if

test/dmtestmqueue.f90

@@ -25,32 +25,16 @@ program dmtestmqueue
 
     integer, parameter :: NTESTS = 2
 
-    logical         :: no_color
     logical         :: stats(NTESTS)
     type(test_type) :: tests(NTESTS)
 
     call dm_init()
-    no_color = dm_env_has('NO_COLOR')
 
     tests(1) = test_type('dmtestmqueue.test01', test01)
     tests(2) = test_type('dmtestmqueue.test02', test02)
 
-    call dm_test_run(tests, stats, no_color)
+    call dm_test_run(tests, stats, dm_env_has('NO_COLOR'))
 contains
-    logical function skip_test() result(skip)
-        integer :: rc
-
-        rc = dm_env_get('DM_MQUEUE_SKIP', skip, .false.)
-
-        if (skip) then
-            call dm_ansi_color(COLOR_YELLOW, no_color)
-            print '("dmtestmqueue:")'
-            print '("    Environment variable DM_MQUEUE_SKIP is set.")'
-            print '("    This test will be skipped.")'
-            call dm_ansi_reset(no_color)
-        end if
-    end function skip_test
-
     logical function test01() result(stat)
         !! Tests observation exchange using a single message queue descriptor.
         integer           :: rc
@@ -59,7 +43,7 @@ logical function test01() result(stat)
         type(observ_type) :: observ1, observ2
 
         stat = TEST_PASSED
-        if (skip_test()) return
+        if (dm_test_skip('DM_MQUEUE_SKIP')) return
 
         stat = TEST_FAILED
         print *, 'Creating message queue "' // MQ_NAME // '" ...'
@@ -76,7 +60,7 @@ logical function test01() result(stat)
         if (dm_is_error(rc)) return
 
         print *, 'Reading message queue attributes ...'
-        rc = dm_mqueue_attr(mqueue, flags, max_msg, msg_size, cur_msgs)
+        rc = dm_mqueue_attributes(mqueue, flags, max_msg, msg_size, cur_msgs)
         call dm_error_out(rc, dm_system_error_message())
         if (dm_is_error(rc)) return
 
@@ -127,7 +111,7 @@ logical function test02() result(stat)
         type(observ_type) :: observ1, observ2
 
         stat = TEST_PASSED
-        if (skip_test()) return
+        if (dm_test_skip('DM_MQUEUE_SKIP')) return
 
         stat = TEST_FAILED
         rc = dm_mqueue_open(mqueue1, TYPE_OBSERV, MQ_NAME, MQUEUE_WRONLY)

test/dmtestpipe.f90

@@ -20,31 +20,13 @@ program dmtestpipe
     implicit none (type, external)
     integer, parameter :: NTESTS = 1
 
-    logical         :: no_color
     logical         :: stats(NTESTS)
     type(test_type) :: tests(NTESTS)
 
     call dm_init()
-    no_color = dm_env_has('NO_COLOR')
-
     tests(1) = test_type('dmtestpipe.test01', test01)
-
-    call dm_test_run(tests, stats, no_color)
+    call dm_test_run(tests, stats, dm_env_has('NO_COLOR'))
 contains
-    logical function skip_test() result(skip)
-        integer :: rc
-
-        rc = dm_env_get('DM_PIPE_SKIP', skip)
-
-        if (skip) then
-            call dm_ansi_color(COLOR_YELLOW, no_color)
-            print '("dmtestpipe:")'
-            print '("    Environment variable DM_PIPE_SKIP is set.")'
-            print '("    This test will be skipped.")'
-            call dm_ansi_reset(no_color)
-        end if
-    end function skip_test
-
     logical function test01() result(stat)
         character(len=*), parameter :: COMMAND = 'cat -n'
 
@@ -54,7 +36,7 @@ logical function test01() result(stat)
         type(pipe_type)   :: stdin, stdout, stderr
 
         stat = TEST_PASSED
-        if (skip_test()) return
+        if (dm_test_skip('DM_PIPE_SKIP')) return
 
         stat = TEST_FAILED
         rc = dm_pipe_open2(stdin, stdout, stderr, COMMAND)