From ba0d5090b4c02466630a93dcebec96dbb5f28b70 Mon Sep 17 00:00:00 2001 From: Philipp Date: Thu, 7 Mar 2024 01:33:17 +0100 Subject: [PATCH] Refactoring. Minor updates. --- adoc/dmexport.adoc | 2 +- app/dmexport.f90 | 103 ++++++------- app/dmimport.f90 | 16 +- app/dmpipe.f90 | 2 +- app/dmserial.f90 | 37 +++-- app/dmsync.f90 | 4 +- app/dmweb.f90 | 2 +- config/dmserial.conf.sample | 91 +++++------- man/dmexport.1 | 6 +- src/dm_dp.f90 | 86 +++++------ src/dm_geocom.f90 | 283 ++++++++++++++++++++---------------- src/dm_geocom_type.f90 | 29 +++- src/dm_logger.f90 | 16 +- src/dm_pipe.f90 | 11 +- src/dm_request.f90 | 4 +- src/dm_system.f90 | 28 ++-- src/dm_tty.f90 | 2 +- src/dm_type.f90 | 6 +- src/dm_z.f90 | 47 +++--- test/dmtestz.f90 | 4 +- 20 files changed, 422 insertions(+), 357 deletions(-) diff --git a/adoc/dmexport.adoc b/adoc/dmexport.adoc index 3d25ed3..c181115 100644 --- a/adoc/dmexport.adoc +++ b/adoc/dmexport.adoc @@ -55,7 +55,7 @@ an empty file will be created. Node id (required). *--output*, *-o* _file_:: - Path of output file. + Path of output file. Empty or `-` for standard output. *--response*, *-R* _name_:: Response name (required for type `dp`). diff --git a/app/dmexport.f90 b/app/dmexport.f90 index 0232430..a95b78b 100644 --- a/app/dmexport.f90 +++ b/app/dmexport.f90 @@ -11,12 +11,12 @@ program dmexport character(len=*), parameter :: APP_NAME = 'dmexport' integer, parameter :: APP_MAJOR = 0 integer, parameter :: APP_MINOR = 9 - integer, parameter :: APP_PATCH = 0 + integer, parameter :: APP_PATCH = 1 type :: app_type !! Command-line arguments. character(len=FILE_PATH_LEN) :: database = ' ' !! Path to database. - character(len=FILE_PATH_LEN) :: output = ' ' !! Output file path. + character(len=FILE_PATH_LEN) :: output = ' ' !! Output file path, empty or '-' for stdout. character(len=NODE_ID_LEN) :: node = ' ' !! Node id. character(len=SENSOR_ID_LEN) :: sensor = ' ' !! Sensor id. character(len=TARGET_ID_LEN) :: target = ' ' !! Target id. @@ -30,7 +30,7 @@ program dmexport end type app_type integer :: rc ! Return code. - type(app_type) :: app ! App type. + type(app_type) :: app ! App settings. ! Initialise DMPACK. call dm_init() @@ -46,7 +46,7 @@ program dmexport integer function export(app) result(rc) type(app_type), intent(inout) :: app - integer :: fu, stat + integer :: stat, unit logical :: is_file type (db_type) :: db @@ -60,7 +60,7 @@ integer function export(app) result(rc) type(target_type), allocatable :: targets(:) is_file = .false. - if (len_trim(app%output) > 0) is_file = .true. + if (len_trim(app%output) > 0 .and. app%output /= '-') is_file = .true. rc = dm_db_open(db, app%database, read_only=.true., validate=.true.) @@ -90,7 +90,7 @@ integer function export(app) result(rc) target_id=app%target, from=app%from, to=app%to) case (TYPE_BEAT) rc = dm_db_select(db, beats) - case (TYPE_DATA_POINT) + case (TYPE_DP) rc = dm_db_select(db, data_points, node_id=app%node, sensor_id=app%sensor, & target_id=app%target, response_name=app%response, & from=app%from, to=app%to) @@ -100,13 +100,16 @@ integer function export(app) result(rc) if (dm_is_error(dm_db_close(db))) rc = E_DB if (dm_is_error(rc)) return - fu = stdout + unit = stdout ! Open file. if (is_file) then rc = E_IO - open (action='write', file=trim(app%output), iostat=stat, newunit=fu, & - status='replace') + open (action = 'write', & + file = trim(app%output), & + iostat = stat, & + newunit = unit, & + status = 'replace') if (stat /= 0) return end if @@ -114,63 +117,66 @@ integer function export(app) result(rc) select case (app%format) case (FORMAT_BLOCK) rc = E_INVALID - if (app%type == TYPE_DATA_POINT) then - rc = dm_block_write(data_points, fu) + if (app%type == TYPE_DP) then + rc = dm_block_write(data_points, unit) end if + case (FORMAT_CSV) select case (app%type) case (TYPE_NODE) - rc = dm_csv_write(nodes, fu, app%header, app%separator) + rc = dm_csv_write(nodes, unit, app%header, app%separator) case (TYPE_SENSOR) - rc = dm_csv_write(sensors, fu, app%header, app%separator) + rc = dm_csv_write(sensors, unit, app%header, app%separator) case (TYPE_TARGET) - rc = dm_csv_write(targets, fu, app%header, app%separator) + rc = dm_csv_write(targets, unit, app%header, app%separator) case (TYPE_OBSERV) - rc = dm_csv_write(observs, fu, app%header, app%separator) + rc = dm_csv_write(observs, unit, app%header, app%separator) case (TYPE_LOG) - rc = dm_csv_write(logs, fu, app%header, app%separator) + rc = dm_csv_write(logs, unit, app%header, app%separator) case (TYPE_BEAT) - rc = dm_csv_write(beats, fu, app%header, app%separator) - case (TYPE_DATA_POINT) - rc = dm_csv_write(data_points, fu, app%header, app%separator) + rc = dm_csv_write(beats, unit, app%header, app%separator) + case (TYPE_DP) + rc = dm_csv_write(data_points, unit, app%header, app%separator) end select + case (FORMAT_JSON) select case (app%type) case (TYPE_NODE) - rc = dm_json_write(nodes, fu) + rc = dm_json_write(nodes, unit) case (TYPE_SENSOR) - rc = dm_json_write(sensors, fu) + rc = dm_json_write(sensors, unit) case (TYPE_TARGET) - rc = dm_json_write(targets, fu) + rc = dm_json_write(targets, unit) case (TYPE_OBSERV) - rc = dm_json_write(observs, fu) + rc = dm_json_write(observs, unit) case (TYPE_LOG) - rc = dm_json_write(logs, fu) + rc = dm_json_write(logs, unit) case (TYPE_BEAT) - rc = dm_json_write(beats, fu) - case (TYPE_DATA_POINT) - rc = dm_json_write(data_points, fu) + rc = dm_json_write(beats, unit) + case (TYPE_DP) + rc = dm_json_write(data_points, unit) end select + case (FORMAT_JSONL) select case (app%type) case (TYPE_NODE) - rc = dm_jsonl_write(nodes, fu) + rc = dm_jsonl_write(nodes, unit) case (TYPE_SENSOR) - rc = dm_jsonl_write(sensors, fu) + rc = dm_jsonl_write(sensors, unit) case (TYPE_TARGET) - rc = dm_jsonl_write(targets, fu) + rc = dm_jsonl_write(targets, unit) case (TYPE_OBSERV) - rc = dm_jsonl_write(observs, fu) + rc = dm_jsonl_write(observs, unit) case (TYPE_LOG) - rc = dm_jsonl_write(logs, fu) + rc = dm_jsonl_write(logs, unit) case (TYPE_BEAT) - rc = dm_jsonl_write(beats, fu) - case (TYPE_DATA_POINT) - rc = dm_jsonl_write(data_points, fu) + rc = dm_jsonl_write(beats, unit) + case (TYPE_DP) + rc = dm_jsonl_write(data_points, unit) end select end select - if (is_file) close (fu) + if (is_file) close (unit) if (dm_is_error(rc)) then call dm_error_out(rc, 'failed to write data') @@ -195,9 +201,9 @@ integer function read_args(app) result(rc) arg_type('target', short='T', type=ARG_TYPE_ID), & ! -T, --target arg_type('from', short='B', type=ARG_TYPE_TIME), & ! -F, --from arg_type('to', short='E', type=ARG_TYPE_TIME), & ! -T, --to - arg_type('response', short='R', type=ARG_TYPE_ID, max_len=RESPONSE_NAME_LEN), & ! -R, --response + arg_type('response', short='R', type=ARG_TYPE_ID, max_len=RESPONSE_NAME_LEN), & ! -R, --response arg_type('format', short='f', type=ARG_TYPE_CHAR, max_len=FORMAT_NAME_LEN, required=.true.), & ! -f, --format - arg_type('type', short='t', type=ARG_TYPE_CHAR, max_len=TYPE_NAME_LEN, required=.true.), & ! -t, --type + arg_type('type', short='t', type=ARG_TYPE_CHAR, max_len=TYPE_NAME_LEN, required=.true.), & ! -t, --type arg_type('header', short='H', type=ARG_TYPE_BOOL), & ! -H, --header arg_type('separator', short='s', type=ARG_TYPE_CHAR, max_len=1) & ! -a, --separator ] @@ -235,7 +241,7 @@ integer function read_args(app) result(rc) ! Data type. select case (app%type) - case (TYPE_NODE, TYPE_SENSOR, TYPE_TARGET, TYPE_OBSERV, TYPE_LOG, TYPE_BEAT, TYPE_DATA_POINT) + case (TYPE_NODE, TYPE_SENSOR, TYPE_TARGET, TYPE_OBSERV, TYPE_LOG, TYPE_BEAT, TYPE_DP) continue case default call dm_error_out(rc, 'invalid type') @@ -243,41 +249,40 @@ integer function read_args(app) result(rc) end select ! Log, observation, and data point. - if (app%type == TYPE_LOG .or. app%type == TYPE_OBSERV .or. & - app%type == TYPE_DATA_POINT) then + if (app%type == TYPE_LOG .or. app%type == TYPE_OBSERV .or. app%type == TYPE_DP) then if (.not. dm_time_valid(app%from)) then - call dm_error_out(rc, 'missing argument --from') + call dm_error_out(rc, 'invalid or missing argument --from') return end if if (.not. dm_time_valid(app%to)) then - call dm_error_out(rc, 'missing argument --to') + call dm_error_out(rc, 'invalid or missing argument --to') return end if end if ! Observation and data point. - if (app%type == TYPE_OBSERV .or. app%type == TYPE_DATA_POINT) then + if (app%type == TYPE_OBSERV .or. app%type == TYPE_DP) then if (.not. dm_id_valid(app%node)) then - call dm_error_out(rc, 'missing argument --node') + call dm_error_out(rc, 'invalid or missing argument --node') return end if if (.not. dm_id_valid(app%sensor)) then - call dm_error_out(rc, 'missing argument --sensor') + call dm_error_out(rc, 'invalid or missing argument --sensor') return end if if (.not. dm_id_valid(app%target)) then - call dm_error_out(rc, 'missing argument --target') + call dm_error_out(rc, 'invalid or missing argument --target') return end if end if ! Data point. - if (app%type == TYPE_DATA_POINT) then + if (app%type == TYPE_DP) then if (.not. dm_id_valid(app%response)) then - call dm_error_out(rc, 'missing argument --response') + call dm_error_out(rc, 'invalid or missing argument --response') return end if else diff --git a/app/dmimport.f90 b/app/dmimport.f90 index 75da9f9..c6f6c71 100644 --- a/app/dmimport.f90 +++ b/app/dmimport.f90 @@ -43,7 +43,7 @@ integer function import(app) result(rc) type(app_type), intent(inout) :: app - integer :: er, fu, stat + integer :: er, stat, unit integer(kind=i8) :: nrecs, nrows logical :: exists, valid real(kind=r8) :: dt @@ -58,7 +58,7 @@ integer function import(app) result(rc) ! Try to open input file. rc = E_IO - open (action='read', file=trim(app%input), iostat=stat, newunit=fu) + open (action='read', file=trim(app%input), iostat=stat, newunit=unit) if (stat /= 0) then call dm_error_out(rc, 'failed to open file ' // trim(app%input)) @@ -132,15 +132,15 @@ integer function import(app) result(rc) ! Read record from file. select case (app%type) case (TYPE_NODE) - rc = dm_csv_read(node, fu, app%separator, app%quote) + rc = dm_csv_read(node, unit, app%separator, app%quote) case (TYPE_SENSOR) - rc = dm_csv_read(sensor, fu, app%separator, app%quote) + rc = dm_csv_read(sensor, unit, app%separator, app%quote) case (TYPE_TARGET) - rc = dm_csv_read(target, fu, app%separator, app%quote) + rc = dm_csv_read(target, unit, app%separator, app%quote) case (TYPE_OBSERV) - rc = dm_csv_read(observ, fu, app%separator, app%quote) + rc = dm_csv_read(observ, unit, app%separator, app%quote) case (TYPE_LOG) - rc = dm_csv_read(log, fu, app%separator, app%quote) + rc = dm_csv_read(log, unit, app%separator, app%quote) end select ! Ignore comments and empty rows. @@ -266,7 +266,7 @@ integer function import(app) result(rc) end if ! Close file. - close (fu) + close (unit) if (app%verbose) print '("Closed file ", a)', trim(app%input) if (dm_is_error(rc)) return diff --git a/app/dmpipe.f90 b/app/dmpipe.f90 index 97c0c5b..bbaaba4 100644 --- a/app/dmpipe.f90 +++ b/app/dmpipe.f90 @@ -15,7 +15,7 @@ program dmpipe integer, parameter :: APP_MINOR = 9 integer, parameter :: APP_PATCH = 0 - character, parameter :: APP_CSV_SEPARATOR = ',' !! CSV seperator character. + character, parameter :: APP_CSV_SEPARATOR = ',' !! CSV field separator. logical, parameter :: APP_MQ_BLOCKING = .true. !! Observation forwarding is blocking. integer, parameter :: OUTPUT_NONE = 0 !! No output. diff --git a/app/dmserial.f90 b/app/dmserial.f90 index 8d63199..a603bee 100644 --- a/app/dmserial.f90 +++ b/app/dmserial.f90 @@ -12,7 +12,7 @@ program dmserial integer, parameter :: APP_MINOR = 9 integer, parameter :: APP_PATCH = 1 - character, parameter :: APP_CSV_SEPARATOR = ',' !! CSV seperator character. + character, parameter :: APP_CSV_SEPARATOR = ',' !! CSV field separator. logical, parameter :: APP_MQ_BLOCKING = .true. !! Observation forwarding is blocking. integer, parameter :: OUTPUT_NONE = 0 !! No output. @@ -55,7 +55,14 @@ program dmserial if (dm_is_error(rc)) call dm_stop(1) ! Create TTY type. - rc = create_tty(tty, app) + rc = create_tty(tty = tty, & + path = app%tty, & + baud_rate = app%baud_rate, & + byte_size = app%byte_size, & + parity = app%parity, & + stop_bits = app%stop_bits, & + dtr = app%dtr, & + rts = app%rts) if (dm_is_error(rc)) call dm_stop(1) ! Initialise logger. @@ -75,28 +82,34 @@ program dmserial call dm_stop(0) contains - integer function create_tty(tty, app) result(rc) + integer function create_tty(tty, path, baud_rate, byte_size, parity, stop_bits, dtr, rts) result(rc) !! Creates TTY type from application settings. - type(tty_type), intent(inout) :: tty !! TTY type. - type(app_type), intent(inout) :: app !! App type. + type(tty_type), intent(out) :: tty !! TTY type. + character(len=*), intent(in) :: path !! Device path. + integer, intent(in) :: baud_rate !! Numeric baud rate. + integer, intent(in) :: byte_size !! Numeric byte size. + character(len=*), intent(in) :: parity !! Parity string. + integer, intent(in) :: stop_bits !! Numeric stop bits. + logical, intent(in) :: dtr !! DTR enabled. + logical, intent(in) :: rts !! RTS enabled. tty_block: block - tty%path = app%tty + tty%path = path - tty%baud_rate = dm_tty_baud_rate_from_value(app%baud_rate, error=rc) + tty%baud_rate = dm_tty_baud_rate_from_value(baud_rate, error=rc) if (dm_is_error(rc)) exit tty_block - tty%byte_size = dm_tty_byte_size_from_value(app%byte_size, error=rc) + tty%byte_size = dm_tty_byte_size_from_value(byte_size, error=rc) if (dm_is_error(rc)) exit tty_block - tty%parity = dm_tty_parity_from_name(app%parity, error=rc) + tty%parity = dm_tty_parity_from_name(parity, error=rc) if (dm_is_error(rc)) exit tty_block - tty%stop_bits = dm_tty_stop_bits_from_value(app%stop_bits, error=rc) + tty%stop_bits = dm_tty_stop_bits_from_value(stop_bits, error=rc) if (dm_is_error(rc)) exit tty_block - tty%dtr = app%dtr - tty%rts = app%rts + tty%dtr = dtr + tty%rts = rts end block tty_block if (dm_is_error(rc)) call dm_error_out(rc, 'invalid TTY parameters') diff --git a/app/dmsync.f90 b/app/dmsync.f90 index 2f646a1..fd97f60 100644 --- a/app/dmsync.f90 +++ b/app/dmsync.f90 @@ -22,7 +22,7 @@ program dmsync integer, parameter :: PASSWORD_LEN = 256 !! Max. length of password. type :: app_type - !! Global application settings. + !! Application settings. character(len=ID_LEN) :: name = APP_NAME !! Name of instance/configuration. character(len=FILE_PATH_LEN) :: config = ' ' !! Path to configuration file. character(len=LOGGER_NAME_LEN) :: logger = ' ' !! Name of logger. @@ -44,7 +44,7 @@ program dmsync end type app_type integer :: rc ! Return code. - type(app_type) :: app ! App configuration. + type(app_type) :: app ! App settings. type(db_type) :: db ! Database type. type(sem_type) :: sem ! POSIX semaphore type. diff --git a/app/dmweb.f90 b/app/dmweb.f90 index 8344b24..8abb1cc 100644 --- a/app/dmweb.f90 +++ b/app/dmweb.f90 @@ -1908,7 +1908,7 @@ function html_form_observs(nodes, sensors, targets, max_results, node_id, sensor end function html_form_observs function html_form_plots(nodes, sensors, targets, max_results, node_id, sensor_id, & - target_id, response_name, from, to, nresults) result(html) + target_id, response_name, from, to, nresults) result(html) !! Returns HTML form for plot selection. type(node_type), intent(inout) :: nodes(:) !! Node types. type(sensor_type), intent(inout) :: sensors(:) !! Sensor types. diff --git a/config/dmserial.conf.sample b/config/dmserial.conf.sample index ea957da..6593920 100644 --- a/config/dmserial.conf.sample +++ b/config/dmserial.conf.sample @@ -34,59 +34,48 @@ -- -- --- Request and response delimiter (carriage return). It may be necessary to --- change the delimiter to `\\n` (line feed). +-- The observations to be used in jobs list. The attribute `receivers` may +-- contain a list of up to 16 processes to forward the observation to. -- -del = "\\r" - --- --- Table of observations to be used in jobs list. The attribute `receivers` --- contains a list of up to 16 processes to forward the observation to. --- -observs = { +observ_stop = { -- - -- Sensor commands of DKRF400 from Driesen + Kern GmbH. + -- Stop "Meter Mode". + -- The sensor response is not read if the delimiter is empty (as the + -- DKRF400 does not always return a response to command `s\r`). -- - { - -- - -- Stop "Meter Mode". - -- The sensor response is not read if the delimiter is empty (as the - -- DKRF400 does not always return a response to command `s\r`). - -- - name = "stop", - target_id = "meter", - receivers = { }, - requests = { - { - name = "stop", - request = "s" .. del, - delimiter = "", - pattern = "", - delay = 0 - } + name = "stop", + target_id = "meter", + receivers = { }, + requests = { + { + name = "stop", + request = "s\\r", + delimiter = "", + pattern = "", + delay = 0 } - }, - { - -- - -- Single measurement. - -- - name = "meter", - target_id = "meter", - receivers = { "dmdb" }, - requests = { - { - name = "get-values", - request = "Meter" .. del, - delimiter = del, - pattern = "^\\s*(?[-0-9.]+)\\s.C\\s+.t\\s+(?[-0-9.]+)\\s%\\s+.t\\s+(?[-0-9.]+)\\sg.m3.t\\s+(?[-0-9.]+)\\s.C\\s+.t\\s+(?[-0-9.]+)", - delay = 0, - responses = { - { name = "temp", unit = "degC" }, -- Temperature. - { name = "humrel", unit = "%" }, -- Relative humidity. - { name = "humabs", unit = "g/m3" }, -- Absolute humidity. - { name = "dew", unit = "degC" }, -- Dew point. - { name = "wetbulb", unit = "degC" } -- Wet-bulb temperature. - } +} + +observ_meter = { + -- + -- Single measurement. + -- + name = "meter", + target_id = "meter", + receivers = { "dmdb" }, + requests = { + { + name = "get-values", + request = "Meter\\r", + delimiter = "\\n", + pattern = "^\\s*(?[-0-9.]+)\\s.C\\s+.t\\s+(?[-0-9.]+)\\s%\\s+.t\\s+(?[-0-9.]+)\\sg.m3.t\\s+(?[-0-9.]+)\\s.C\\s+.t\\s+(?[-0-9.]+)", + delay = 0, + responses = { + { name = "temp", unit = "degC", type = RESPONSE_TYPE_REAL64 }, -- Temperature. + { name = "humrel", unit = "%", type = RESPONSE_TYPE_REAL64 }, -- Relative humidity. + { name = "humabs", unit = "g/m3", type = RESPONSE_TYPE_REAL64 }, -- Absolute humidity. + { name = "dew", unit = "degC", type = RESPONSE_TYPE_REAL64 }, -- Dew point. + { name = "wetbulb", unit = "degC", type = RESPONSE_TYPE_REAL64 } -- Wet-bulb temperature. } } } @@ -113,7 +102,7 @@ dmserial = { -- disabled = false, onetime = true, - observation = observs[1], + observation = observ_stop, delay = 500 }, { @@ -122,7 +111,7 @@ dmserial = { -- disabled = false, onetime = false, - observation = observs[2], + observation = observ_meter, delay = 5 * 1000 } }, diff --git a/man/dmexport.1 b/man/dmexport.1 index 921194f..85ef9eb 100644 --- a/man/dmexport.1 +++ b/man/dmexport.1 @@ -2,12 +2,12 @@ .\" Title: dmexport .\" Author: Philipp Engel .\" Generator: Asciidoctor 2.0.20 -.\" Date: 2024-02-21 +.\" Date: 2024-03-06 .\" Manual: User Commands .\" Source: DMEXPORT .\" Language: English .\" -.TH "DMEXPORT" "1" "2024-02-21" "DMEXPORT" "User Commands" +.TH "DMEXPORT" "1" "2024-03-06" "DMEXPORT" "User Commands" .ie \n(.g .ds Aq \(aq .el .ds Aq ' .ss \n[.ss] 0 @@ -86,7 +86,7 @@ Node id (required). .sp \fB\-\-output\fP, \fB\-o\fP \fIfile\fP .RS 4 -Path of output file. +Path of output file. Empty or \f(CR\-\fP for standard output. .RE .sp \fB\-\-response\fP, \fB\-R\fP \fIname\fP diff --git a/src/dm_dp.f90 b/src/dm_dp.f90 index 9ded3a6..abf3400 100644 --- a/src/dm_dp.f90 +++ b/src/dm_dp.f90 @@ -4,7 +4,6 @@ module dm_dp !! X/Y data point type declaration that stores a single set of a time !! series. use :: dm_error - use :: dm_file use :: dm_kind use :: dm_time implicit none (type, external) @@ -20,50 +19,51 @@ module dm_dp integer, parameter, public :: DP_SIZE = storage_size(dp_type()) / 8 !! Size of `dp_type` in bytes. - public :: dm_dp_from_file +! public :: dm_dp_from_file public :: dm_dp_to_string contains - integer function dm_dp_from_file(path, dps, n, error_line) result(rc) - !! Reads X, Y data from a CSV file. Returns the lines in allocatable - !! array `dps` and the number of elements in `n`. On error, the - !! array might not be allocated. The argument `error_line` returns the - !! line in the input file in which the error occured. - character(len=*), intent(in) :: path !! Path to input file. - type(dp_type), allocatable, intent(out) :: dps(:) !! Array of data points. - integer(kind=i8), intent(out) :: n !! Size of array. - integer(kind=i8), intent(out), optional :: error_line !! Line number of error or 0. - - integer :: fu, stat - integer(kind=i8) :: i - - if (present(error_line)) error_line = 0 - - n = dm_file_line_count(path, rc) - if (rc /= E_NONE) return - - rc = E_EMPTY - if (n == 0) return - - rc = E_ALLOC - allocate (dps(n), stat=stat) - if (stat /= 0) return - - rc = E_IO - open (action='read', file=trim(path), iostat=stat, newunit=fu, status='old') - if (stat /= 0) return - - do i = 1, n - rc = E_INVALID - read (fu, *, iostat=stat) dps%x, dps%y - if (stat /= 0) then - if (present(error_line)) error_line = i - exit - end if - rc = E_NONE - end do - - close (fu) - end function dm_dp_from_file +! integer function dm_dp_from_file(path, dps, n, error_line) result(rc) +! !! Reads X, Y data from a CSV file. Returns the lines in allocatable +! !! array `dps` and the number of elements in `n`. On error, the +! !! array might not be allocated. The argument `error_line` returns the +! !! line in the input file in which the error occured. +! use :: dm_file +! character(len=*), intent(in) :: path !! Path to input file. +! type(dp_type), allocatable, intent(out) :: dps(:) !! Array of data points. +! integer(kind=i8), intent(out) :: n !! Size of array. +! integer(kind=i8), intent(out), optional :: error_line !! Line number of error or 0. +! +! integer :: fu, stat +! integer(kind=i8) :: i +! +! if (present(error_line)) error_line = 0 +! +! n = dm_file_line_count(path, rc) +! if (rc /= E_NONE) return +! +! rc = E_EMPTY +! if (n == 0) return +! +! rc = E_ALLOC +! allocate (dps(n), stat=stat) +! if (stat /= 0) return +! +! rc = E_IO +! open (action='read', file=trim(path), iostat=stat, newunit=fu, status='old') +! if (stat /= 0) return +! +! do i = 1, n +! rc = E_INVALID +! read (fu, *, iostat=stat) dps%x, dps%y +! if (stat /= 0) then +! if (present(error_line)) error_line = i +! exit +! end if +! rc = E_NONE +! end do +! +! close (fu) +! end function dm_dp_from_file pure elemental character(len=58) function dm_dp_to_string(dp) result(str) !! Returns data point as 58 characters long string. The attributes `x` diff --git a/src/dm_geocom.f90 b/src/dm_geocom.f90 index 3730d20..71dfb0a 100644 --- a/src/dm_geocom.f90 +++ b/src/dm_geocom.f90 @@ -5,22 +5,18 @@ module dm_geocom !! !! The API provided by DMPACK does not follow the official Leica GeoCOM API !! for C/C++ and Visual Basic. Structured types and functions are simplified - !! and given more memorable names. Function names do not contain a sub-system - !! prefix. + !! and given more memorable names. Function names do not contain any + !! sub-system prefix. !! - !! The following example opens the TTY `/dev/ttyUSB0` at 115,200 baud and - !! calls the null procedure of the instrument: + !! The following example opens the TTY `/dev/ttyUSB0` at 115,200 baud, and + !! calls the null procedure of the instrument (`COM_NullProc`): !! !! ```fortran !! integer :: rc ! DMPACK return code. !! type(geocom_class) :: geocom ! GeoCOM object. !! !! call geocom%open('/dev/ttyUSB0', GEOCOM_COM_BAUD_115200, retries=1, verbose=.true. error=rc) - !! - !! if (dm_is_error(rc)) then - !! dm_error_out(rc) - !! stop - !! end if + !! if (dm_is_error(rc)) error stop !! !! call geocom%null() !! print '(i0, ": ", a)', geocom%code(), geocom%message() @@ -28,6 +24,7 @@ module dm_geocom !! call geocom%close() !! ``` use :: dm_error + use :: dm_file use :: dm_geocom_api use :: dm_geocom_error use :: dm_geocom_type @@ -43,21 +40,25 @@ module dm_geocom !! GeoCOM class for TTY access and GeoCOM API handling through the !! public methods. Objects of this class are not thread-safe. private - integer :: rc = E_NONE !! Last DMPACK return code. - integer :: grc = GRC_OK !! Last GeoCOM return code. - logical :: verbose = .true. !! Print error messages to stderr. - type(request_type) :: request !! Last request sent to sensor. - type(tty_type) :: tty !! TTY type for serial connection. + character(len=FILE_PATH_LEN) :: path = ' ' !! TTY device path. + integer :: baud_rate = GEOCOM_COM_BAUD_19200 !! GeoCOM baud rate enumerator (`GEOCOM_COM_BAUD_RATE`). + integer :: grc = GRC_OK !! Last GeoCOM return code. + integer :: rc = E_NONE !! Last DMPACK return code. + logical :: verbose = .false. !! Print error messages to stderr. + type(request_type) :: request !! Last request sent to sensor. + type(tty_type) :: tty !! TTY type for serial connection. contains ! Public class methods. - procedure, public :: close => geocom_close - procedure, public :: code => geocom_code - procedure, public :: error => geocom_error - procedure, public :: last_request => geocom_last_request - procedure, public :: message => geocom_message - procedure, public :: open => geocom_open - procedure, public :: send => geocom_send - procedure, public :: set_verbose => geocom_set_verbose + procedure, public :: close => geocom_close + procedure, public :: code => geocom_code + procedure, public :: error => geocom_error + procedure, public :: get_baud_rate => geocom_get_baud_rate + procedure, public :: get_path => geocom_get_path + procedure, public :: last_request => geocom_last_request + procedure, public :: message => geocom_message + procedure, public :: open => geocom_open + procedure, public :: send => geocom_send + procedure, public :: set_verbose => geocom_set_verbose ! Public GeoCOM-specific methods. procedure, public :: abort_download => geocom_abort_download @@ -80,6 +81,8 @@ module dm_geocom private :: geocom_close private :: geocom_code private :: geocom_error + private :: geocom_get_baud_rate + private :: geocom_get_path private :: geocom_last_request private :: geocom_message private :: geocom_open @@ -141,6 +144,23 @@ subroutine geocom_close(this) if (dm_tty_connected(this%tty)) call dm_tty_close(this%tty) end subroutine geocom_close + subroutine geocom_get_baud_rate(this, baud_rate) + !! Returns current baud rate enumerator (`GEOCOM_COM_BAUD_RATE`) of TTY + !! in `baud_rate`. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(out) :: baud_rate !! Baud rate enumerator (`GEOCOM_COM_BAUD_RATE`). + + baud_rate = this%baud_rate + end subroutine geocom_get_baud_rate + + subroutine geocom_get_path(this, path) + !! Returns TTY device path in allocatable character string `path`. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + character(len=:), allocatable, intent(out) :: path !! TTY device path. + + path = trim(this%path) + end subroutine geocom_get_path + subroutine geocom_last_request(this, request) !! Returns the last request sent to the sensor in `request`. If no !! request has been sent, the derived type is uninitialised and the time @@ -154,15 +174,16 @@ end subroutine geocom_last_request subroutine geocom_open(this, path, baud_rate, retries, verbose, error) !! Opens TTY connection to robotic total station. !! - !! The argument `baud_rate` must be one of the following: + !! The argument `baud_rate` must be one of the following + !! `GEOCOM_COM_BAUD_RATE` enumerators: !! - !! * `GEOCOM_COM_BAUD_2400` - !! * `GEOCOM_COM_BAUD_4800` - !! * `GEOCOM_COM_BAUD_9600` - !! * `GEOCOM_COM_BAUD_19200` - !! * `GEOCOM_COM_BAUD_38400` - !! * `GEOCOM_COM_BAUD_57600` - !! * `GEOCOM_COM_BAUD_115200` + !! * `GEOCOM_COM_BAUD_2400` – 2400 baud. + !! * `GEOCOM_COM_BAUD_4800` – 4800 baud. + !! * `GEOCOM_COM_BAUD_9600` – 9600 baud. + !! * `GEOCOM_COM_BAUD_19200` – 19200 baud (default). + !! * `GEOCOM_COM_BAUD_38400` – 38400 baud. + !! * `GEOCOM_COM_BAUD_57600` – 57600 baud. + !! * `GEOCOM_COM_BAUD_115200` – 115200 baud. !! !! Argument `retries` specifies the number of attempts to make to !! connect to the sensor. If `verbose` is `.true.`, error messages are @@ -177,23 +198,16 @@ subroutine geocom_open(this, path, baud_rate, retries, verbose, error) !! * `E_SYSTEM` if setting the TTY attributes or flushing the buffers failed. use :: dm_file, only: dm_file_exists + integer, parameter :: WAIT_TIME = 3 !! Retry wait time in [sec]. + class(geocom_class), intent(inout) :: this !! GeoCOM object. - character(len=*), intent(in) :: path !! Path of TTY. - integer, intent(in) :: baud_rate !! Baud rate value. - integer, intent(in), optional :: retries !! Number of retries + character(len=*), intent(in) :: path !! Path of TTY (for example, `/dev/ttyUSB0`). + integer, intent(in) :: baud_rate !! GeoCOM baud rate enumerator (`GEOCOM_COM_BAUD_RATE`). + integer, intent(in), optional :: retries !! Number of retries. logical, intent(in), optional :: verbose !! Print errors to standard error. integer, intent(out), optional :: error !! DMPACK error code - integer :: baud, i, retries_, rc - - this%rc = E_NONE - this%grc = GRC_OK - this%verbose = .false. - this%request = request_type() - - retries_ = 0 - if (present(retries)) retries_ = max(0, retries) - if (present(verbose)) this%verbose = verbose + integer :: i, n, rc tty_block: block rc = E_EXIST @@ -202,53 +216,47 @@ subroutine geocom_open(this, path, baud_rate, retries, verbose, error) exit tty_block end if - rc = E_INVALID - select case (baud_rate) - case (GEOCOM_COM_BAUD_2400) - baud = TTY_B2400 - case (GEOCOM_COM_BAUD_4800) - baud = TTY_B4800 - case (GEOCOM_COM_BAUD_9600) - baud = TTY_B9600 - case (GEOCOM_COM_BAUD_19200) - baud = TTY_B19200 - case (GEOCOM_COM_BAUD_38400) - baud = TTY_B38400 - case (GEOCOM_COM_BAUD_57600) - baud = TTY_B57600 - case (GEOCOM_COM_BAUD_115200) - baud = TTY_B115200 - case default - if (this%verbose) call dm_error_out(rc, 'invalid baud rate') - exit tty_block - end select + ! Initialise TTY type. + this%path = path + this%grc = GRC_OK + this%rc = E_NONE + this%request = request_type() + this%verbose = .false. + if (present(verbose)) this%verbose = verbose - rc = E_NOT_FOUND - if (.not. dm_file_exists(path)) then - if (this%verbose) call dm_error_out(rc, 'TTY ' // trim(path) // ' not found') + ! Validate and set baud rate. + this%baud_rate = dm_geocom_type_validated(GEOCOM_COM_BAUD_RATE, baud_rate, error=rc) + + if (dm_is_error(rc)) then + if (this%verbose) call dm_error_out(rc, 'invalid baud rate') exit tty_block end if - i = 0 + ! Verify TTY device exists. + rc = E_NOT_FOUND + if (.not. dm_file_exists(this%path)) then + if (this%verbose) call dm_error_out(rc, 'TTY ' // trim(this%path) // ' not found') + exit tty_block + end if - do - if (i > retries_) exit + n = 0 + if (present(retries)) n = max(0, retries) - ! Try to open TTY. + ! Try to open TTY. + do i = 0, n rc = dm_tty_open(tty = this%tty, & - path = path, & - baud_rate = baud, & + path = this%path, & + baud_rate = this%baud_rate, & byte_size = TTY_BYTE_SIZE8, & parity = TTY_PARITY_NONE, & stop_bits = TTY_STOP_BITS1) ! Exit on success. if (dm_is_ok(rc)) exit - if (this%verbose) call dm_error_out(rc, 'failed to open TTY ' // trim(path)) + if (this%verbose) call dm_error_out(rc, 'failed to open TTY ' // trim(this%path)) - ! Re-try in 3 seconds. - i = i + 1 - call dm_sleep(3) + ! Try again. + if (i < n) call dm_sleep(WAIT_TIME) end do end block tty_block @@ -256,23 +264,22 @@ subroutine geocom_open(this, path, baud_rate, retries, verbose, error) if (present(error)) error = rc end subroutine geocom_open - subroutine geocom_send(this, request, error) + subroutine geocom_send(this, request, delay, error) !! Sends request to configured TTY. use :: dm_regex, only: dm_regex_request use :: dm_time, only: dm_time_now class(geocom_class), intent(inout) :: this !! GeoCOM object. type(request_type), intent(inout) :: request !! Request to send. + integer, intent(in), optional :: delay !! Request delay [msec]. integer, intent(out), optional :: error !! DMPACK error code - integer :: grc, rc + integer :: rc this%grc = GRC_UNDEFINED tty_block: block - ! Prepare request. - request%timestamp = dm_time_now() - + ! Verify that TTY is not connected yet. rc = E_IO if (.not. dm_tty_connected(this%tty)) then if (this%verbose) call dm_error_out(rc, 'TTY not connected') @@ -287,6 +294,9 @@ subroutine geocom_send(this, request, error) exit tty_block end if + ! Prepare request. + request%timestamp = dm_time_now() + ! Send request to sensor. rc = dm_tty_write(this%tty, request, flush=.true.) @@ -312,7 +322,10 @@ subroutine geocom_send(this, request, error) end if ! Get GeoCOM return code from response. - call dm_request_get(request, 'grc', grc) + call dm_request_get(request, 'grc', this%grc) + + ! Wait additional delay. + if (present(delay)) call dm_usleep(max(0, delay) * 1000) end block tty_block this%rc = rc @@ -332,66 +345,72 @@ end subroutine geocom_set_verbose ! ************************************************************************** ! PUBLIC GEOCOM METHODS. ! ************************************************************************** - subroutine geocom_abort_download(this) + subroutine geocom_abort_download(this, delay) !! Sends *FTR_AbortDownload* request to sensor. Aborts or ends the file !! download command. - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_abort_download(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_abort_download - subroutine geocom_abort_list(this) + subroutine geocom_abort_list(this, delay) !! Sends *FTR_AbortList* request to sensor. Aborts or ends the file !! list command. - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_abort_list(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_abort_list - subroutine geocom_beep_alarm(this) + subroutine geocom_beep_alarm(this, delay) !! Sends *BMM_BeepAlarm* request to sensor. Outputs an alarm signal !! (triple beep). - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_beep_alarm(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_beep_alarm - subroutine geocom_beep_normal(this) + subroutine geocom_beep_normal(this, delay) !! Sends *BMM_BeepNormal* request to sensor. Outputs an alarm signal !! (single beep). - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_beep_normal(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_beep_normal - subroutine geocom_beep_off(this) + subroutine geocom_beep_off(this, delay) !! Sends *IOS_BeepOff* request to sensor. Stops an active beep signal. - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_beep_off(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_beep_off - subroutine geocom_beep_on(this, intensity) + subroutine geocom_beep_on(this, intensity, delay) !! Sends *IOS_BeepOn* request to sensor. Outputs continuous beep signal !! of given intensity (between 0 and 100). If no intensity is given, !! the default `GEOCOM_IOS_BEEP_STDINTENS` is used. class(geocom_class), intent(inout) :: this !! GeoCOM object. integer, intent(in), optional :: intensity !! Intensity of beep, from 0 to 100. + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: intensity_ type(request_type) :: request @@ -400,10 +419,10 @@ subroutine geocom_beep_on(this, intensity) if (present(intensity)) intensity_ = max(0, min(100, intensity)) call dm_geocom_api_request_beep_on(request, intensity_) - call this%send(request) + call this%send(request, delay) end subroutine geocom_beep_on - subroutine geocom_change_face(this, pos_mode, atr_mode) + subroutine geocom_change_face(this, pos_mode, atr_mode, delay) !! Sends *AUT_ChangeFace* request to sensor. Turns the telescope to the !! other face. !! @@ -415,9 +434,10 @@ subroutine geocom_change_face(this, pos_mode, atr_mode) !! If `atr_mode` is `GEOCOM_AUT_POSITION`, uses conventional position to !! other face. If set to `GEOCOM_AUT_TARGET`, tries to position into a !! target in the destination area. This mode requires activated ATR. - class(geocom_class), intent(inout) :: this !! GeoCOM object. - integer, intent(in) :: pos_mode !! Position mode (`GEOCOM_AUT_POSMODE`). - integer, intent(in) :: atr_mode !! ATR mode (`GEOCOM_AUT_ATRMODE`). + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in) :: pos_mode !! Position mode (`GEOCOM_AUT_POSMODE`). + integer, intent(in) :: atr_mode !! ATR mode (`GEOCOM_AUT_ATRMODE`). + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: atr_mode_, pos_mode_ type(request_type) :: request @@ -426,10 +446,10 @@ subroutine geocom_change_face(this, pos_mode, atr_mode) atr_mode_ = dm_geocom_type_validated(GEOCOM_AUT_ATRMODE, atr_mode) call dm_geocom_api_request_change_face(request, pos_mode_, atr_mode_) - call this%send(request) + call this%send(request, delay) end subroutine geocom_change_face - subroutine geocom_delete(this, device_type, file_type, day, month, year, file_name, nfiles) + subroutine geocom_delete(this, device_type, file_type, day, month, year, file_name, nfiles, delay) !! Sends *FTR_Delete* request to sensor. Deletes one or more files. !! !! Wildcards may be used to delete multiple files. If the deletion date @@ -438,11 +458,12 @@ subroutine geocom_delete(this, device_type, file_type, day, month, year, file_na class(geocom_class), intent(inout) :: this !! GeoCOM object. integer, intent(in) :: device_type !! Internal memory or memory card (`GEOCOM_FTR_DEVICETYPE`). integer, intent(in) :: file_type !! Type of file (`GEOCOM_FTR_FILETYPE`). - integer, intent(in) :: day !! Day (`DD`). + integer, intent(in) :: day !! Day of month (`DD`). integer, intent(in) :: month !! Month (`MM`). integer, intent(in) :: year !! Year (`YY`). character(len=*), intent(in) :: file_name !! Name of file to delete. integer, intent(out), optional :: nfiles !! Number of files deleted. + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: device_type_, file_type_ integer :: day_, month_, year_ @@ -458,12 +479,12 @@ subroutine geocom_delete(this, device_type, file_type, day, month, year, file_na if (present(nfiles)) nfiles = 0 call dm_geocom_api_request_delete(request, device_type_, file_type_, day_, month_, year_, file_name) - call this%send(request) + call this%send(request, delay) if (present(nfiles)) call dm_request_get(this%request, 'nfiles', nfiles) end subroutine geocom_delete - subroutine geocom_do_measure(this, tmc_prog, inc_mode) + subroutine geocom_do_measure(this, tmc_prog, inc_mode, delay) !! Sends *TMC_DoMeasure* request to sensor. The API procedure tries a !! distance measurement. This command does not return any values. !! @@ -495,6 +516,7 @@ subroutine geocom_do_measure(this, tmc_prog, inc_mode) class(geocom_class), intent(inout) :: this !! GeoCOM object. integer, intent(in) :: tmc_prog !! TMC measurement program (`GEOCOM_TMC_MEASURE_PRG`). integer, intent(in), optional :: inc_mode !! Inclination measurement mode (`GEOCOM_TMC_INCLINE_PRG`). + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: inc_mode_, tmc_prog_ type(request_type) :: request @@ -505,24 +527,25 @@ subroutine geocom_do_measure(this, tmc_prog, inc_mode) if (present(inc_mode)) inc_mode_ = dm_geocom_type_validated(GEOCOM_TMC_INCLINE_PRG, inc_mode) call dm_geocom_api_request_do_measure(request, tmc_prog_, inc_mode_) - call this%send(request) + call this%send(request, delay) end subroutine geocom_do_measure - subroutine geocom_download(this, block_number, block_value, block_length) + subroutine geocom_download(this, block_number, block_value, block_length, delay) !! Sends *FTR_Download* request to sensor. Reads a single block of !! data. The *FTR_SetupDownload* command has to be called first. !! !! The block sequence starts with 1. The download process will be - !! aborted if the block number is set to 0. + !! aborted if the block number is 0. !! !! The maximum block number is 65535. The file size is therefore !! limited to 28 MiB. !! !! On error, `block_value` is `NULL`, and `block_length` is 0. - class(geocom_class), intent(inout) :: this !! GeoCOM object. - integer, intent(in) :: block_number !! Block number, from 0 to 65535. - character, intent(out) :: block_value !! Block value [byte]. - integer, intent(out) :: block_length !! Block length. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in) :: block_number !! Block number, from 0 to 65535. + character, intent(out) :: block_value !! Block value [byte]. + integer, intent(out) :: block_length !! Block length. + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: block_number_ type(request_type) :: request @@ -532,13 +555,13 @@ subroutine geocom_download(this, block_number, block_value, block_length) block_number_ = max(0, min(65535, block_number)) call dm_geocom_api_request_download(request, block_number_) - call this%send(request) + call this%send(request, delay) call dm_request_get(this%request, 'blockval', block_value) call dm_request_get(this%request, 'blocklen', block_length) end subroutine geocom_download - subroutine geocom_fine_adjust(this, search_hz, search_v) + subroutine geocom_fine_adjust(this, search_hz, search_v, delay) !! Sends *AUT_FineAdjust* request to sensor to perform automatic target !! positioning. !! @@ -559,17 +582,18 @@ subroutine geocom_fine_adjust(this, search_hz, search_v) !! The tolerance settings have no influence to this operation. The !! tolerance settings and the ATR precision depend on the instrument !! class and the used EDM mode. - class(geocom_class), intent(inout) :: this !! GeoCOM object. - real(kind=r8), intent(in) :: search_hz !! Search range, Hz axis [rad]. - real(kind=r8), intent(in) :: search_v !! Search range, V axis [rad]. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + real(kind=r8), intent(in) :: search_hz !! Search range, Hz axis [rad]. + real(kind=r8), intent(in) :: search_v !! Search range, V axis [rad]. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_fine_adjust(request, search_hz, search_v) - call this%send(request) + call this%send(request, delay) end subroutine geocom_fine_adjust - subroutine geocom_get_angle(this, hz, v, inc_mode) + subroutine geocom_get_angle(this, hz, v, inc_mode, delay) !! Sends *TMC_GetAngle5* request to sensor. Starts an angle measurement !! and returns the results. This function sets inclination mode !! `GEOCOM_TMC_MEA_INC` by default. @@ -577,6 +601,7 @@ subroutine geocom_get_angle(this, hz, v, inc_mode) real(kind=r8), intent(out) :: hz !! Horizontal angle [rad]. real(kind=r8), intent(out) :: v !! Vertical angle [rad]. integer, intent(in), optional :: inc_mode !! Inclination measurement mode (`GEOCOM_TMC_INCLINE_PRG`). + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: inc_mode_ type(request_type) :: request @@ -585,14 +610,14 @@ subroutine geocom_get_angle(this, hz, v, inc_mode) if (present(inc_mode)) inc_mode_ = dm_geocom_type_validated(GEOCOM_TMC_INCLINE_PRG, inc_mode) call dm_geocom_api_request_get_angle(request, inc_mode) - call this%send(request) + call this%send(request, delay) call dm_request_get(this%request, 'hz', hz) call dm_request_get(this%request, 'v', v) end subroutine geocom_get_angle subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, trans_inc, long_inc, & - inc_accuracy, inc_time, face, inc_mode) + inc_accuracy, inc_time, face, inc_mode, delay) !! Sends *TMC_GetAngle1* request to sensor. Performs a complete angle !! measurement. The function starts an angle and, depending on the !! configuration, an inclination measurement, and returns the results. @@ -608,6 +633,7 @@ subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, tr integer(kind=i8), intent(out), optional :: inc_time !! Moment of measurement [ms]. integer, intent(out), optional :: face !! Face position of telescope (`GEOCOM_TMC_FACE`). integer, intent(in), optional :: inc_mode !! Inclination measurement mode (`GEOCOM_TMC_INCLINE_PRG`). + integer, intent(in), optional :: delay !! Request delay [msec]. integer :: inc_mode_ type(request_type) :: request @@ -627,7 +653,7 @@ subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, tr if (present(inc_mode)) inc_mode_ = dm_geocom_type_validated(GEOCOM_TMC_INCLINE_PRG, inc_mode) call dm_geocom_api_request_get_angle_complete(request, inc_mode_) - call this%send(request) + call this%send(request, delay) call dm_request_get(this%request, 'hz', hz) call dm_request_get(this%request, 'v', v) @@ -641,14 +667,15 @@ subroutine geocom_get_angle_complete(this, hz, v, angle_accuracy, angle_time, tr if (present(face)) call dm_request_get(this%request, 'face', face) end subroutine geocom_get_angle_complete - subroutine geocom_null(this) + subroutine geocom_null(this, delay) !! Sends *COM_NullProc* request to sensor. API call for checking the !! communication. - class(geocom_class), intent(inout) :: this !! GeoCOM object. + class(geocom_class), intent(inout) :: this !! GeoCOM object. + integer, intent(in), optional :: delay !! Request delay [msec]. type(request_type) :: request call dm_geocom_api_request_null(request) - call this%send(request) + call this%send(request, delay) end subroutine geocom_null end module dm_geocom diff --git a/src/dm_geocom_type.f90 b/src/dm_geocom_type.f90 index 0645e7f..9081287 100644 --- a/src/dm_geocom_type.f90 +++ b/src/dm_geocom_type.f90 @@ -314,13 +314,14 @@ module dm_geocom_type integer function dm_geocom_type_validated(type, value, default, error) result(n) !! Parameterisation function for GeoCOM enumeration types. !! - !! Returns argument `value` if it is a valid enumerator of `type`, else - !! the default value of that type. If argument `type` is not found or - !! not supported, the function returns 0. If argument `default` is - !! passed, it is returned on error. + !! Returns argument `value` if it is a valid enumerator of enumeration + !! `type`, else the default value of that type. If argument `type` is not + !! found or not supported, the function returns 0. If argument `default` + !! is passed, it is returned on error. !! - !! If argument `default` is not passed and `type` is valid, one of the - !! following values is returned: + !! If argument `type` is valid, argument `value` is invalid, and argument + !! `default` is not passed, the default value from the following table is + !! returned: !! !! | Type | Default Value | !! |--------------------------------|----------------------------------| @@ -332,6 +333,7 @@ integer function dm_geocom_type_validated(type, value, default, error) result(n) !! | `GEOCOM_BAP_REFLTYPE` | `GEOCOM_BAP_REFL_UNDEF` | !! | `GEOCOM_BAP_TARGET_TYPE` | `GEOCOM_BAP_REFL_USE` | !! | `GEOCOM_BAP_USER_MEASPRG` | `GEOCOM_BAP_SINGLE_REF_STANDARD` | + !! | `GEOCOM_COM_BAUD_RATE` | `GEOCOM_COM_BAUD_19200` | !! | `GEOCOM_COM_TPS_STARTUP_MODE` | `GEOCOM_COM_STARTUP_REMOTE` | !! | `GEOCOM_COM_TPS_STOP_MODE` | `GEOCOM_COM_STOP_SHUT_DOWN` | !! | `GEOCOM_EDM_EGLINTENSITY_TYPE` | `GEOCOM_EDM_EGLINTEN_OFF` | @@ -466,6 +468,21 @@ integer function dm_geocom_type_validated(type, value, default, error) result(n) n = GEOCOM_BAP_SINGLE_REF_STANDARD end select + case (GEOCOM_COM_BAUD_RATE) + select case (value) + case (GEOCOM_COM_BAUD_38400, & + GEOCOM_COM_BAUD_19200, & + GEOCOM_COM_BAUD_9600, & + GEOCOM_COM_BAUD_4800, & + GEOCOM_COM_BAUD_2400, & + GEOCOM_COM_BAUD_115200, & + GEOCOM_COM_BAUD_57600) + rc = E_NONE + n = value + case default + n = GEOCOM_COM_BAUD_19200 + end select + case (GEOCOM_COM_TPS_STARTUP_MODE) select case (value) case (GEOCOM_COM_STARTUP_LOCAL, & diff --git a/src/dm_logger.f90 b/src/dm_logger.f90 index f87c1df..c388fba 100644 --- a/src/dm_logger.f90 +++ b/src/dm_logger.f90 @@ -9,18 +9,13 @@ module dm_logger !! Be aware that only a single receiver is allowed (but multiple senders). !! Otherwise, the messages are passed in round-robin fashion to the receivers. use :: dm_ansi - use :: dm_ascii use :: dm_error use :: dm_id use :: dm_kind use :: dm_log use :: dm_node use :: dm_observ - use :: dm_sensor - use :: dm_target - use :: dm_time use :: dm_type - use :: dm_uuid implicit none (type, external) private @@ -29,9 +24,9 @@ module dm_logger character(len=*), parameter, public :: LOGGER_NAME_DEFAULT = 'dmlogger' !! Default name of logger process. ! ANSI colours of log level. - integer, parameter :: LOGGER_COLORS(0:5) = [ & + integer, parameter :: LOGGER_COLORS(LVL_NONE:LVL_LAST) = [ & COLOR_RESET, COLOR_GREEN, COLOR_BLUE, COLOR_YELLOW, COLOR_RED, COLOR_RED & - ] + ] !! Colours associated with log level. type, public :: logger_type !! Opaque logger type. @@ -102,6 +97,8 @@ module dm_logger subroutine dm_logger_fail(message, error, source) !! Prints critical error message to standard error, with optional !! DMPACK error code. + use :: dm_time + character(len=*), intent(in) :: message !! Error message. integer, intent(in), optional :: error !! Optional error code. character(len=*), intent(in), optional :: source !! Optional source of log. @@ -146,6 +143,10 @@ end subroutine dm_logger_init subroutine dm_logger_log_args(level, message, source, observ, timestamp, error) !! Sends a log message to the message queue (fire & forget). Only the !! log level is validated. + use :: dm_ascii + use :: dm_time + use :: dm_uuid + integer, intent(in) :: level !! Log level. character(len=*), intent(in) :: message !! Log message. character(len=*), intent(in), optional :: source !! Optional source of log. @@ -299,6 +300,7 @@ subroutine dm_logger_send(log) !! if `LOGGER%ipc` is true. Prints message to standard output if !! `LOGGER%verbose` is true. use :: dm_mqueue + type(log_type), intent(inout) :: log !! Log type. integer :: rc diff --git a/src/dm_pipe.f90 b/src/dm_pipe.f90 index dfad67c..873e224 100644 --- a/src/dm_pipe.f90 +++ b/src/dm_pipe.f90 @@ -17,8 +17,8 @@ module dm_pipe type, public :: pipe_type !! Opaque pipe type. Stores the C pointer of uni-directional pipe. private - integer :: access = 0 - type(c_ptr) :: ptr = c_null_ptr + integer :: access = 0 !! `PIPE_RDONLY` or `PIPE_WRONLY`. + type(c_ptr) :: ptr = c_null_ptr !! Pointer of pipe. end type pipe_type public :: dm_pipe_connected @@ -123,14 +123,15 @@ integer function dm_pipe_open2(stdin, stdout, stderr, command) result(rc) end function dm_pipe_open2 integer(kind=i8) function dm_pipe_read(pipe, bytes) result(sz) - !! Reads from pipe to buffer `bytes` (binary). + !! Reads from pipe to buffer `bytes` (binary) and returns number of + !! bytes written to buffer. type(pipe_type), intent(inout) :: pipe !! Bi-directional pipe. character(len=*), target, intent(inout) :: bytes !! Output buffer. sz = 0_i8 bytes = ' ' if (pipe%access == PIPE_WRONLY) return - sz = c_fread(c_loc(bytes), int(1, kind=c_size_t), len(bytes, kind=c_size_t), pipe%ptr) + sz = c_fread(c_loc(bytes), 1_c_size_t, len(bytes, kind=c_size_t), pipe%ptr) end function dm_pipe_read integer function dm_pipe_write(pipe, str) result(rc) @@ -155,7 +156,7 @@ integer(kind=i8) function dm_pipe_write2(pipe, bytes) result(sz) sz = 0_i8 if (pipe%access == PIPE_RDONLY) return - sz = c_fwrite(c_loc(bytes), int(1, kind=c_size_t), len(bytes, kind=c_size_t), pipe%ptr) + sz = c_fwrite(c_loc(bytes), 1_c_size_t, len(bytes, kind=c_size_t), pipe%ptr) end function dm_pipe_write2 subroutine dm_pipe_close(pipe) diff --git a/src/dm_request.f90 b/src/dm_request.f90 index 40e4ed7..7cbecc7 100644 --- a/src/dm_request.f90 +++ b/src/dm_request.f90 @@ -35,12 +35,12 @@ module dm_request character(len=REQUEST_RESPONSE_LEN) :: response = ' ' !! Raw response (printable). character(len=REQUEST_DELIMITER_LEN) :: delimiter = ' ' !! Response delimiter (printable). character(len=REQUEST_PATTERN_LEN) :: pattern = ' ' !! Regular expression pattern. - integer :: delay = 0 !! Delay in msec (optional). + integer :: delay = 0 !! Delay in [msec] (optional). integer :: error = E_NONE !! Error code. integer :: mode = REQUEST_MODE_NONE !! Request mode (optional). integer :: retries = 0 !! Number of executed retries. integer :: state = REQUEST_STATE_NONE !! Request state (optional). - integer :: timeout = 0 !! Timeout in msec (optional). + integer :: timeout = 0 !! Timeout in [msec] (optional). integer :: nresponses = 0 !! Number of responses. type(response_type) :: responses(REQUEST_MAX_NRESPONSES) !! Responses array. end type request_type diff --git a/src/dm_system.f90 b/src/dm_system.f90 index 07f39a1..dded825 100644 --- a/src/dm_system.f90 +++ b/src/dm_system.f90 @@ -101,15 +101,18 @@ subroutine dm_system_path(path) call get_command_argument(0, path) end subroutine dm_system_path - subroutine dm_system_uname(uname, stat) + subroutine dm_system_uname(uname, error) !! Returns uname information (operating system, hostname, ...). type(uname_type), intent(out) :: uname !! Uname type. - integer, intent(out), optional :: stat !! Error code. + integer, intent(out), optional :: error !! Error code. + integer :: stat type(c_utsname) :: utsname - if (present(stat)) stat = E_SYSTEM - if (c_uname(utsname) /= 0) return + if (present(error)) error = E_SYSTEM + + stat = c_uname(utsname) + if (stat /= 0) return call c_f_str_chars(utsname%sysname, uname%system_name) call c_f_str_chars(utsname%nodename, uname%node_name) @@ -117,20 +120,25 @@ subroutine dm_system_uname(uname, stat) call c_f_str_chars(utsname%version, uname%version) call c_f_str_chars(utsname%machine, uname%machine) - if (present(stat)) stat = E_NONE + if (present(error)) error = E_NONE end subroutine dm_system_uname - subroutine dm_system_uptime(time, stat) + subroutine dm_system_uptime(time, error) !! Returns system uptime. integer(kind=i8), intent(out) :: time - integer, intent(out), optional :: stat + integer, intent(out), optional :: error + integer :: stat type(c_timespec) :: tp - if (present(stat)) stat = E_SYSTEM - if (c_clock_gettime(CLOCK_MONOTONIC, tp) /= 0) return + if (present(error)) error = E_SYSTEM + + stat = c_clock_gettime(CLOCK_MONOTONIC, tp) + if (stat /= 0) return + time = int(tp%tv_sec, kind=i8) if (time > 60) time = time + 30 - if (present(stat)) stat = E_NONE + + if (present(error)) error = E_NONE end subroutine dm_system_uptime end module dm_system diff --git a/src/dm_tty.f90 b/src/dm_tty.f90 index 1ba7551..9466ced 100644 --- a/src/dm_tty.f90 +++ b/src/dm_tty.f90 @@ -258,7 +258,7 @@ integer function dm_tty_open(tty, path, baud_rate, byte_size, parity, stop_bits) !! * `E_SYSTEM` if setting the TTY attributes or flushing the buffers failed. use :: unix - type(tty_type) , intent(inout) :: tty !! TTY type. + type(tty_type), intent(inout) :: tty !! TTY type. character(len=*), intent(in), optional :: path !! Device path. integer, intent(in), optional :: baud_rate !! Baud rate enumerator (`TTY_B_*`). integer, intent(in), optional :: byte_size !! Byte size enumerator (`TTY_BYTE_SIZE*`). diff --git a/src/dm_type.f90 b/src/dm_type.f90 index 42b2cb4..a08be29 100644 --- a/src/dm_type.f90 +++ b/src/dm_type.f90 @@ -15,7 +15,7 @@ module dm_type integer, parameter, public :: TYPE_RESPONSE = 6 !! Response of request. integer, parameter, public :: TYPE_LOG = 7 !! Log. integer, parameter, public :: TYPE_BEAT = 8 !! Heartbeat. - integer, parameter, public :: TYPE_DATA_POINT = 9 !! X/Y data point. + integer, parameter, public :: TYPE_DP = 9 !! X/Y data point. integer, parameter, public :: TYPE_LAST = 9 !! Never use this. integer, parameter, public :: TYPE_NAME_LEN = 8 !! Max. type name length. @@ -56,8 +56,8 @@ integer function dm_type_from_name(name) result(type) type = TYPE_LOG case (TYPE_NAMES(TYPE_BEAT)) type = TYPE_BEAT - case (TYPE_NAMES(TYPE_DATA_POINT)) - type = TYPE_DATA_POINT + case (TYPE_NAMES(TYPE_DP)) + type = TYPE_DP case default type = TYPE_NONE end select diff --git a/src/dm_z.f90 b/src/dm_z.f90 index 4f05bef..832baf4 100644 --- a/src/dm_z.f90 +++ b/src/dm_z.f90 @@ -10,8 +10,8 @@ module dm_z private public :: dm_z_compress - public :: dm_z_deflate_mem - public :: dm_z_inflate_mem + public :: dm_z_deflate + public :: dm_z_inflate public :: dm_z_uncompress contains integer function dm_z_compress(input, output, output_size) result(rc) @@ -47,21 +47,21 @@ integer function dm_z_compress(input, output, output_size) result(rc) rc = E_NONE end function dm_z_compress - integer function dm_z_deflate_mem(input, output) result(rc) + integer function dm_z_deflate(input, output) result(rc) !! Compresses input string. Returns `E_ZLIB` if the compression !! failed. character(len=*), target, intent(inout) :: input !! Input bytes. character(len=:), allocatable, intent(out) :: output !! Output bytes. character(len=len(input)), target :: buffer - integer :: err, have + integer :: have, stat type(z_stream) :: strm rc = E_ZLIB output = '' - if (deflate_init2(strm, Z_DEFAULT_COMPRESSION, Z_DEFLATED, & - -15, 8, Z_DEFAULT_STRATEGY) /= Z_OK) return + stat = deflate_init2(strm, Z_DEFAULT_COMPRESSION, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) + if (stat /= Z_OK) return def_block: block strm%avail_in = len(input) @@ -72,33 +72,35 @@ integer function dm_z_deflate_mem(input, output) result(rc) strm%total_out = strm%avail_in strm%next_out = c_loc(buffer) - err = deflate(strm, Z_FINISH) - if (err == Z_STREAM_ERROR) exit def_block + stat = deflate(strm, Z_FINISH) + if (stat == Z_STREAM_ERROR) exit def_block have = len(buffer) - strm%avail_out output = buffer(1:have) - if (err /= Z_STREAM_END) exit def_block + if (stat /= Z_STREAM_END) exit def_block rc = E_NONE end block def_block - err = deflate_end(strm) - end function dm_z_deflate_mem + stat = deflate_end(strm) + end function dm_z_deflate - integer function dm_z_inflate_mem(input, output, buffer_size) result(rc) - !! Decompresses input string. Returns `E_ZLIB` if the decompression - !! failed. + integer function dm_z_inflate(input, output, buffer_size) result(rc) + !! Decompresses input string. The argument `buffer_size` specifies the + !! size of the inflate buffer and must be large enough for the buffer + !! to hold the result. Returns `E_ZLIB` if the decompression failed. character(len=*), target, intent(inout) :: input !! Input bytes. character(len=:), allocatable, intent(out) :: output !! Output bytes. integer, intent(in) :: buffer_size !! Buffer size. character(len=buffer_size), target :: buffer - integer :: err, have + integer :: have, stat type(z_stream) :: strm rc = E_ZLIB output = '' - if (inflate_init2(strm, -15) /= Z_OK) return + stat = inflate_init2(strm, -15) + if (stat /= Z_OK) return inf_block: block strm%avail_in = len(input) @@ -109,20 +111,21 @@ integer function dm_z_inflate_mem(input, output, buffer_size) result(rc) strm%total_out = strm%avail_out strm%next_out = c_loc(buffer) - err = inflate(strm, Z_FINISH) - if (err == Z_STREAM_ERROR) exit inf_block + stat = inflate(strm, Z_FINISH) + if (stat == Z_STREAM_ERROR) exit inf_block have = len(buffer) - strm%avail_out output = buffer(1:have) - if (err /= Z_STREAM_END) exit inf_block + if (stat /= Z_STREAM_END) exit inf_block rc = E_NONE end block inf_block - err = inflate_end(strm) - end function dm_z_inflate_mem + stat = inflate_end(strm) + end function dm_z_inflate integer function dm_z_uncompress(input, output, output_size) result(rc) - !! Uncompresses input string using the zlib utility function. Returns + !! Uncompresses input string using the zlib utility function. The output + !! buffer must be large enough to hold the uncompressed result. Returns !! `E_ZLIB` if the decompression failed. character(len=*), intent(inout) :: input !! Input bytes. character(len=*), intent(inout) :: output !! Output bytes. diff --git a/test/dmtestz.f90 b/test/dmtestz.f90 index 774b818..ca0ef30 100644 --- a/test/dmtestz.f90 +++ b/test/dmtestz.f90 @@ -28,11 +28,11 @@ logical function test01() result(stat) rc = dm_nml_from(observ1, input) print *, 'deflate ...' - rc = dm_z_deflate_mem(input, output1) + rc = dm_z_deflate(input, output1) if (dm_is_error(rc)) return print *, 'inflate ...' - rc = dm_z_inflate_mem(output1, output2, len(input)) + rc = dm_z_inflate(output1, output2, len(input)) if (dm_is_error(rc)) return print '(" source size.: ", i0)', len(input)