From 69714cca9ee60565839b6acf4a1b675a380bcd7f Mon Sep 17 00:00:00 2001 From: Philipp Date: Sat, 20 Apr 2024 19:53:23 +0200 Subject: [PATCH] Refactoring. Added dummy arguments. --- app/dmweb.f90 | 203 ++++++++++++++++++++++++++++-------------------- src/dm_env.f90 | 147 +++++++++++++++++++++-------------- src/dm_html.f90 | 5 +- src/dmpack.f90 | 5 +- 4 files changed, 214 insertions(+), 146 deletions(-) diff --git a/app/dmweb.f90 b/app/dmweb.f90 index 3f5d816..ccb3ce4 100644 --- a/app/dmweb.f90 +++ b/app/dmweb.f90 @@ -3,15 +3,36 @@ ! Author: Philipp Engel ! Licence: ISC program dmweb - !! Server-side web application for DMPACK database access. A CGI- - !! compatible web server, such as lighttpd, is required to run this - !! program. If served locally, access the web interface at + !! This program is a server-side web application for DMPACK database access + !! that has to be executed by a CGI-compatible web server, such as + !! _lighttpd(1)_. If served locally, access the web interface at !! `http://127.0.0.1/dmpack/`. !! - !! Make sure that the URL is redirected to the CGI program in your web - !! server configuration. + !! Make sure that the path `/dmpack` is redirected to the CGI program. For + !! example, in the _lighttpd(1)_ configuration file `lighttpd.conf`, load + !! the required modules first and then add an alias: !! - !! Configure the application through CGI environment variables: + !! ```lighttpd + !! # Load additional modules. + !! server.modules += ( + !! "mod_alias", + !! "mod_authn_file", + !! "mod_cgi", + !! "mod_setenv" + !! ) + !! + !! $HTTP["url"] =^ "/dmpack/" { + !! # Map URL to CGI executable. + !! alias.url += ( "/dmpack" => "/usr/local/bin/dmweb" + !! + !! # Enable CGI. + !! cgi.assign = ( "" => "" ) + !! } + !! ``` + !! + !! In this particular case, the web interface is installed to + !! `/usr/local/bin/` Configure the application through CGI environment + !! variables: !! !! | Environment Variable | Description | !! |----------------------|----------------------------------------------| @@ -21,11 +42,23 @@ program dmweb !! | `DM_READ_ONLY` | Open databases in read-only mode (optional). | !! !! The databases have to exist at start-up. Add the variables to the - !! configuration file of your web server. + !! configuration file of your web server. In _lighttpd(1)_, for instance: + !! + !! ```lighttpd + !! # Pass the database paths through environment variables. + !! setenv.add-environment = ( + !! "DM_DB_BEAT" => "/var/dmpack/beat.sqlite", + !! "DM_DB_LOG" => "/var/dmpack/log.sqlite", + !! "DM_DB_OBSERV" => "/var/dmpack/observ.sqlite", + !! "DM_READ_ONLY" => "0" + !! ) + !! ``` + !! + !! The module `sentenv` must be loaded (see above). !! - !! Copy the CSS file `share/dmpack.min.css` and the JavaScript file - !! `share/dmpack.js` to the document root path (`/var/www/`), or create a - !! symlink. Other classless style sheets may work as well. + !! Copy the CSS file `share/dmpack.min.css` to the document root path of the + !! web server (for example, `/var/www/`), or create a symlink. Other + !! classless style sheets may work as well. use :: dmpack implicit none (type, external) @@ -84,11 +117,10 @@ program dmweb type(cgi_env_type) :: env ! Read environment variables. - has_db_beat = dm_is_ok(dm_env_get('DM_DB_BEAT', db_beat, n)) ! Path to beat database. - has_db_log = dm_is_ok(dm_env_get('DM_DB_LOG', db_log, n)) ! Path to log database. - has_db_observ = dm_is_ok(dm_env_get('DM_DB_OBSERV', db_observ, n)) ! Path to observ database. - - rc = dm_env_get('DM_READ_ONLY', read_only, APP_READ_ONLY) ! Database access mode. + rc = dm_env_get('DM_DB_BEAT', db_beat, n, exists=has_db_beat) + rc = dm_env_get('DM_DB_LOG', db_log, n, exists=has_db_log) + rc = dm_env_get('DM_DB_OBSERV', db_observ, n, exists=has_db_observ) + rc = dm_env_get('DM_READ_ONLY', read_only, APP_READ_ONLY) ! Set-up router. rc = dm_cgi_router_set(router, routes) @@ -116,7 +148,7 @@ subroutine route_beat(env) !! * GET !! !! ## GET Parameters - !! * node_id - Node ID (string). + !! * `node_id` – Node id (string). character(len=*), parameter :: TITLE = 'Beat' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -419,7 +451,7 @@ subroutine route_log(env) !! * GET !! !! ## GET Parameters - !! * id - Log ID (UUID4). + !! * `id` – Log id (UUID4). character(len=*), parameter :: TITLE = 'Log' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -484,14 +516,14 @@ subroutine route_logs(env) !! * POST !! !! ## POST Parameters - !! * node_id - Node ID (string). - !! * sensor_id - Sensor ID (string). - !! * target_id - Target ID (string). - !! * source - Log source (string). - !! * from - Time range start (ISO 8601). - !! * to - Time range end (ISO 8601). - !! * level - Log level (integer). - !! * max_results - Maximum number of logs (integer). + !! * `node_id` – Node id (string). + !! * `sensor_id` – Sensor id (string). + !! * `target_id` – Target id (string). + !! * `source` – Log source (string). + !! * `from` – Time range start (ISO 8601). + !! * `to` – Time range end (ISO 8601). + !! * `level` – Log level (integer). + !! * `max_results` – Maximum number of logs (integer). character(len=*), parameter :: TITLE = 'Logs' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -652,7 +684,7 @@ subroutine route_node(env) !! * GET !! !! ## GET Parameters - !! * id - Node ID (string). + !! * `id` – Node id (string). character(len=*), parameter :: TITLE = 'Node' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -710,9 +742,9 @@ subroutine route_nodes(env) !! * POST !! !! ## POST Parameters - !! * id - Node ID (string). - !! * name - Node name (string). - !! * meta - Node meta description (string). + !! * `id` – Node id (string). + !! * `name` – Node name (string). + !! * `meta` – Node meta description (string). character(len=*), parameter :: TITLE = 'Nodes' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -805,7 +837,7 @@ subroutine route_observ(env) !! * GET !! !! ## GET Parameters - !! * id - Observation ID (UUID4). + !! * `id` – Observation id (UUID4). character(len=*), parameter :: TITLE = 'Observation' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -892,12 +924,12 @@ subroutine route_observs(env) !! * POST !! !! ## POST Parameters - !! * node_id - Node ID (string). - !! * sensor_id - Sensor ID (string). - !! * target_id - Target ID (string). - !! * from - Time range start (ISO 8601). - !! * to - Time range end (ISO 8601). - !! * max_results - Maximum number of points per plot (integer). + !! * `node_id` – Node id (string). + !! * `sensor_id` – Sensor id (string). + !! * `target_id` – Target id (string). + !! * `from` – Time range start (ISO 8601). + !! * `to` – Time range end (ISO 8601). + !! * `max_results` – Maximum number of points per plot (integer). character(len=*), parameter :: TITLE = 'Observations' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -1029,13 +1061,13 @@ subroutine route_plots(env) !! * POST !! !! ## POST Parameters - !! * node_id - Node ID (string). - !! * sensor_id - Sensor ID (string). - !! * target_id - Target ID (string). - !! * response_name - Observation response name (string). - !! * from - Time range start (ISO 8601). - !! * to - Time range end (ISO 8601). - !! * max_results - Maximum number of data points (integer). + !! * `node_id` – Node id (string). + !! * `sensor_id` – Sensor id (string). + !! * `target_id` – Target id (string). + !! * `response_name` – Observation response name (string). + !! * `from` – Time range start (ISO 8601). + !! * `to` – Time range end (ISO 8601). + !! * `max_results` – Maximum number of data points (integer). character(len=*), parameter :: TITLE = 'Plots' !! Page title. integer, parameter :: PLOT_WIDTH = 1050 !! Default plot width. integer, parameter :: PLOT_HEIGHT = 400 !! Default plot height. @@ -1200,7 +1232,7 @@ subroutine route_sensor(env) !! * GET !! !! ## GET Parameters - !! * id - Sensor ID (string). + !! * `id` – Sensor id (string). character(len=*), parameter :: TITLE = 'Sensor' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -1484,7 +1516,7 @@ subroutine route_target(env) !! * GET !! !! ## GET Parameters - !! * id - Target ID (string). + !! * `id` – Target id (string). character(len=*), parameter :: TITLE = 'Target' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -1540,10 +1572,11 @@ subroutine route_targets(env) !! Targets page. !! !! ## Path - !! /dmpack/targets + !! * `/dmpack/targets` !! !! ## Methods - !! GET, POST + !! * GET + !! * POST character(len=*), parameter :: TITLE = 'Targets' !! Page title. type(cgi_env_type), intent(inout) :: env !! CGI environment type. @@ -1724,16 +1757,16 @@ function html_form_logs(nodes, sensors, targets, max_results, node_id, sensor_id ! Create HTML. html = H_FORM_POST // H_FIELDSET // & - H_DIV_ROW // & - H_DIV_COL // & + H_DIV_ROW // & ! row 1 + H_DIV_COL // & ! column 1 dm_html_label('Node Name', for='node_id') // & dm_html_select(select_node, 'node_id', 'node_id', node_id_) // & dm_html_label('Sensor Name', for='sensor_id') // & dm_html_select(select_sensor, 'sensor_id', 'sensor_id', sensor_id_) // & dm_html_label('Target Name', for='target_id') // & dm_html_select(select_target, 'target_id', 'target_id', target_id_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 1 + H_DIV_COL // & ! column 2 dm_html_label('Source', for='source') // & dm_html_input(HTML_INPUT_TYPE_TEXT, id='source', name='source', & max_length=LOG_SOURCE_LEN, pattern='[\-0-9A-Z_a-z]+', & @@ -1742,14 +1775,14 @@ function html_form_logs(nodes, sensors, targets, max_results, node_id, sensor_id dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='from', name='from', required=.true., value=from_) // & dm_html_label('To', for='to') // & dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='to', name='to', required=.true., value=to_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 2 + H_DIV_COL // & ! column 3 dm_html_label('Log Level', for='level') // & dm_html_select(select_level, 'level', 'level', level_) // & dm_html_label('Max. Results', for='max_results') // & dm_html_select(select_result, 'max_results', 'max_results', dm_itoa(nresults_)) // & - H_DIV_END // & - H_DIV_END // & + H_DIV_END // & ! end column 3 + H_DIV_END // & ! end row 1 dm_html_input(HTML_INPUT_TYPE_SUBMIT, name='submit', value='Search') // & H_FIELDSET_END // H_FORM_END @@ -1774,8 +1807,8 @@ function html_form_nodes(disabled) result(html) html = H_DETAILS // H_SUMMARY // 'Add Node' // H_SUMMARY_END // & H_P // 'Add a new sensor node to the database.' // H_P_END // & H_FORM_POST // H_FIELDSET // & - H_DIV_ROW // & - H_DIV_COL // & + H_DIV_ROW // & ! row 1 + H_DIV_COL // & ! column 1 dm_html_label('ID', for='id') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='id', name='id', & max_length=NODE_ID_LEN, pattern='[\-0-9A-Z_a-z]+', & @@ -1787,8 +1820,8 @@ function html_form_nodes(disabled) result(html) dm_html_label('Meta', for='meta') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='meta', name='meta', & max_length=NODE_META_LEN, placeholder='Enter node description (optional)') // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 1 + H_DIV_COL // & ! column 2 dm_html_label('X', for='x') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='x', name='x', & pattern='[\+\-\.0-9]+', placeholder='Enter node X or easting (optional)') // & @@ -1798,8 +1831,8 @@ function html_form_nodes(disabled) result(html) dm_html_label('Z', for='z') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='z', name='z', & pattern='[\+\-\.0-9]+', placeholder='Enter node Z or altitude (optional)') // & - H_DIV_END // & - H_DIV_END // & + H_DIV_END // & ! end column 2 + H_DIV_END // & ! end row 1 dm_html_input(HTML_INPUT_TYPE_SUBMIT, disabled=disabled_, name='submit', value='Submit') // & H_FIELDSET_END // H_FORM_END // H_DETAILS_END end function html_form_nodes @@ -1877,26 +1910,26 @@ function html_form_observs(nodes, sensors, targets, max_results, node_id, sensor ! Create HTML. html = H_FORM_POST // H_FIELDSET // & - H_DIV_ROW // & - H_DIV_COL // & + H_DIV_ROW // & ! row 1 + H_DIV_COL // & ! column 1 dm_html_label('Node Name', for='node_id') // & dm_html_select(select_node, 'node_id', 'node_id', node_id_) // & dm_html_label('Sensor Name', for='sensor_id') // & dm_html_select(select_sensor, 'sensor_id', 'sensor_id', sensor_id_) // & dm_html_label('Target Name', for='target_id') // & dm_html_select(select_target, 'target_id', 'target_id', target_id_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 1 + H_DIV_COL // & ! column 2 dm_html_label('From', for='from') // & dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='from', name='from', required=.true., value=from_) // & dm_html_label('To', for='to') // & dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='to', name='to', required=.true., value=to_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 2 + H_DIV_COL // & ! column 3 dm_html_label('Max. Results', for='max_results') // & dm_html_select(select_result, 'max_results', 'max_results', dm_itoa(nresults_)) // & - H_DIV_END // & - H_DIV_END // & + H_DIV_END // & ! end column 3 + H_DIV_END // & ! end row 1 dm_html_input(HTML_INPUT_TYPE_SUBMIT, disabled=disabled, name='submit', value='Search') // & H_FIELDSET_END // H_FORM_END @@ -1986,16 +2019,16 @@ function html_form_plots(nodes, sensors, targets, max_results, node_id, sensor_i ! Create HTML. html = H_FORM_POST // H_FIELDSET // & - H_DIV_ROW // & - H_DIV_COL // & + H_DIV_ROW // & ! row 1 + H_DIV_COL // & ! column 1 dm_html_label('Node Name', for='node_id') // & dm_html_select(select_node, 'node_id', 'node_id', node_id_) // & dm_html_label('Sensor Name', for='sensor_id') // & dm_html_select(select_sensor, 'sensor_id', 'sensor_id', sensor_id_) // & dm_html_label('Target Name', for='target_id') // & dm_html_select(select_target, 'target_id', 'target_id', target_id_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 1 + H_DIV_COL // & ! column 2 dm_html_label('Response Name', for='response_name') // & dm_html_input(HTML_INPUT_TYPE_TEXT, id='response_name', name='response_name', & max_length=RESPONSE_NAME_LEN, pattern='[\-0-9A-Z_a-z]+', & @@ -2005,12 +2038,12 @@ function html_form_plots(nodes, sensors, targets, max_results, node_id, sensor_i dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='from', name='from', required=.true., value=from_) // & dm_html_label('To', for='to') // & dm_html_input(HTML_INPUT_TYPE_DATETIME_LOCAL, id='to', name='to', required=.true., value=to_) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 2 + H_DIV_COL // & ! column 3 dm_html_label('Max. Results', for='max_results') // & dm_html_select(select_result, 'max_results', 'max_results', dm_itoa(nresults_)) // & - H_DIV_END // & - H_DIV_END // & + H_DIV_END // & ! end column 3 + H_DIV_END // & ! end row 1 dm_html_input(HTML_INPUT_TYPE_SUBMIT, disabled=disabled, name='submit', value='Plot') // & H_FIELDSET_END // H_FORM_END @@ -2049,8 +2082,8 @@ function html_form_sensors(nodes, disabled) result(html) html = H_DETAILS // H_SUMMARY // 'Add Sensor' // H_SUMMARY_END // & H_P // 'Add a new sensor to the database.' // H_P_END // & H_FORM_POST // H_FIELDSET // & - H_DIV_ROW // & - H_DIV_COL // & + H_DIV_ROW // & ! row 1 + H_DIV_COL // & ! column 1 dm_html_label('Node Name', for='node_id') // & dm_html_select(select_node, 'node_id', 'node_id', '', disabled=disabled_) // & dm_html_label('ID', for='id') // & @@ -2061,8 +2094,8 @@ function html_form_sensors(nodes, disabled) result(html) dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='name', name='name', & max_length=SENSOR_NAME_LEN, placeholder='Enter sensor name', & required=.true.) // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 1 + H_DIV_COL // & ! column 2 dm_html_label('Type', for='type') // & dm_html_select(select_sensor_type, 'type', 'type', dm_itoa(SENSOR_TYPE_NONE), disabled=disabled_) // & dm_html_label('Serial Number', for='sn') // & @@ -2071,8 +2104,8 @@ function html_form_sensors(nodes, disabled) result(html) dm_html_label('Meta', for='meta') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='meta', name='meta', & max_length=SENSOR_META_LEN, placeholder='Enter sensor description (optional)') // & - H_DIV_END // & - H_DIV_COL // & + H_DIV_END // & ! end column 2 + H_DIV_COL // & ! column 3 dm_html_label('X', for='x') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='x', name='x', & pattern='[\+\-\.0-9]+', placeholder='Enter sensor X or easting (optional)') // & @@ -2082,8 +2115,8 @@ function html_form_sensors(nodes, disabled) result(html) dm_html_label('Z', for='z') // & dm_html_input(HTML_INPUT_TYPE_TEXT, disabled=disabled_, id='z', name='z', & pattern='[\+\-\.0-9]+', placeholder='Enter sensor Z or altitude (optional)') // & - H_DIV_END // & - H_DIV_END // & + H_DIV_END // & ! end column 3 + H_DIV_END // & ! end row 1 dm_html_input(HTML_INPUT_TYPE_SUBMIT, disabled=disabled_, name='submit', value='Submit') // & H_FIELDSET_END // H_FORM_END // H_DETAILS_END diff --git a/src/dm_env.f90 b/src/dm_env.f90 index 167c212..48915af 100644 --- a/src/dm_env.f90 +++ b/src/dm_env.f90 @@ -32,21 +32,40 @@ module dm_env private :: env_get_real64 private :: env_get_string contains + ! ****************************************************************** + ! PUBLIC PROCEDURES. + ! ****************************************************************** + logical function dm_env_has(name) result(has) + !! Returns `.true.` if the environment variable of the given name + !! exists and has a value. + character(len=*), intent(in) :: name !! Variable name. + + character :: a + integer :: n, stat + + call get_environment_variable(name, a, length=n, status=stat) + has = (stat == 0 .and. n > 0) + end function dm_env_has + ! ****************************************************************** ! PRIVATE PROCEDURES. ! ****************************************************************** - integer function env_get_allocatable(name, value, default) result(rc) + integer function env_get_allocatable(name, value, default, exists) result(rc) !! Returns environment variable as allocatable string in `value`, with !! optional default value from `default` if the variable does not exist. - character(len=*), intent(in) :: name !! Variable name. - character(len=:), allocatable, intent(out) :: value !! Variable value. - character(len=*), intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + character(len=:), allocatable, intent(out) :: value !! Variable value. + character(len=*), intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. character(len=ENV_BUFFER_LEN) :: buffer integer :: n, stat - rc = E_EMPTY + rc = E_EMPTY buffer = ' ' + + if (present(exists)) exists = .false. + call get_environment_variable(name, buffer, length=n, status=stat) if (stat /= 0 .or. n == 0) then @@ -59,150 +78,164 @@ integer function env_get_allocatable(name, value, default) result(rc) return end if + if (present(exists)) exists = .true. + value = trim(buffer) - rc = E_NONE + rc = E_NONE end function env_get_allocatable - integer function env_get_int32(name, value, default) result(rc) + integer function env_get_int32(name, value, default, exists) result(rc) !! Returns environment variable as 4-byte integer in `value`, with !! optional default value from `default` if the variable does not exist. - character(len=*), intent(in) :: name !! Variable name. - integer(kind=i4), intent(out) :: value !! Variable value. - integer(kind=i4), intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + integer(kind=i4), intent(out) :: value !! Variable value. + integer(kind=i4), intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. character(len=20) :: buffer integer :: i, n, stat - rc = E_EMPTY + rc = E_EMPTY value = 0 - if (present(default)) value = default + + if (present(default)) value = default + if (present(exists)) exists = .false. call get_environment_variable(name, buffer, length=n, status=stat) if (stat /= 0 .or. n == 0) return + if (present(exists)) exists = .true. call dm_string_to(buffer, i, rc) if (rc /= E_NONE) return value = i - rc = E_NONE + rc = E_NONE end function env_get_int32 - integer function env_get_int64(name, value, default) result(rc) + integer function env_get_int64(name, value, default, exists) result(rc) !! Returns environment variable as 8-byte integer in `value`, with !! optional default value from `default` if the variable does not exist. - character(len=*), intent(in) :: name !! Variable name. - integer(kind=i8), intent(out) :: value !! Variable value. - integer(kind=i8), intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + integer(kind=i8), intent(out) :: value !! Variable value. + integer(kind=i8), intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. character(len=20) :: buffer integer :: n, stat integer(kind=i8) :: i - rc = E_EMPTY + rc = E_EMPTY value = 0 - if (present(default)) value = default + + if (present(default)) value = default + if (present(exists)) exists = .false. call get_environment_variable(name, buffer, length=n, status=stat) if (stat /= 0 .or. n == 0) return + if (present(exists)) exists = .true. call dm_string_to(buffer, i, rc) if (rc /= E_NONE) return value = i - rc = E_NONE + rc = E_NONE end function env_get_int64 - integer function env_get_logical(name, value, default) result(rc) + integer function env_get_logical(name, value, default, exists) result(rc) !! Returns environment variable as logical in `value`, with optional !! default value from `default` if the variable does not exist. An !! integer value greater 0 is interpreted as `.true.`, else `.false.`. - character(len=*), intent(in) :: name !! Variable name. - logical, intent(out) :: value !! Variable value. - logical, intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + logical, intent(out) :: value !! Variable value. + logical, intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. integer :: i value = .false. - if (present(default)) value = default + + if (present(default)) value = default + if (present(exists)) exists = .false. rc = dm_env_get(name, i) if (rc /= E_NONE) return + if (present(exists)) exists = .true. value = (i > 0) - rc = E_NONE + rc = E_NONE end function env_get_logical - integer function env_get_real32(name, value, default) result(rc) + integer function env_get_real32(name, value, default, exists) result(rc) !! Returns environment variable as 4-byte real in `value`, with optional !! default value from `default` if the variable does not exist. - character(len=*), intent(in) :: name !! Variable name. - real(kind=r4), intent(out) :: value !! Variable value. - real(kind=r4), intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + real(kind=r4), intent(out) :: value !! Variable value. + real(kind=r4), intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. character(len=20) :: buffer integer :: n, stat real(kind=r4) :: f - rc = E_EMPTY + rc = E_EMPTY value = 0 - if (present(default)) value = default + + if (present(default)) value = default + if (present(exists)) exists = .false. call get_environment_variable(name, buffer, length=n, status=stat) if (stat /= 0 .or. n == 0) return + if (present(exists)) exists = .true. call dm_string_to(buffer, f, rc) if (rc /= E_NONE) return value = f - rc = E_NONE + rc = E_NONE end function env_get_real32 - integer function env_get_real64(name, value, default) result(rc) + integer function env_get_real64(name, value, default, exists) result(rc) !! Returns environment variable as 8-byte real in `value`, with optional !! default value from `default` if the variable does not exist. - character(len=*), intent(in) :: name !! Variable name. - real(kind=r8), intent(out) :: value !! Variable value. - real(kind=r8), intent(in), optional :: default !! Default value. + character(len=*), intent(in) :: name !! Variable name. + real(kind=r8), intent(out) :: value !! Variable value. + real(kind=r8), intent(in), optional :: default !! Default value. + logical, intent(out), optional :: exists !! Variable exists. character(len=20) :: buffer integer :: n, stat real(kind=r8) :: f - rc = E_EMPTY + rc = E_EMPTY value = 0 - if (present(default)) value = default + + if (present(default)) value = default + if (present(exists)) exists = .false. call get_environment_variable(name, buffer, length=n, status=stat) if (stat /= 0 .or. n == 0) return + if (present(exists)) exists = .true. call dm_string_to(buffer, f, rc) if (rc /= E_NONE) return value = f - rc = E_NONE + rc = E_NONE end function env_get_real64 - integer function env_get_string(name, value, n) result(rc) + integer function env_get_string(name, value, n, exists) result(rc) !! Returns environment variable as string in `value` and string !! length in `n`. - character(len=*), intent(in) :: name !! Variable name. - character(len=*), intent(inout) :: value !! Variable value. - integer, intent(out) :: n !! Actual length of string. + character(len=*), intent(in) :: name !! Variable name. + character(len=*), intent(inout) :: value !! Variable value. + integer, intent(out) :: n !! Actual length of string. + logical, intent(out), optional :: exists !! Variable exists. integer :: stat - rc = E_EMPTY + rc = E_EMPTY value = ' ' + if (present(exists)) exists = .false. + call get_environment_variable(name, value, length=n, status=stat) if (stat /= 0 .or. n == 0) return + if (present(exists)) exists = .true. rc = E_NONE end function env_get_string - - logical function dm_env_has(name) result(has) - !! Returns `.true.` if the environment variable of the given name - !! exists and has a value. - character(len=*), intent(in) :: name !! Variable name. - - character :: a - integer :: n, stat - - call get_environment_variable(name, a, length=n, status=stat) - has = (stat == 0 .and. n > 0) - end function dm_env_has end module dm_env diff --git a/src/dm_html.f90 b/src/dm_html.f90 index 21fbf24..fda1194 100644 --- a/src/dm_html.f90 +++ b/src/dm_html.f90 @@ -630,10 +630,13 @@ function dm_html_header(title, subtitle, style, internal_style, brand, nav, mask ! Sidebar navigation. if (present(nav) .and. present(mask)) then + ! Apply mask on navigation anchors. html = html // dm_html_nav(nav, mask) else if (present(nav)) then + ! Use whole navigation anchors array. html = html // dm_html_nav(nav) else + ! No navigation. if (has_subtitle) then html = html // dm_html_heading(1, title, subtitle) else @@ -934,7 +937,7 @@ function dm_html_logs(logs, prefix, node, max_len) result(html) if (node_) html = html // H_TH // 'Node' // H_TH_END - html = html // H_TH // 'Source' // H_TH_END // & + html = html // H_TH // 'Source' // H_TH_END // & H_TH // 'Level' // H_TH_END // & H_TH // 'Error' // H_TH_END // & H_TH // 'Message' // H_TH_END // & diff --git a/src/dmpack.f90 b/src/dmpack.f90 index fc430a5..e6a0e0b 100644 --- a/src/dmpack.f90 +++ b/src/dmpack.f90 @@ -16,7 +16,7 @@ module dmpack !! call dm_init() !! !! ! Call any DMPACK procedures here. - !! ! ... + !! call dm_version_out() !! end program main !! ``` !! @@ -26,8 +26,7 @@ module dmpack !! $ gfortran -I/usr/local/include/dmpack -o app app.f90 /usr/local/lib/libdmpack.a !! ``` !! - !! On Linux, change `/usr/local` to `/usr` (or the chosen installation - !! prefix). + !! You may have to change `/usr/local` the chosen installation prefix. use :: dm_ansi use :: dm_api use :: dm_arg